This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate change #18420 from maint-5.8:
[perl5.git] / regexec.c
1 /*    regexec.c
2  */
3
4 /*
5  * "One Ring to rule them all, One Ring to find them..."
6  */
7
8 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
9  * confused with the original package (see point 3 below).  Thanks, Henry!
10  */
11
12 /* Additional note: this code is very heavily munged from Henry's version
13  * in places.  In some spots I've traded clarity for efficiency, so don't
14  * blame Henry for some of the lack of readability.
15  */
16
17 /* The names of the functions have been changed from regcomp and
18  * regexec to  pregcomp and pregexec in order to avoid conflicts
19  * with the POSIX routines of the same names.
20 */
21
22 #ifdef PERL_EXT_RE_BUILD
23 /* need to replace pregcomp et al, so enable that */
24 #  ifndef PERL_IN_XSUB_RE
25 #    define PERL_IN_XSUB_RE
26 #  endif
27 /* need access to debugger hooks */
28 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
29 #    define DEBUGGING
30 #  endif
31 #endif
32
33 #ifdef PERL_IN_XSUB_RE
34 /* We *really* need to overwrite these symbols: */
35 #  define Perl_regexec_flags my_regexec
36 #  define Perl_regdump my_regdump
37 #  define Perl_regprop my_regprop
38 #  define Perl_re_intuit_start my_re_intuit_start
39 /* *These* symbols are masked to allow static link. */
40 #  define Perl_pregexec my_pregexec
41 #  define Perl_reginitcolors my_reginitcolors
42 #  define Perl_regclass_swash my_regclass_swash
43
44 #  define PERL_NO_GET_CONTEXT
45 #endif
46
47 /*SUPPRESS 112*/
48 /*
49  * pregcomp and pregexec -- regsub and regerror are not used in perl
50  *
51  *      Copyright (c) 1986 by University of Toronto.
52  *      Written by Henry Spencer.  Not derived from licensed software.
53  *
54  *      Permission is granted to anyone to use this software for any
55  *      purpose on any computer system, and to redistribute it freely,
56  *      subject to the following restrictions:
57  *
58  *      1. The author is not responsible for the consequences of use of
59  *              this software, no matter how awful, even if they arise
60  *              from defects in it.
61  *
62  *      2. The origin of this software must not be misrepresented, either
63  *              by explicit claim or by omission.
64  *
65  *      3. Altered versions must be plainly marked as such, and must not
66  *              be misrepresented as being the original software.
67  *
68  ****    Alterations to Henry's code are...
69  ****
70  ****    Copyright (c) 1991-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                     && (!do_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         && (!do_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) {
1886             I32 op = (U8)OP(prog->regstclass);
1887             /* don't bother with what can't match */
1888             if (PL_regkind[op] != EXACT && op != CANY)
1889                 strend = HOPc(strend, -(minlen - 1));
1890         }
1891         DEBUG_r({
1892             SV *prop = sv_newmortal();
1893             char *s0;
1894             char *s1;
1895             int len0;
1896             int len1;
1897
1898             regprop(prop, c);
1899             s0 = UTF ?
1900               pv_uni_display(dsv0, (U8*)SvPVX(prop), SvCUR(prop), 60,
1901                              UNI_DISPLAY_REGEX) :
1902               SvPVX(prop);
1903             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1904             s1 = UTF ?
1905               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1906             len1 = UTF ? SvCUR(dsv1) : strend - s;
1907             PerlIO_printf(Perl_debug_log,
1908                           "Matching stclass `%*.*s' against `%*.*s'\n",
1909                           len0, len0, s0,
1910                           len1, len1, s1);
1911         });
1912         if (find_byclass(prog, c, s, strend, startpos, 0))
1913             goto got_it;
1914         DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1915     }
1916     else {
1917         dontbother = 0;
1918         if (prog->float_substr != Nullsv || prog->float_utf8 != Nullsv) {
1919             /* Trim the end. */
1920             char *last;
1921             SV* float_real;
1922
1923             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1924                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1925             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1926
1927             if (flags & REXEC_SCREAM) {
1928                 last = screaminstr(sv, float_real, s - strbeg,
1929                                    end_shift, &scream_pos, 1); /* last one */
1930                 if (!last)
1931                     last = scream_olds; /* Only one occurrence. */
1932             }
1933             else {
1934                 STRLEN len;
1935                 char *little = SvPV(float_real, len);
1936
1937                 if (SvTAIL(float_real)) {
1938                     if (memEQ(strend - len + 1, little, len - 1))
1939                         last = strend - len + 1;
1940                     else if (!PL_multiline)
1941                         last = memEQ(strend - len, little, len)
1942                             ? strend - len : Nullch;
1943                     else
1944                         goto find_last;
1945                 } else {
1946                   find_last:
1947                     if (len)
1948                         last = rninstr(s, strend, little, little + len);
1949                     else
1950                         last = strend;  /* matching `$' */
1951                 }
1952             }
1953             if (last == NULL) {
1954                 DEBUG_r(PerlIO_printf(Perl_debug_log,
1955                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1956                                       PL_colors[4],PL_colors[5]));
1957                 goto phooey; /* Should not happen! */
1958             }
1959             dontbother = strend - last + prog->float_min_offset;
1960         }
1961         if (minlen && (dontbother < minlen))
1962             dontbother = minlen - 1;
1963         strend -= dontbother;              /* this one's always in bytes! */
1964         /* We don't know much -- general case. */
1965         if (do_utf8) {
1966             for (;;) {
1967                 if (regtry(prog, s))
1968                     goto got_it;
1969                 if (s >= strend)
1970                     break;
1971                 s += UTF8SKIP(s);
1972             };
1973         }
1974         else {
1975             do {
1976                 if (regtry(prog, s))
1977                     goto got_it;
1978             } while (s++ < strend);
1979         }
1980     }
1981
1982     /* Failure. */
1983     goto phooey;
1984
1985 got_it:
1986     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1987
1988     if (PL_reg_eval_set) {
1989         /* Preserve the current value of $^R */
1990         if (oreplsv != GvSV(PL_replgv))
1991             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1992                                                   restored, the value remains
1993                                                   the same. */
1994         restore_pos(aTHX_ 0);
1995     }
1996
1997     /* make sure $`, $&, $', and $digit will work later */
1998     if ( !(flags & REXEC_NOT_FIRST) ) {
1999         if (RX_MATCH_COPIED(prog)) {
2000             Safefree(prog->subbeg);
2001             RX_MATCH_COPIED_off(prog);
2002         }
2003         if (flags & REXEC_COPY_STR) {
2004             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2005
2006             s = savepvn(strbeg, i);
2007             prog->subbeg = s;
2008             prog->sublen = i;
2009             RX_MATCH_COPIED_on(prog);
2010         }
2011         else {
2012             prog->subbeg = strbeg;
2013             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2014         }
2015     }
2016
2017     return 1;
2018
2019 phooey:
2020     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2021                           PL_colors[4],PL_colors[5]));
2022     if (PL_reg_eval_set)
2023         restore_pos(aTHX_ 0);
2024     return 0;
2025 }
2026
2027 /*
2028  - regtry - try match at specific point
2029  */
2030 STATIC I32                      /* 0 failure, 1 success */
2031 S_regtry(pTHX_ regexp *prog, char *startpos)
2032 {
2033     register I32 i;
2034     register I32 *sp;
2035     register I32 *ep;
2036     CHECKPOINT lastcp;
2037
2038 #ifdef DEBUGGING
2039     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2040 #endif
2041     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2042         MAGIC *mg;
2043
2044         PL_reg_eval_set = RS_init;
2045         DEBUG_r(DEBUG_s(
2046             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2047                           (IV)(PL_stack_sp - PL_stack_base));
2048             ));
2049         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2050         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2051         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2052         SAVETMPS;
2053         /* Apparently this is not needed, judging by wantarray. */
2054         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2055            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2056
2057         if (PL_reg_sv) {
2058             /* Make $_ available to executed code. */
2059             if (PL_reg_sv != DEFSV) {
2060                 /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
2061                 SAVESPTR(DEFSV);
2062                 DEFSV = PL_reg_sv;
2063             }
2064         
2065             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2066                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2067                 /* prepare for quick setting of pos */
2068                 sv_magic(PL_reg_sv, (SV*)0,
2069                         PERL_MAGIC_regex_global, Nullch, 0);
2070                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
2071                 mg->mg_len = -1;
2072             }
2073             PL_reg_magic    = mg;
2074             PL_reg_oldpos   = mg->mg_len;
2075             SAVEDESTRUCTOR_X(restore_pos, 0);
2076         }
2077         if (!PL_reg_curpm) {
2078             Newz(22,PL_reg_curpm, 1, PMOP);
2079 #ifdef USE_ITHREADS
2080             {
2081                 SV* repointer = newSViv(0);
2082                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2083                 SvFLAGS(repointer) |= SVf_BREAK;
2084                 av_push(PL_regex_padav,repointer);
2085                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2086                 PL_regex_pad = AvARRAY(PL_regex_padav);
2087             }
2088 #endif      
2089         }
2090         PM_SETRE(PL_reg_curpm, prog);
2091         PL_reg_oldcurpm = PL_curpm;
2092         PL_curpm = PL_reg_curpm;
2093         if (RX_MATCH_COPIED(prog)) {
2094             /*  Here is a serious problem: we cannot rewrite subbeg,
2095                 since it may be needed if this match fails.  Thus
2096                 $` inside (?{}) could fail... */
2097             PL_reg_oldsaved = prog->subbeg;
2098             PL_reg_oldsavedlen = prog->sublen;
2099             RX_MATCH_COPIED_off(prog);
2100         }
2101         else
2102             PL_reg_oldsaved = Nullch;
2103         prog->subbeg = PL_bostr;
2104         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2105     }
2106     prog->startp[0] = startpos - PL_bostr;
2107     PL_reginput = startpos;
2108     PL_regstartp = prog->startp;
2109     PL_regendp = prog->endp;
2110     PL_reglastparen = &prog->lastparen;
2111     PL_reglastcloseparen = &prog->lastcloseparen;
2112     prog->lastparen = 0;
2113     prog->lastcloseparen = 0;
2114     PL_regsize = 0;
2115     DEBUG_r(PL_reg_starttry = startpos);
2116     if (PL_reg_start_tmpl <= prog->nparens) {
2117         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2118         if(PL_reg_start_tmp)
2119             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2120         else
2121             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2122     }
2123
2124     /* XXXX What this code is doing here?!!!  There should be no need
2125        to do this again and again, PL_reglastparen should take care of
2126        this!  --ilya*/
2127
2128     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2129      * Actually, the code in regcppop() (which Ilya may be meaning by
2130      * PL_reglastparen), is not needed at all by the test suite
2131      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2132      * enough, for building DynaLoader, or otherwise this
2133      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2134      * will happen.  Meanwhile, this code *is* needed for the
2135      * above-mentioned test suite tests to succeed.  The common theme
2136      * on those tests seems to be returning null fields from matches.
2137      * --jhi */
2138 #if 1
2139     sp = prog->startp;
2140     ep = prog->endp;
2141     if (prog->nparens) {
2142         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2143             *++sp = -1;
2144             *++ep = -1;
2145         }
2146     }
2147 #endif
2148     REGCP_SET(lastcp);
2149     if (regmatch(prog->program + 1)) {
2150         prog->endp[0] = PL_reginput - PL_bostr;
2151         return 1;
2152     }
2153     REGCP_UNWIND(lastcp);
2154     return 0;
2155 }
2156
2157 #define RE_UNWIND_BRANCH        1
2158 #define RE_UNWIND_BRANCHJ       2
2159
2160 union re_unwind_t;
2161
2162 typedef struct {                /* XX: makes sense to enlarge it... */
2163     I32 type;
2164     I32 prev;
2165     CHECKPOINT lastcp;
2166 } re_unwind_generic_t;
2167
2168 typedef struct {
2169     I32 type;
2170     I32 prev;
2171     CHECKPOINT lastcp;
2172     I32 lastparen;
2173     regnode *next;
2174     char *locinput;
2175     I32 nextchr;
2176 #ifdef DEBUGGING
2177     int regindent;
2178 #endif
2179 } re_unwind_branch_t;
2180
2181 typedef union re_unwind_t {
2182     I32 type;
2183     re_unwind_generic_t generic;
2184     re_unwind_branch_t branch;
2185 } re_unwind_t;
2186
2187 #define sayYES goto yes
2188 #define sayNO goto no
2189 #define sayNO_ANYOF goto no_anyof
2190 #define sayYES_FINAL goto yes_final
2191 #define sayYES_LOUD  goto yes_loud
2192 #define sayNO_FINAL  goto no_final
2193 #define sayNO_SILENT goto do_no
2194 #define saySAME(x) if (x) goto yes; else goto no
2195
2196 #define REPORT_CODE_OFF 24
2197
2198 /*
2199  - regmatch - main matching routine
2200  *
2201  * Conceptually the strategy is simple:  check to see whether the current
2202  * node matches, call self recursively to see whether the rest matches,
2203  * and then act accordingly.  In practice we make some effort to avoid
2204  * recursion, in particular by going through "ordinary" nodes (that don't
2205  * need to know whether the rest of the match failed) by a loop instead of
2206  * by recursion.
2207  */
2208 /* [lwall] I've hoisted the register declarations to the outer block in order to
2209  * maybe save a little bit of pushing and popping on the stack.  It also takes
2210  * advantage of machines that use a register save mask on subroutine entry.
2211  */
2212 STATIC I32                      /* 0 failure, 1 success */
2213 S_regmatch(pTHX_ regnode *prog)
2214 {
2215     register regnode *scan;     /* Current node. */
2216     regnode *next;              /* Next node. */
2217     regnode *inner;             /* Next node in internal branch. */
2218     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2219                                    function of same name */
2220     register I32 n;             /* no or next */
2221     register I32 ln = 0;        /* len or last */
2222     register char *s = Nullch;  /* operand or save */
2223     register char *locinput = PL_reginput;
2224     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2225     int minmod = 0, sw = 0, logical = 0;
2226     I32 unwind = 0;
2227 #if 0
2228     I32 firstcp = PL_savestack_ix;
2229 #endif
2230     register bool do_utf8 = PL_reg_match_utf8;
2231 #ifdef DEBUGGING
2232     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2233     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2234     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2235 #endif
2236
2237 #ifdef DEBUGGING
2238     PL_regindent++;
2239 #endif
2240
2241     /* Note that nextchr is a byte even in UTF */
2242     nextchr = UCHARAT(locinput);
2243     scan = prog;
2244     while (scan != NULL) {
2245
2246         DEBUG_r( {
2247             SV *prop = sv_newmortal();
2248             int docolor = *PL_colors[0];
2249             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2250             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2251             /* The part of the string before starttry has one color
2252                (pref0_len chars), between starttry and current
2253                position another one (pref_len - pref0_len chars),
2254                after the current position the third one.
2255                We assume that pref0_len <= pref_len, otherwise we
2256                decrease pref0_len.  */
2257             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2258                 ? (5 + taill) - l : locinput - PL_bostr;
2259             int pref0_len;
2260
2261             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2262                 pref_len++;
2263             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2264             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2265                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2266                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2267             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2268                 l--;
2269             if (pref0_len < 0)
2270                 pref0_len = 0;
2271             if (pref0_len > pref_len)
2272                 pref0_len = pref_len;
2273             regprop(prop, scan);
2274             {
2275               char *s0 =
2276                 do_utf8 && OP(scan) != CANY ?
2277                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2278                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2279                 locinput - pref_len;
2280               int len0 = do_utf8 ? strlen(s0) : pref0_len;
2281               char *s1 = do_utf8 && OP(scan) != CANY ?
2282                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2283                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2284                 locinput - pref_len + pref0_len;
2285               int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2286               char *s2 = do_utf8 && OP(scan) != CANY ?
2287                 pv_uni_display(dsv2, (U8*)locinput,
2288                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2289                 locinput;
2290               int len2 = do_utf8 ? strlen(s2) : l;
2291               PerlIO_printf(Perl_debug_log,
2292                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2293                             (IV)(locinput - PL_bostr),
2294                             PL_colors[4],
2295                             len0, s0,
2296                             PL_colors[5],
2297                             PL_colors[2],
2298                             len1, s1,
2299                             PL_colors[3],
2300                             (docolor ? "" : "> <"),
2301                             PL_colors[0],
2302                             len2, s2,
2303                             PL_colors[1],
2304                             15 - l - pref_len + 1,
2305                             "",
2306                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2307                             SvPVX(prop));
2308             }
2309         });
2310
2311         next = scan + NEXT_OFF(scan);
2312         if (next == scan)
2313             next = NULL;
2314
2315         switch (OP(scan)) {
2316         case BOL:
2317             if (locinput == PL_bostr || (PL_multiline &&
2318                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2319             {
2320                 /* regtill = regbol; */
2321                 break;
2322             }
2323             sayNO;
2324         case MBOL:
2325             if (locinput == PL_bostr ||
2326                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2327             {
2328                 break;
2329             }
2330             sayNO;
2331         case SBOL:
2332             if (locinput == PL_bostr)
2333                 break;
2334             sayNO;
2335         case GPOS:
2336             if (locinput == PL_reg_ganch)
2337                 break;
2338             sayNO;
2339         case EOL:
2340             if (PL_multiline)
2341                 goto meol;
2342             else
2343                 goto seol;
2344         case MEOL:
2345           meol:
2346             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2347                 sayNO;
2348             break;
2349         case SEOL:
2350           seol:
2351             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2352                 sayNO;
2353             if (PL_regeol - locinput > 1)
2354                 sayNO;
2355             break;
2356         case EOS:
2357             if (PL_regeol != locinput)
2358                 sayNO;
2359             break;
2360         case SANY:
2361             if (!nextchr && locinput >= PL_regeol)
2362                 sayNO;
2363             if (do_utf8) {
2364                 locinput += PL_utf8skip[nextchr];
2365                 if (locinput > PL_regeol)
2366                     sayNO;
2367                 nextchr = UCHARAT(locinput);
2368             }
2369             else
2370                 nextchr = UCHARAT(++locinput);
2371             break;
2372         case CANY:
2373             if (!nextchr && locinput >= PL_regeol)
2374                 sayNO;
2375             nextchr = UCHARAT(++locinput);
2376             break;
2377         case REG_ANY:
2378             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2379                 sayNO;
2380             if (do_utf8) {
2381                 locinput += PL_utf8skip[nextchr];
2382                 if (locinput > PL_regeol)
2383                     sayNO;
2384                 nextchr = UCHARAT(locinput);
2385             }
2386             else
2387                 nextchr = UCHARAT(++locinput);
2388             break;
2389         case EXACT:
2390             s = STRING(scan);
2391             ln = STR_LEN(scan);
2392             if (do_utf8 != UTF) {
2393                 /* The target and the pattern have differing utf8ness. */
2394                 char *l = locinput;
2395                 char *e = s + ln;
2396                 STRLEN ulen;
2397
2398                 if (do_utf8) {
2399                     /* The target is utf8, the pattern is not utf8. */
2400                     while (s < e) {
2401                         if (l >= PL_regeol)
2402                              sayNO;
2403                         if (NATIVE_TO_UNI(*(U8*)s) !=
2404                             utf8n_to_uvuni((U8*)l, UTF8_MAXLEN, &ulen,
2405                                            ckWARN(WARN_UTF8) ?
2406                                            0 : UTF8_ALLOW_ANY))
2407                              sayNO;
2408                         l += ulen;
2409                         s ++;
2410                     }
2411                 }
2412                 else {
2413                     /* The target is not utf8, the pattern is utf8. */
2414                     while (s < e) {
2415                         if (l >= PL_regeol)
2416                             sayNO;
2417                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2418                             utf8n_to_uvuni((U8*)s, UTF8_MAXLEN, &ulen,
2419                                            ckWARN(WARN_UTF8) ?
2420                                            0 : UTF8_ALLOW_ANY))
2421                             sayNO;
2422                         s += ulen;
2423                         l ++;
2424                     }
2425                 }
2426                 locinput = l;
2427                 nextchr = UCHARAT(locinput);
2428                 break;
2429             }
2430             /* The target and the pattern have the same utf8ness. */
2431             /* Inline the first character, for speed. */
2432             if (UCHARAT(s) != nextchr)
2433                 sayNO;
2434             if (PL_regeol - locinput < ln)
2435                 sayNO;
2436             if (ln > 1 && memNE(s, locinput, ln))
2437                 sayNO;
2438             locinput += ln;
2439             nextchr = UCHARAT(locinput);
2440             break;
2441         case EXACTFL:
2442             PL_reg_flags |= RF_tainted;
2443             /* FALL THROUGH */
2444         case EXACTF:
2445             s = STRING(scan);
2446             ln = STR_LEN(scan);
2447
2448             if (do_utf8 || UTF) {
2449               /* Either target or the pattern are utf8. */
2450                 char *l = locinput;
2451                 char *e = PL_regeol;
2452
2453                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
2454                                l, &e, 0,  do_utf8)) {
2455                      /* One more case for the sharp s:
2456                       * pack("U0U*", 0xDF) =~ /ss/i,
2457                       * the 0xC3 0x9F are the UTF-8
2458                       * byte sequence for the U+00DF. */
2459                      if (!(do_utf8 &&
2460                            toLOWER(s[0]) == 's' &&
2461                            ln >= 2 &&
2462                            toLOWER(s[1]) == 's' &&
2463                            (U8)l[0] == 0xC3 &&
2464                            e - l >= 2 &&
2465                            (U8)l[1] == 0x9F))
2466                           sayNO;
2467                 }
2468                 locinput = e;
2469                 nextchr = UCHARAT(locinput);
2470                 break;
2471             }
2472
2473             /* Neither the target and the pattern are utf8. */
2474
2475             /* Inline the first character, for speed. */
2476             if (UCHARAT(s) != nextchr &&
2477                 UCHARAT(s) != ((OP(scan) == EXACTF)
2478                                ? PL_fold : PL_fold_locale)[nextchr])
2479                 sayNO;
2480             if (PL_regeol - locinput < ln)
2481                 sayNO;
2482             if (ln > 1 && (OP(scan) == EXACTF
2483                            ? ibcmp(s, locinput, ln)
2484                            : ibcmp_locale(s, locinput, ln)))
2485                 sayNO;
2486             locinput += ln;
2487             nextchr = UCHARAT(locinput);
2488             break;
2489         case ANYOF:
2490             if (do_utf8) {
2491                 STRLEN inclasslen = PL_regeol - locinput;
2492
2493                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2494                     sayNO_ANYOF;
2495                 if (locinput >= PL_regeol)
2496                     sayNO;
2497                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2498                 nextchr = UCHARAT(locinput);
2499                 break;
2500             }
2501             else {
2502                 if (nextchr < 0)
2503                     nextchr = UCHARAT(locinput);
2504                 if (!REGINCLASS(scan, (U8*)locinput))
2505                     sayNO_ANYOF;
2506                 if (!nextchr && locinput >= PL_regeol)
2507                     sayNO;
2508                 nextchr = UCHARAT(++locinput);
2509                 break;
2510             }
2511         no_anyof:
2512             /* If we might have the case of the German sharp s
2513              * in a casefolding Unicode character class. */
2514
2515             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2516                  locinput += SHARP_S_SKIP;
2517                  nextchr = UCHARAT(locinput);
2518             }
2519             else
2520                  sayNO;
2521             break;
2522         case ALNUML:
2523             PL_reg_flags |= RF_tainted;
2524             /* FALL THROUGH */
2525         case ALNUM:
2526             if (!nextchr)
2527                 sayNO;
2528             if (do_utf8) {
2529                 LOAD_UTF8_CHARCLASS(alnum,"a");
2530                 if (!(OP(scan) == ALNUM
2531                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2532                       : isALNUM_LC_utf8((U8*)locinput)))
2533                 {
2534                     sayNO;
2535                 }
2536                 locinput += PL_utf8skip[nextchr];
2537                 nextchr = UCHARAT(locinput);
2538                 break;
2539             }
2540             if (!(OP(scan) == ALNUM
2541                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2542                 sayNO;
2543             nextchr = UCHARAT(++locinput);
2544             break;
2545         case NALNUML:
2546             PL_reg_flags |= RF_tainted;
2547             /* FALL THROUGH */
2548         case NALNUM:
2549             if (!nextchr && locinput >= PL_regeol)
2550                 sayNO;
2551             if (do_utf8) {
2552                 LOAD_UTF8_CHARCLASS(alnum,"a");
2553                 if (OP(scan) == NALNUM
2554                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2555                     : isALNUM_LC_utf8((U8*)locinput))
2556                 {
2557                     sayNO;
2558                 }
2559                 locinput += PL_utf8skip[nextchr];
2560                 nextchr = UCHARAT(locinput);
2561                 break;
2562             }
2563             if (OP(scan) == NALNUM
2564                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2565                 sayNO;
2566             nextchr = UCHARAT(++locinput);
2567             break;
2568         case BOUNDL:
2569         case NBOUNDL:
2570             PL_reg_flags |= RF_tainted;
2571             /* FALL THROUGH */
2572         case BOUND:
2573         case NBOUND:
2574             /* was last char in word? */
2575             if (do_utf8) {
2576                 if (locinput == PL_bostr)
2577                     ln = '\n';
2578                 else {
2579                     U8 *r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
2580                 
2581                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
2582                 }
2583                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2584                     ln = isALNUM_uni(ln);
2585                     LOAD_UTF8_CHARCLASS(alnum,"a");
2586                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2587                 }
2588                 else {
2589                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2590                     n = isALNUM_LC_utf8((U8*)locinput);
2591                 }
2592             }
2593             else {
2594                 ln = (locinput != PL_bostr) ?
2595                     UCHARAT(locinput - 1) : '\n';
2596                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2597                     ln = isALNUM(ln);
2598                     n = isALNUM(nextchr);
2599                 }
2600                 else {
2601                     ln = isALNUM_LC(ln);
2602                     n = isALNUM_LC(nextchr);
2603                 }
2604             }
2605             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2606                                     OP(scan) == BOUNDL))
2607                     sayNO;
2608             break;
2609         case SPACEL:
2610             PL_reg_flags |= RF_tainted;
2611             /* FALL THROUGH */
2612         case SPACE:
2613             if (!nextchr)
2614                 sayNO;
2615             if (do_utf8) {
2616                 if (UTF8_IS_CONTINUED(nextchr)) {
2617                     LOAD_UTF8_CHARCLASS(space," ");
2618                     if (!(OP(scan) == SPACE
2619                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2620                           : isSPACE_LC_utf8((U8*)locinput)))
2621                     {
2622                         sayNO;
2623                     }
2624                     locinput += PL_utf8skip[nextchr];
2625                     nextchr = UCHARAT(locinput);
2626                     break;
2627                 }
2628                 if (!(OP(scan) == SPACE
2629                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2630                     sayNO;
2631                 nextchr = UCHARAT(++locinput);
2632             }
2633             else {
2634                 if (!(OP(scan) == SPACE
2635                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2636                     sayNO;
2637                 nextchr = UCHARAT(++locinput);
2638             }
2639             break;
2640         case NSPACEL:
2641             PL_reg_flags |= RF_tainted;
2642             /* FALL THROUGH */
2643         case NSPACE:
2644             if (!nextchr && locinput >= PL_regeol)
2645                 sayNO;
2646             if (do_utf8) {
2647                 LOAD_UTF8_CHARCLASS(space," ");
2648                 if (OP(scan) == NSPACE
2649                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2650                     : isSPACE_LC_utf8((U8*)locinput))
2651                 {
2652                     sayNO;
2653                 }
2654                 locinput += PL_utf8skip[nextchr];
2655                 nextchr = UCHARAT(locinput);
2656                 break;
2657             }
2658             if (OP(scan) == NSPACE
2659                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2660                 sayNO;
2661             nextchr = UCHARAT(++locinput);
2662             break;
2663         case DIGITL:
2664             PL_reg_flags |= RF_tainted;
2665             /* FALL THROUGH */
2666         case DIGIT:
2667             if (!nextchr)
2668                 sayNO;
2669             if (do_utf8) {
2670                 LOAD_UTF8_CHARCLASS(digit,"0");
2671                 if (!(OP(scan) == DIGIT
2672                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2673                       : isDIGIT_LC_utf8((U8*)locinput)))
2674                 {
2675                     sayNO;
2676                 }
2677                 locinput += PL_utf8skip[nextchr];
2678                 nextchr = UCHARAT(locinput);
2679                 break;
2680             }
2681             if (!(OP(scan) == DIGIT
2682                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2683                 sayNO;
2684             nextchr = UCHARAT(++locinput);
2685             break;
2686         case NDIGITL:
2687             PL_reg_flags |= RF_tainted;
2688             /* FALL THROUGH */
2689         case NDIGIT:
2690             if (!nextchr && locinput >= PL_regeol)
2691                 sayNO;
2692             if (do_utf8) {
2693                 LOAD_UTF8_CHARCLASS(digit,"0");
2694                 if (OP(scan) == NDIGIT
2695                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2696                     : isDIGIT_LC_utf8((U8*)locinput))
2697                 {
2698                     sayNO;
2699                 }
2700                 locinput += PL_utf8skip[nextchr];
2701                 nextchr = UCHARAT(locinput);
2702                 break;
2703             }
2704             if (OP(scan) == NDIGIT
2705                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2706                 sayNO;
2707             nextchr = UCHARAT(++locinput);
2708             break;
2709         case CLUMP:
2710             if (locinput >= PL_regeol)
2711                 sayNO;
2712             if  (do_utf8) {
2713                 LOAD_UTF8_CHARCLASS(mark,"~");
2714                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2715                     sayNO;
2716                 locinput += PL_utf8skip[nextchr];
2717                 while (locinput < PL_regeol &&
2718                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2719                     locinput += UTF8SKIP(locinput);
2720                 if (locinput > PL_regeol)
2721                     sayNO;
2722             } 
2723             else
2724                locinput++;
2725             nextchr = UCHARAT(locinput);
2726             break;
2727         case REFFL:
2728             PL_reg_flags |= RF_tainted;
2729             /* FALL THROUGH */
2730         case REF:
2731         case REFF:
2732             n = ARG(scan);  /* which paren pair */
2733             ln = PL_regstartp[n];
2734             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2735             if ((I32)*PL_reglastparen < n || ln == -1)
2736                 sayNO;                  /* Do not match unless seen CLOSEn. */
2737             if (ln == PL_regendp[n])
2738                 break;
2739
2740             s = PL_bostr + ln;
2741             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2742                 char *l = locinput;
2743                 char *e = PL_bostr + PL_regendp[n];
2744                 /*
2745                  * Note that we can't do the "other character" lookup trick as
2746                  * in the 8-bit case (no pun intended) because in Unicode we
2747                  * have to map both upper and title case to lower case.
2748                  */
2749                 if (OP(scan) == REFF) {
2750                     STRLEN ulen1, ulen2;
2751                     U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
2752                     U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
2753                     while (s < e) {
2754                         if (l >= PL_regeol)
2755                             sayNO;
2756                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2757                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2758                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2759                             sayNO;
2760                         s += ulen1;
2761                         l += ulen2;
2762                     }
2763                 }
2764                 locinput = l;
2765                 nextchr = UCHARAT(locinput);
2766                 break;
2767             }
2768
2769             /* Inline the first character, for speed. */
2770             if (UCHARAT(s) != nextchr &&
2771                 (OP(scan) == REF ||
2772                  (UCHARAT(s) != ((OP(scan) == REFF
2773                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2774                 sayNO;
2775             ln = PL_regendp[n] - ln;
2776             if (locinput + ln > PL_regeol)
2777                 sayNO;
2778             if (ln > 1 && (OP(scan) == REF
2779                            ? memNE(s, locinput, ln)
2780                            : (OP(scan) == REFF
2781                               ? ibcmp(s, locinput, ln)
2782                               : ibcmp_locale(s, locinput, ln))))
2783                 sayNO;
2784             locinput += ln;
2785             nextchr = UCHARAT(locinput);
2786             break;
2787
2788         case NOTHING:
2789         case TAIL:
2790             break;
2791         case BACK:
2792             break;
2793         case EVAL:
2794         {
2795             dSP;
2796             OP_4tree *oop = PL_op;
2797             COP *ocurcop = PL_curcop;
2798             PAD *old_comppad;
2799             SV *ret;
2800         
2801             n = ARG(scan);
2802             PL_op = (OP_4tree*)PL_regdata->data[n];
2803             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2804             PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
2805             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2806
2807             {
2808                 SV **before = SP;
2809                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2810                 SPAGAIN;
2811                 if (SP == before)
2812                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
2813                 else {
2814                     ret = POPs;
2815                     PUTBACK;
2816                 }
2817             }
2818
2819             PL_op = oop;
2820             PAD_RESTORE_LOCAL(old_comppad);
2821             PL_curcop = ocurcop;
2822             if (logical) {
2823                 if (logical == 2) {     /* Postponed subexpression. */
2824                     regexp *re;
2825                     MAGIC *mg = Null(MAGIC*);
2826                     re_cc_state state;
2827                     CHECKPOINT cp, lastcp;
2828                     int toggleutf;
2829
2830                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2831                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2832
2833                         if(SvMAGICAL(sv))
2834                             mg = mg_find(sv, PERL_MAGIC_qr);
2835                     }
2836                     if (mg) {
2837                         re = (regexp *)mg->mg_obj;
2838                         (void)ReREFCNT_inc(re);
2839                     }
2840                     else {
2841                         STRLEN len;
2842                         char *t = SvPV(ret, len);
2843                         PMOP pm;
2844                         char *oprecomp = PL_regprecomp;
2845                         I32 osize = PL_regsize;
2846                         I32 onpar = PL_regnpar;
2847
2848                         Zero(&pm, 1, PMOP);
2849                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
2850                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2851                         if (!(SvFLAGS(ret)
2852                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2853                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2854                                         PERL_MAGIC_qr,0,0);
2855                         PL_regprecomp = oprecomp;
2856                         PL_regsize = osize;
2857                         PL_regnpar = onpar;
2858                     }
2859                     DEBUG_r(
2860                         PerlIO_printf(Perl_debug_log,
2861                                       "Entering embedded `%s%.60s%s%s'\n",
2862                                       PL_colors[0],
2863                                       re->precomp,
2864                                       PL_colors[1],
2865                                       (strlen(re->precomp) > 60 ? "..." : ""))
2866                         );
2867                     state.node = next;
2868                     state.prev = PL_reg_call_cc;
2869                     state.cc = PL_regcc;
2870                     state.re = PL_reg_re;
2871
2872                     PL_regcc = 0;
2873                 
2874                     cp = regcppush(0);  /* Save *all* the positions. */
2875                     REGCP_SET(lastcp);
2876                     cache_re(re);
2877                     state.ss = PL_savestack_ix;
2878                     *PL_reglastparen = 0;
2879                     *PL_reglastcloseparen = 0;
2880                     PL_reg_call_cc = &state;
2881                     PL_reginput = locinput;
2882                     toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
2883                                 ((re->reganch & ROPT_UTF8) != 0);
2884                     if (toggleutf) PL_reg_flags ^= RF_utf8;
2885
2886                     /* XXXX This is too dramatic a measure... */
2887                     PL_reg_maxiter = 0;
2888
2889                     if (regmatch(re->program + 1)) {
2890                         /* Even though we succeeded, we need to restore
2891                            global variables, since we may be wrapped inside
2892                            SUSPEND, thus the match may be not finished yet. */
2893
2894                         /* XXXX Do this only if SUSPENDed? */
2895                         PL_reg_call_cc = state.prev;
2896                         PL_regcc = state.cc;
2897                         PL_reg_re = state.re;
2898                         cache_re(PL_reg_re);
2899                         if (toggleutf) PL_reg_flags ^= RF_utf8;
2900
2901                         /* XXXX This is too dramatic a measure... */
2902                         PL_reg_maxiter = 0;
2903
2904                         /* These are needed even if not SUSPEND. */
2905                         ReREFCNT_dec(re);
2906                         regcpblow(cp);
2907                         sayYES;
2908                     }
2909                     ReREFCNT_dec(re);
2910                     REGCP_UNWIND(lastcp);
2911                     regcppop();
2912                     PL_reg_call_cc = state.prev;
2913                     PL_regcc = state.cc;
2914                     PL_reg_re = state.re;
2915                     cache_re(PL_reg_re);
2916                     if (toggleutf) PL_reg_flags ^= RF_utf8;
2917
2918                     /* XXXX This is too dramatic a measure... */
2919                     PL_reg_maxiter = 0;
2920
2921                     logical = 0;
2922                     sayNO;
2923                 }
2924                 sw = SvTRUE(ret);
2925                 logical = 0;
2926             }
2927             else
2928                 sv_setsv(save_scalar(PL_replgv), ret);
2929             break;
2930         }
2931         case OPEN:
2932             n = ARG(scan);  /* which paren pair */
2933             PL_reg_start_tmp[n] = locinput;
2934             if (n > PL_regsize)
2935                 PL_regsize = n;
2936             break;
2937         case CLOSE:
2938             n = ARG(scan);  /* which paren pair */
2939             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2940             PL_regendp[n] = locinput - PL_bostr;
2941             if (n > (I32)*PL_reglastparen)
2942                 *PL_reglastparen = n;
2943             *PL_reglastcloseparen = n;
2944             break;
2945         case GROUPP:
2946             n = ARG(scan);  /* which paren pair */
2947             sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
2948             break;
2949         case IFTHEN:
2950             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2951             if (sw)
2952                 next = NEXTOPER(NEXTOPER(scan));
2953             else {
2954                 next = scan + ARG(scan);
2955                 if (OP(next) == IFTHEN) /* Fake one. */
2956                     next = NEXTOPER(NEXTOPER(next));
2957             }
2958             break;
2959         case LOGICAL:
2960             logical = scan->flags;
2961             break;
2962 /*******************************************************************
2963  PL_regcc contains infoblock about the innermost (...)* loop, and
2964  a pointer to the next outer infoblock.
2965
2966  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2967
2968    1) After matching X, regnode for CURLYX is processed;
2969
2970    2) This regnode creates infoblock on the stack, and calls
2971       regmatch() recursively with the starting point at WHILEM node;
2972
2973    3) Each hit of WHILEM node tries to match A and Z (in the order
2974       depending on the current iteration, min/max of {min,max} and
2975       greediness).  The information about where are nodes for "A"
2976       and "Z" is read from the infoblock, as is info on how many times "A"
2977       was already matched, and greediness.
2978
2979    4) After A matches, the same WHILEM node is hit again.
2980
2981    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2982       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2983       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2984       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2985       of the external loop.
2986
2987  Currently present infoblocks form a tree with a stem formed by PL_curcc
2988  and whatever it mentions via ->next, and additional attached trees
2989  corresponding to temporarily unset infoblocks as in "5" above.
2990
2991  In the following picture infoblocks for outer loop of
2992  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2993  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2994  infoblocks are drawn below the "reset" infoblock.
2995
2996  In fact in the picture below we do not show failed matches for Z and T
2997  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2998  more obvious *why* one needs to *temporary* unset infoblocks.]
2999
3000   Matched       REx position    InfoBlocks      Comment
3001                 (Y(A)*?Z)*?T    x
3002                 Y(A)*?Z)*?T     x <- O
3003   Y             (A)*?Z)*?T      x <- O
3004   Y             A)*?Z)*?T       x <- O <- I
3005   YA            )*?Z)*?T        x <- O <- I
3006   YA            A)*?Z)*?T       x <- O <- I
3007   YAA           )*?Z)*?T        x <- O <- I
3008   YAA           Z)*?T           x <- O          # Temporary unset I
3009                                      I
3010
3011   YAAZ          Y(A)*?Z)*?T     x <- O
3012                                      I
3013
3014   YAAZY         (A)*?Z)*?T      x <- O
3015                                      I
3016
3017   YAAZY         A)*?Z)*?T       x <- O <- I
3018                                      I
3019
3020   YAAZYA        )*?Z)*?T        x <- O <- I     
3021                                      I
3022
3023   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3024                                      I,I
3025
3026   YAAZYAZ       )*?T            x <- O
3027                                      I,I
3028
3029   YAAZYAZ       T               x               # Temporary unset O
3030                                 O
3031                                 I,I
3032
3033   YAAZYAZT                      x
3034                                 O
3035                                 I,I
3036  *******************************************************************/
3037         case CURLYX: {
3038                 CURCUR cc;
3039                 CHECKPOINT cp = PL_savestack_ix;
3040                 /* No need to save/restore up to this paren */
3041                 I32 parenfloor = scan->flags;
3042
3043                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3044                     next += ARG(next);
3045                 cc.oldcc = PL_regcc;
3046                 PL_regcc = &cc;
3047                 /* XXXX Probably it is better to teach regpush to support
3048                    parenfloor > PL_regsize... */
3049                 if (parenfloor > (I32)*PL_reglastparen)
3050                     parenfloor = *PL_reglastparen; /* Pessimization... */
3051                 cc.parenfloor = parenfloor;
3052                 cc.cur = -1;
3053                 cc.min = ARG1(scan);
3054                 cc.max  = ARG2(scan);
3055                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3056                 cc.next = next;
3057                 cc.minmod = minmod;
3058                 cc.lastloc = 0;
3059                 PL_reginput = locinput;
3060                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3061                 regcpblow(cp);
3062                 PL_regcc = cc.oldcc;
3063                 saySAME(n);
3064             }
3065             /* NOT REACHED */
3066         case WHILEM: {
3067                 /*
3068                  * This is really hard to understand, because after we match
3069                  * what we're trying to match, we must make sure the rest of
3070                  * the REx is going to match for sure, and to do that we have
3071                  * to go back UP the parse tree by recursing ever deeper.  And
3072                  * if it fails, we have to reset our parent's current state
3073                  * that we can try again after backing off.
3074                  */
3075
3076                 CHECKPOINT cp, lastcp;
3077                 CURCUR* cc = PL_regcc;
3078                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
3079                 
3080                 n = cc->cur + 1;        /* how many we know we matched */
3081                 PL_reginput = locinput;
3082
3083                 DEBUG_r(
3084                     PerlIO_printf(Perl_debug_log,
3085                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3086                                   REPORT_CODE_OFF+PL_regindent*2, "",
3087                                   (long)n, (long)cc->min,
3088                                   (long)cc->max, PTR2UV(cc))
3089                     );
3090
3091                 /* If degenerate scan matches "", assume scan done. */
3092
3093                 if (locinput == cc->lastloc && n >= cc->min) {
3094                     PL_regcc = cc->oldcc;
3095                     if (PL_regcc)
3096                         ln = PL_regcc->cur;
3097                     DEBUG_r(
3098                         PerlIO_printf(Perl_debug_log,
3099                            "%*s  empty match detected, try continuation...\n",
3100                            REPORT_CODE_OFF+PL_regindent*2, "")
3101                         );
3102                     if (regmatch(cc->next))
3103                         sayYES;
3104                     if (PL_regcc)
3105                         PL_regcc->cur = ln;
3106                     PL_regcc = cc;
3107                     sayNO;
3108                 }
3109
3110                 /* First just match a string of min scans. */
3111
3112                 if (n < cc->min) {
3113                     cc->cur = n;
3114                     cc->lastloc = locinput;
3115                     if (regmatch(cc->scan))
3116                         sayYES;
3117                     cc->cur = n - 1;
3118                     cc->lastloc = lastloc;
3119                     sayNO;
3120                 }
3121
3122                 if (scan->flags) {
3123                     /* Check whether we already were at this position.
3124                         Postpone detection until we know the match is not
3125                         *that* much linear. */
3126                 if (!PL_reg_maxiter) {
3127                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3128                     PL_reg_leftiter = PL_reg_maxiter;
3129                 }
3130                 if (PL_reg_leftiter-- == 0) {
3131                     I32 size = (PL_reg_maxiter + 7)/8;
3132                     if (PL_reg_poscache) {
3133                         if ((I32)PL_reg_poscache_size < size) {
3134                             Renew(PL_reg_poscache, size, char);
3135                             PL_reg_poscache_size = size;
3136                         }
3137                         Zero(PL_reg_poscache, size, char);
3138                     }
3139                     else {
3140                         PL_reg_poscache_size = size;
3141                         Newz(29, PL_reg_poscache, size, char);
3142                     }
3143                     DEBUG_r(
3144                         PerlIO_printf(Perl_debug_log,
3145               "%sDetected a super-linear match, switching on caching%s...\n",
3146                                       PL_colors[4], PL_colors[5])
3147                         );
3148                 }
3149                 if (PL_reg_leftiter < 0) {
3150                     I32 o = locinput - PL_bostr, b;
3151
3152                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
3153                     b = o % 8;
3154                     o /= 8;
3155                     if (PL_reg_poscache[o] & (1<<b)) {
3156                     DEBUG_r(
3157                         PerlIO_printf(Perl_debug_log,
3158                                       "%*s  already tried at this position...\n",
3159                                       REPORT_CODE_OFF+PL_regindent*2, "")
3160                         );
3161                         sayNO_SILENT;
3162                     }
3163                     PL_reg_poscache[o] |= (1<<b);
3164                 }
3165                 }
3166
3167                 /* Prefer next over scan for minimal matching. */
3168
3169                 if (cc->minmod) {
3170                     PL_regcc = cc->oldcc;
3171                     if (PL_regcc)
3172                         ln = PL_regcc->cur;
3173                     cp = regcppush(cc->parenfloor);
3174                     REGCP_SET(lastcp);
3175                     if (regmatch(cc->next)) {
3176                         regcpblow(cp);
3177                         sayYES; /* All done. */
3178                     }
3179                     REGCP_UNWIND(lastcp);
3180                     regcppop();
3181                     if (PL_regcc)
3182                         PL_regcc->cur = ln;
3183                     PL_regcc = cc;
3184
3185                     if (n >= cc->max) { /* Maximum greed exceeded? */
3186                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3187                             && !(PL_reg_flags & RF_warned)) {
3188                             PL_reg_flags |= RF_warned;
3189                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3190                                  "Complex regular subexpression recursion",
3191                                  REG_INFTY - 1);
3192                         }
3193                         sayNO;
3194                     }
3195
3196                     DEBUG_r(
3197                         PerlIO_printf(Perl_debug_log,
3198                                       "%*s  trying longer...\n",
3199                                       REPORT_CODE_OFF+PL_regindent*2, "")
3200                         );
3201                     /* Try scanning more and see if it helps. */
3202                     PL_reginput = locinput;
3203                     cc->cur = n;
3204                     cc->lastloc = locinput;
3205                     cp = regcppush(cc->parenfloor);
3206                     REGCP_SET(lastcp);
3207                     if (regmatch(cc->scan)) {
3208                         regcpblow(cp);
3209                         sayYES;
3210                     }
3211                     REGCP_UNWIND(lastcp);
3212                     regcppop();
3213                     cc->cur = n - 1;
3214                     cc->lastloc = lastloc;
3215                     sayNO;
3216                 }
3217
3218                 /* Prefer scan over next for maximal matching. */
3219
3220                 if (n < cc->max) {      /* More greed allowed? */
3221                     cp = regcppush(cc->parenfloor);
3222                     cc->cur = n;
3223                     cc->lastloc = locinput;
3224                     REGCP_SET(lastcp);
3225                     if (regmatch(cc->scan)) {
3226                         regcpblow(cp);
3227                         sayYES;
3228                     }
3229                     REGCP_UNWIND(lastcp);
3230                     regcppop();         /* Restore some previous $<digit>s? */
3231                     PL_reginput = locinput;
3232                     DEBUG_r(
3233                         PerlIO_printf(Perl_debug_log,
3234                                       "%*s  failed, try continuation...\n",
3235                                       REPORT_CODE_OFF+PL_regindent*2, "")
3236                         );
3237                 }
3238                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3239                         && !(PL_reg_flags & RF_warned)) {
3240                     PL_reg_flags |= RF_warned;
3241                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3242                          "Complex regular subexpression recursion",
3243                          REG_INFTY - 1);
3244                 }
3245
3246                 /* Failed deeper matches of scan, so see if this one works. */
3247                 PL_regcc = cc->oldcc;
3248                 if (PL_regcc)
3249                     ln = PL_regcc->cur;
3250                 if (regmatch(cc->next))
3251                     sayYES;
3252                 if (PL_regcc)
3253                     PL_regcc->cur = ln;
3254                 PL_regcc = cc;
3255                 cc->cur = n - 1;
3256                 cc->lastloc = lastloc;
3257                 sayNO;
3258             }
3259             /* NOT REACHED */
3260         case BRANCHJ:
3261             next = scan + ARG(scan);
3262             if (next == scan)
3263                 next = NULL;
3264             inner = NEXTOPER(NEXTOPER(scan));
3265             goto do_branch;
3266         case BRANCH:
3267             inner = NEXTOPER(scan);
3268           do_branch:
3269             {
3270                 c1 = OP(scan);
3271                 if (OP(next) != c1)     /* No choice. */
3272                     next = inner;       /* Avoid recursion. */
3273                 else {
3274                     I32 lastparen = *PL_reglastparen;
3275                     I32 unwind1;
3276                     re_unwind_branch_t *uw;
3277
3278                     /* Put unwinding data on stack */
3279                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3280                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3281                     uw->prev = unwind;
3282                     unwind = unwind1;
3283                     uw->type = ((c1 == BRANCH)
3284                                 ? RE_UNWIND_BRANCH
3285                                 : RE_UNWIND_BRANCHJ);
3286                     uw->lastparen = lastparen;
3287                     uw->next = next;
3288                     uw->locinput = locinput;
3289                     uw->nextchr = nextchr;
3290 #ifdef DEBUGGING
3291                     uw->regindent = ++PL_regindent;
3292 #endif
3293
3294                     REGCP_SET(uw->lastcp);
3295
3296                     /* Now go into the first branch */
3297                     next = inner;
3298                 }
3299             }
3300             break;
3301         case MINMOD:
3302             minmod = 1;
3303             break;
3304         case CURLYM:
3305         {
3306             I32 l = 0;
3307             CHECKPOINT lastcp;
3308         
3309             /* We suppose that the next guy does not need
3310                backtracking: in particular, it is of constant length,
3311                and has no parenths to influence future backrefs. */
3312             ln = ARG1(scan);  /* min to match */
3313             n  = ARG2(scan);  /* max to match */
3314             paren = scan->flags;
3315             if (paren) {
3316                 if (paren > PL_regsize)
3317                     PL_regsize = paren;
3318                 if (paren > (I32)*PL_reglastparen)
3319                     *PL_reglastparen = paren;
3320             }
3321             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3322             if (paren)
3323                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3324             PL_reginput = locinput;
3325             if (minmod) {
3326                 minmod = 0;
3327                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3328                     sayNO;
3329                 /* if we matched something zero-length we don't need to
3330                    backtrack - capturing parens are already defined, so
3331                    the caveat in the maximal case doesn't apply
3332
3333                    XXXX if ln == 0, we can redo this check first time
3334                    through the following loop
3335                 */
3336                 if (ln && l == 0)
3337                     n = ln;     /* don't backtrack */
3338                 locinput = PL_reginput;
3339                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3340                     regnode *text_node = next;
3341
3342                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3343
3344                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3345                     else {
3346                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3347                             I32 n, ln;
3348                             n = ARG(text_node);  /* which paren pair */
3349                             ln = PL_regstartp[n];
3350                             /* assume yes if we haven't seen CLOSEn */
3351                             if (
3352                                 (I32)*PL_reglastparen < n ||
3353                                 ln == -1 ||
3354                                 ln == PL_regendp[n]
3355                             ) {
3356                                 c1 = c2 = -1000;
3357                                 goto assume_ok_MM;
3358                             }
3359                             c1 = *(PL_bostr + ln);
3360                         }
3361                         else { c1 = (U8)*STRING(text_node); }
3362                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3363                             c2 = PL_fold[c1];
3364                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3365                             c2 = PL_fold_locale[c1];
3366                         else
3367                             c2 = c1;
3368                     }
3369                 }
3370                 else
3371                     c1 = c2 = -1000;
3372             assume_ok_MM:
3373                 REGCP_SET(lastcp);
3374                 /* This may be improved if l == 0.  */
3375                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3376                     /* If it could work, try it. */
3377                     if (c1 == -1000 ||
3378                         UCHARAT(PL_reginput) == c1 ||
3379                         UCHARAT(PL_reginput) == c2)
3380                     {
3381                         if (paren) {
3382                             if (ln) {
3383                                 PL_regstartp[paren] =
3384                                     HOPc(PL_reginput, -l) - PL_bostr;
3385                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3386                             }
3387                             else
3388                                 PL_regendp[paren] = -1;
3389                         }
3390                         if (regmatch(next))
3391                             sayYES;
3392                         REGCP_UNWIND(lastcp);
3393                     }
3394                     /* Couldn't or didn't -- move forward. */
3395                     PL_reginput = locinput;
3396                     if (regrepeat_hard(scan, 1, &l)) {
3397                         ln++;
3398                         locinput = PL_reginput;
3399                     }
3400                     else
3401                         sayNO;
3402                 }
3403             }
3404             else {
3405                 n = regrepeat_hard(scan, n, &l);
3406                 /* if we matched something zero-length we don't need to
3407                    backtrack, unless the minimum count is zero and we
3408                    are capturing the result - in that case the capture
3409                    being defined or not may affect later execution
3410                 */
3411                 if (n != 0 && l == 0 && !(paren && ln == 0))
3412                     ln = n;     /* don't backtrack */
3413                 locinput = PL_reginput;
3414                 DEBUG_r(
3415                     PerlIO_printf(Perl_debug_log,
3416                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3417                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3418                                   (IV) n, (IV)l)
3419                     );
3420                 if (n >= ln) {
3421                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3422                         regnode *text_node = next;
3423
3424                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3425
3426                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3427                         else {
3428                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3429                                 I32 n, ln;
3430                                 n = ARG(text_node);  /* which paren pair */
3431                                 ln = PL_regstartp[n];
3432                                 /* assume yes if we haven't seen CLOSEn */
3433                                 if (
3434                                     (I32)*PL_reglastparen < n ||
3435                                     ln == -1 ||
3436                                     ln == PL_regendp[n]
3437                                 ) {
3438                                     c1 = c2 = -1000;
3439                                     goto assume_ok_REG;
3440                                 }
3441                                 c1 = *(PL_bostr + ln);
3442                             }
3443                             else { c1 = (U8)*STRING(text_node); }
3444
3445                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3446                                 c2 = PL_fold[c1];
3447                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3448                                 c2 = PL_fold_locale[c1];
3449                             else
3450                                 c2 = c1;
3451                         }
3452                     }
3453                     else
3454                         c1 = c2 = -1000;
3455                 }
3456             assume_ok_REG:
3457                 REGCP_SET(lastcp);
3458                 while (n >= ln) {
3459                     /* If it could work, try it. */
3460                     if (c1 == -1000 ||
3461                         UCHARAT(PL_reginput) == c1 ||
3462                         UCHARAT(PL_reginput) == c2)
3463                     {
3464                         DEBUG_r(
3465                                 PerlIO_printf(Perl_debug_log,
3466                                               "%*s  trying tail with n=%"IVdf"...\n",
3467                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3468                             );
3469                         if (paren) {
3470                             if (n) {
3471                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3472                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3473                             }
3474                             else
3475                                 PL_regendp[paren] = -1;
3476                         }
3477                         if (regmatch(next))
3478                             sayYES;
3479                         REGCP_UNWIND(lastcp);
3480                     }
3481                     /* Couldn't or didn't -- back up. */
3482                     n--;
3483                     locinput = HOPc(locinput, -l);
3484                     PL_reginput = locinput;
3485                 }
3486             }
3487             sayNO;
3488             break;
3489         }
3490         case CURLYN:
3491             paren = scan->flags;        /* Which paren to set */
3492             if (paren > PL_regsize)
3493                 PL_regsize = paren;
3494             if (paren > (I32)*PL_reglastparen)
3495                 *PL_reglastparen = paren;
3496             ln = ARG1(scan);  /* min to match */
3497             n  = ARG2(scan);  /* max to match */
3498             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3499             goto repeat;
3500         case CURLY:
3501             paren = 0;
3502             ln = ARG1(scan);  /* min to match */
3503             n  = ARG2(scan);  /* max to match */
3504             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3505             goto repeat;
3506         case STAR:
3507             ln = 0;
3508             n = REG_INFTY;
3509             scan = NEXTOPER(scan);
3510             paren = 0;
3511             goto repeat;
3512         case PLUS:
3513             ln = 1;
3514             n = REG_INFTY;
3515             scan = NEXTOPER(scan);
3516             paren = 0;
3517           repeat:
3518             /*
3519             * Lookahead to avoid useless match attempts
3520             * when we know what character comes next.
3521             */
3522
3523             /*
3524             * Used to only do .*x and .*?x, but now it allows
3525             * for )'s, ('s and (?{ ... })'s to be in the way
3526             * of the quantifier and the EXACT-like node.  -- japhy
3527             */
3528
3529             if (HAS_TEXT(next) || JUMPABLE(next)) {
3530                 U8 *s;
3531                 regnode *text_node = next;
3532
3533                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3534
3535                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3536                 else {
3537                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3538                         I32 n, ln;
3539                         n = ARG(text_node);  /* which paren pair */
3540                         ln = PL_regstartp[n];
3541                         /* assume yes if we haven't seen CLOSEn */
3542                         if (
3543                             (I32)*PL_reglastparen < n ||
3544                             ln == -1 ||
3545                             ln == PL_regendp[n]
3546                         ) {
3547                             c1 = c2 = -1000;
3548                             goto assume_ok_easy;
3549                         }
3550                         s = (U8*)PL_bostr + ln;
3551                     }
3552                     else { s = (U8*)STRING(text_node); }
3553
3554                     if (!UTF) {
3555                         c2 = c1 = *s;
3556                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3557                             c2 = PL_fold[c1];
3558                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3559                             c2 = PL_fold_locale[c1];
3560                     }
3561                     else { /* UTF */
3562                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3563                              STRLEN ulen1, ulen2;
3564                              U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
3565                              U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
3566
3567                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3568                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3569
3570                              c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXLEN, 0,
3571                                                  ckWARN(WARN_UTF8) ?
3572                                                  0 : UTF8_ALLOW_ANY);
3573                              c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXLEN, 0,
3574                                                  ckWARN(WARN_UTF8) ?
3575                                                  0 : UTF8_ALLOW_ANY);
3576                         }
3577                         else {
3578                             c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXLEN, 0,
3579                                                      ckWARN(WARN_UTF8) ?
3580                                                      0 : UTF8_ALLOW_ANY);
3581                         }
3582                     }
3583                 }
3584             }
3585             else
3586                 c1 = c2 = -1000;
3587         assume_ok_easy:
3588             PL_reginput = locinput;
3589             if (minmod) {
3590                 CHECKPOINT lastcp;
3591                 minmod = 0;
3592                 if (ln && regrepeat(scan, ln) < ln)
3593                     sayNO;
3594                 locinput = PL_reginput;
3595                 REGCP_SET(lastcp);
3596                 if (c1 != -1000) {
3597                     char *e; /* Should not check after this */
3598                     char *old = locinput;
3599                     int count = 0;
3600
3601                     if  (n == REG_INFTY) {
3602                         e = PL_regeol - 1;
3603                         if (do_utf8)
3604                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3605                                 e--;
3606                     }
3607                     else if (do_utf8) {
3608                         int m = n - ln;
3609                         for (e = locinput;
3610                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3611                             e += UTF8SKIP(e);
3612                     }
3613                     else {
3614                         e = locinput + n - ln;
3615                         if (e >= PL_regeol)
3616                             e = PL_regeol - 1;
3617                     }
3618                     while (1) {
3619                         /* Find place 'next' could work */
3620                         if (!do_utf8) {
3621                             if (c1 == c2) {
3622                                 while (locinput <= e &&
3623                                        UCHARAT(locinput) != c1)
3624                                     locinput++;
3625                             } else {
3626                                 while (locinput <= e
3627                                        && UCHARAT(locinput) != c1
3628                                        && UCHARAT(locinput) != c2)
3629                                     locinput++;
3630                             }
3631                             count = locinput - old;
3632                         }
3633                         else {
3634                             STRLEN len;
3635                             if (c1 == c2) {
3636                                 /* count initialised to
3637                                  * utf8_distance(old, locinput) */
3638                                 while (locinput <= e &&
3639                                        utf8n_to_uvchr((U8*)locinput,
3640                                                       UTF8_MAXLEN, &len,
3641                                                       ckWARN(WARN_UTF8) ?
3642                                                       0 : UTF8_ALLOW_ANY) != (UV)c1) {
3643                                     locinput += len;
3644                                     count++;
3645                                 }
3646                             } else {
3647                                 /* count initialised to
3648                                  * utf8_distance(old, locinput) */
3649                                 while (locinput <= e) {
3650                                     UV c = utf8n_to_uvchr((U8*)locinput,
3651                                                           UTF8_MAXLEN, &len,
3652                                                           ckWARN(WARN_UTF8) ?
3653                                                           0 : UTF8_ALLOW_ANY);
3654                                     if (c == (UV)c1 || c == (UV)c2)
3655                                         break;
3656                                     locinput += len;
3657                                     count++;
3658                                 }
3659                             }
3660                         }
3661                         if (locinput > e)
3662                             sayNO;
3663                         /* PL_reginput == old now */
3664                         if (locinput != old) {
3665                             ln = 1;     /* Did some */
3666                             if (regrepeat(scan, count) < count)
3667                                 sayNO;
3668                         }
3669                         /* PL_reginput == locinput now */
3670                         TRYPAREN(paren, ln, locinput);
3671                         PL_reginput = locinput; /* Could be reset... */
3672                         REGCP_UNWIND(lastcp);
3673                         /* Couldn't or didn't -- move forward. */
3674                         old = locinput;
3675                         if (do_utf8)
3676                             locinput += UTF8SKIP(locinput);
3677                         else
3678                             locinput++;
3679                         count = 1;
3680                     }
3681                 }
3682                 else
3683                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3684                     UV c;
3685                     if (c1 != -1000) {
3686                         if (do_utf8)
3687                             c = utf8n_to_uvchr((U8*)PL_reginput,
3688                                                UTF8_MAXLEN, 0,
3689                                                ckWARN(WARN_UTF8) ?
3690                                                0 : UTF8_ALLOW_ANY);
3691                         else
3692                             c = UCHARAT(PL_reginput);
3693                         /* If it could work, try it. */
3694                         if (c == (UV)c1 || c == (UV)c2)
3695                         {
3696                             TRYPAREN(paren, ln, PL_reginput);
3697                             REGCP_UNWIND(lastcp);
3698                         }
3699                     }
3700                     /* If it could work, try it. */
3701                     else if (c1 == -1000)
3702                     {
3703                         TRYPAREN(paren, ln, PL_reginput);
3704                         REGCP_UNWIND(lastcp);
3705                     }
3706                     /* Couldn't or didn't -- move forward. */
3707                     PL_reginput = locinput;
3708                     if (regrepeat(scan, 1)) {
3709                         ln++;
3710                         locinput = PL_reginput;
3711                     }
3712                     else
3713                         sayNO;
3714                 }
3715             }
3716             else {
3717                 CHECKPOINT lastcp;
3718                 n = regrepeat(scan, n);
3719                 locinput = PL_reginput;
3720                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3721                     ((!PL_multiline && OP(next) != MEOL) ||
3722                         OP(next) == SEOL || OP(next) == EOS))
3723                 {
3724                     ln = n;                     /* why back off? */
3725                     /* ...because $ and \Z can match before *and* after
3726                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3727                        We should back off by one in this case. */
3728                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3729                         ln--;
3730                 }
3731                 REGCP_SET(lastcp);
3732                 if (paren) {
3733                     UV c = 0;
3734                     while (n >= ln) {
3735                         if (c1 != -1000) {
3736                             if (do_utf8)
3737                                 c = utf8n_to_uvchr((U8*)PL_reginput,
3738                                                    UTF8_MAXLEN, 0,
3739                                                    ckWARN(WARN_UTF8) ?
3740                                                    0 : UTF8_ALLOW_ANY);
3741                             else
3742                                 c = UCHARAT(PL_reginput);
3743                         }
3744                         /* If it could work, try it. */
3745                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
3746                             {
3747                                 TRYPAREN(paren, n, PL_reginput);
3748                                 REGCP_UNWIND(lastcp);
3749                             }
3750                         /* Couldn't or didn't -- back up. */
3751                         n--;
3752                         PL_reginput = locinput = HOPc(locinput, -1);
3753                     }
3754                 }
3755                 else {
3756                     UV c = 0;
3757                     while (n >= ln) {
3758                         if (c1 != -1000) {
3759                             if (do_utf8)
3760                                 c = utf8n_to_uvchr((U8*)PL_reginput,
3761                                                    UTF8_MAXLEN, 0,
3762                                                    ckWARN(WARN_UTF8) ?
3763                                                    0 : UTF8_ALLOW_ANY);
3764                             else
3765                                 c = UCHARAT(PL_reginput);
3766                         }
3767                         /* If it could work, try it. */
3768                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
3769                             {
3770                                 TRYPAREN(paren, n, PL_reginput);
3771                                 REGCP_UNWIND(lastcp);
3772                             }
3773                         /* Couldn't or didn't -- back up. */
3774                         n--;
3775                         PL_reginput = locinput = HOPc(locinput, -1);
3776                     }
3777                 }
3778             }
3779             sayNO;
3780             break;
3781         case END:
3782             if (PL_reg_call_cc) {
3783                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3784                 CURCUR *cctmp = PL_regcc;
3785                 regexp *re = PL_reg_re;
3786                 CHECKPOINT cp, lastcp;
3787                 
3788                 cp = regcppush(0);      /* Save *all* the positions. */
3789                 REGCP_SET(lastcp);
3790                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3791                                                     the caller. */
3792                 PL_reginput = locinput; /* Make position available to
3793                                            the callcc. */
3794                 cache_re(PL_reg_call_cc->re);
3795                 PL_regcc = PL_reg_call_cc->cc;
3796                 PL_reg_call_cc = PL_reg_call_cc->prev;
3797                 if (regmatch(cur_call_cc->node)) {
3798                     PL_reg_call_cc = cur_call_cc;
3799                     regcpblow(cp);
3800                     sayYES;
3801                 }
3802                 REGCP_UNWIND(lastcp);
3803                 regcppop();
3804                 PL_reg_call_cc = cur_call_cc;
3805                 PL_regcc = cctmp;
3806                 PL_reg_re = re;
3807                 cache_re(re);
3808
3809                 DEBUG_r(
3810                     PerlIO_printf(Perl_debug_log,
3811                                   "%*s  continuation failed...\n",
3812                                   REPORT_CODE_OFF+PL_regindent*2, "")
3813                     );
3814                 sayNO_SILENT;
3815             }
3816             if (locinput < PL_regtill) {
3817                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3818                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3819                                       PL_colors[4],
3820                                       (long)(locinput - PL_reg_starttry),
3821                                       (long)(PL_regtill - PL_reg_starttry),
3822                                       PL_colors[5]));
3823                 sayNO_FINAL;            /* Cannot match: too short. */
3824             }
3825             PL_reginput = locinput;     /* put where regtry can find it */
3826             sayYES_FINAL;               /* Success! */
3827         case SUCCEED:
3828             PL_reginput = locinput;     /* put where regtry can find it */
3829             sayYES_LOUD;                /* Success! */
3830         case SUSPEND:
3831             n = 1;
3832             PL_reginput = locinput;
3833             goto do_ifmatch;    
3834         case UNLESSM:
3835             n = 0;
3836             if (scan->flags) {
3837                 s = HOPBACKc(locinput, scan->flags);
3838                 if (!s)
3839                     goto say_yes;
3840                 PL_reginput = s;
3841             }
3842             else
3843                 PL_reginput = locinput;
3844             goto do_ifmatch;
3845         case IFMATCH:
3846             n = 1;
3847             if (scan->flags) {
3848                 s = HOPBACKc(locinput, scan->flags);
3849                 if (!s)
3850                     goto say_no;
3851                 PL_reginput = s;
3852             }
3853             else
3854                 PL_reginput = locinput;
3855
3856           do_ifmatch:
3857             inner = NEXTOPER(NEXTOPER(scan));
3858             if (regmatch(inner) != n) {
3859               say_no:
3860                 if (logical) {
3861                     logical = 0;
3862                     sw = 0;
3863                     goto do_longjump;
3864                 }
3865                 else
3866                     sayNO;
3867             }
3868           say_yes:
3869             if (logical) {
3870                 logical = 0;
3871                 sw = 1;
3872             }
3873             if (OP(scan) == SUSPEND) {
3874                 locinput = PL_reginput;
3875                 nextchr = UCHARAT(locinput);
3876             }
3877             /* FALL THROUGH. */
3878         case LONGJMP:
3879           do_longjump:
3880             next = scan + ARG(scan);
3881             if (next == scan)
3882                 next = NULL;
3883             break;
3884         default:
3885             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3886                           PTR2UV(scan), OP(scan));
3887             Perl_croak(aTHX_ "regexp memory corruption");
3888         }
3889       reenter:
3890         scan = next;
3891     }
3892
3893     /*
3894     * We get here only if there's trouble -- normally "case END" is
3895     * the terminating point.
3896     */
3897     Perl_croak(aTHX_ "corrupted regexp pointers");
3898     /*NOTREACHED*/
3899     sayNO;
3900
3901 yes_loud:
3902     DEBUG_r(
3903         PerlIO_printf(Perl_debug_log,
3904                       "%*s  %scould match...%s\n",
3905                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3906         );
3907     goto yes;
3908 yes_final:
3909     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3910                           PL_colors[4],PL_colors[5]));
3911 yes:
3912 #ifdef DEBUGGING
3913     PL_regindent--;
3914 #endif
3915
3916 #if 0                                   /* Breaks $^R */
3917     if (unwind)
3918         regcpblow(firstcp);
3919 #endif
3920     return 1;
3921
3922 no:
3923     DEBUG_r(
3924         PerlIO_printf(Perl_debug_log,
3925                       "%*s  %sfailed...%s\n",
3926                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3927         );
3928     goto do_no;
3929 no_final:
3930 do_no:
3931     if (unwind) {
3932         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3933
3934         switch (uw->type) {
3935         case RE_UNWIND_BRANCH:
3936         case RE_UNWIND_BRANCHJ:
3937         {
3938             re_unwind_branch_t *uwb = &(uw->branch);
3939             I32 lastparen = uwb->lastparen;
3940         
3941             REGCP_UNWIND(uwb->lastcp);
3942             for (n = *PL_reglastparen; n > lastparen; n--)
3943                 PL_regendp[n] = -1;
3944             *PL_reglastparen = n;
3945             scan = next = uwb->next;
3946             if ( !scan ||
3947                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3948                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3949                 unwind = uwb->prev;
3950 #ifdef DEBUGGING
3951                 PL_regindent--;
3952 #endif
3953                 goto do_no;
3954             }
3955             /* Have more choice yet.  Reuse the same uwb.  */
3956             /*SUPPRESS 560*/
3957             if ((n = (uwb->type == RE_UNWIND_BRANCH
3958                       ? NEXT_OFF(next) : ARG(next))))
3959                 next += n;
3960             else
3961                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3962             uwb->next = next;
3963             next = NEXTOPER(scan);
3964             if (uwb->type == RE_UNWIND_BRANCHJ)
3965                 next = NEXTOPER(next);
3966             locinput = uwb->locinput;
3967             nextchr = uwb->nextchr;
3968 #ifdef DEBUGGING
3969             PL_regindent = uwb->regindent;
3970 #endif
3971
3972             goto reenter;
3973         }
3974         /* NOT REACHED */
3975         default:
3976             Perl_croak(aTHX_ "regexp unwind memory corruption");
3977         }
3978         /* NOT REACHED */
3979     }
3980 #ifdef DEBUGGING
3981     PL_regindent--;
3982 #endif
3983     return 0;
3984 }
3985
3986 /*
3987  - regrepeat - repeatedly match something simple, report how many
3988  */
3989 /*
3990  * [This routine now assumes that it will only match on things of length 1.
3991  * That was true before, but now we assume scan - reginput is the count,
3992  * rather than incrementing count on every character.  [Er, except utf8.]]
3993  */
3994 STATIC I32
3995 S_regrepeat(pTHX_ regnode *p, I32 max)
3996 {
3997     register char *scan;
3998     register I32 c;
3999     register char *loceol = PL_regeol;
4000     register I32 hardcount = 0;
4001     register bool do_utf8 = PL_reg_match_utf8;
4002
4003     scan = PL_reginput;
4004     if (max == REG_INFTY)
4005         max = I32_MAX;
4006     else if (max < loceol - scan)
4007       loceol = scan + max;
4008     switch (OP(p)) {
4009     case REG_ANY:
4010         if (do_utf8) {
4011             loceol = PL_regeol;
4012             while (scan < loceol && hardcount < max && *scan != '\n') {
4013                 scan += UTF8SKIP(scan);
4014                 hardcount++;
4015             }
4016         } else {
4017             while (scan < loceol && *scan != '\n')
4018                 scan++;
4019         }
4020         break;
4021     case SANY:
4022         if (do_utf8) {
4023             loceol = PL_regeol;
4024             while (scan < loceol && hardcount < max) {
4025                 scan += UTF8SKIP(scan);
4026                 hardcount++;
4027             }
4028         }
4029         else
4030             scan = loceol;
4031         break;
4032     case CANY:
4033         scan = loceol;
4034         break;
4035     case EXACT:         /* length of string is 1 */
4036         c = (U8)*STRING(p);
4037         while (scan < loceol && UCHARAT(scan) == c)
4038             scan++;
4039         break;
4040     case EXACTF:        /* length of string is 1 */
4041         c = (U8)*STRING(p);
4042         while (scan < loceol &&
4043                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4044             scan++;
4045         break;
4046     case EXACTFL:       /* length of string is 1 */
4047         PL_reg_flags |= RF_tainted;
4048         c = (U8)*STRING(p);
4049         while (scan < loceol &&
4050                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4051             scan++;
4052         break;
4053     case ANYOF:
4054         if (do_utf8) {
4055             loceol = PL_regeol;
4056             while (hardcount < max && scan < loceol &&
4057                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4058                 scan += UTF8SKIP(scan);
4059                 hardcount++;
4060             }
4061         } else {
4062             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4063                 scan++;
4064         }
4065         break;
4066     case ALNUM:
4067         if (do_utf8) {
4068             loceol = PL_regeol;
4069             LOAD_UTF8_CHARCLASS(alnum,"a");
4070             while (hardcount < max && scan < loceol &&
4071                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4072                 scan += UTF8SKIP(scan);
4073                 hardcount++;
4074             }
4075         } else {
4076             while (scan < loceol && isALNUM(*scan))
4077                 scan++;
4078         }
4079         break;
4080     case ALNUML:
4081         PL_reg_flags |= RF_tainted;
4082         if (do_utf8) {
4083             loceol = PL_regeol;
4084             while (hardcount < max && scan < loceol &&
4085                    isALNUM_LC_utf8((U8*)scan)) {
4086                 scan += UTF8SKIP(scan);
4087                 hardcount++;
4088             }
4089         } else {
4090             while (scan < loceol && isALNUM_LC(*scan))
4091                 scan++;
4092         }
4093         break;
4094     case NALNUM:
4095         if (do_utf8) {
4096             loceol = PL_regeol;
4097             LOAD_UTF8_CHARCLASS(alnum,"a");
4098             while (hardcount < max && scan < loceol &&
4099                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4100                 scan += UTF8SKIP(scan);
4101                 hardcount++;
4102             }
4103         } else {
4104             while (scan < loceol && !isALNUM(*scan))
4105                 scan++;
4106         }
4107         break;
4108     case NALNUML:
4109         PL_reg_flags |= RF_tainted;
4110         if (do_utf8) {
4111             loceol = PL_regeol;
4112             while (hardcount < max && scan < loceol &&
4113                    !isALNUM_LC_utf8((U8*)scan)) {
4114                 scan += UTF8SKIP(scan);
4115                 hardcount++;
4116             }
4117         } else {
4118             while (scan < loceol && !isALNUM_LC(*scan))
4119                 scan++;
4120         }
4121         break;
4122     case SPACE:
4123         if (do_utf8) {
4124             loceol = PL_regeol;
4125             LOAD_UTF8_CHARCLASS(space," ");
4126             while (hardcount < max && scan < loceol &&
4127                    (*scan == ' ' ||
4128                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4129                 scan += UTF8SKIP(scan);
4130                 hardcount++;
4131             }
4132         } else {
4133             while (scan < loceol && isSPACE(*scan))
4134                 scan++;
4135         }
4136         break;
4137     case SPACEL:
4138         PL_reg_flags |= RF_tainted;
4139         if (do_utf8) {
4140             loceol = PL_regeol;
4141             while (hardcount < max && scan < loceol &&
4142                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4143                 scan += UTF8SKIP(scan);
4144                 hardcount++;
4145             }
4146         } else {
4147             while (scan < loceol && isSPACE_LC(*scan))
4148                 scan++;
4149         }
4150         break;
4151     case NSPACE:
4152         if (do_utf8) {
4153             loceol = PL_regeol;
4154             LOAD_UTF8_CHARCLASS(space," ");
4155             while (hardcount < max && scan < loceol &&
4156                    !(*scan == ' ' ||
4157                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4158                 scan += UTF8SKIP(scan);
4159                 hardcount++;
4160             }
4161         } else {
4162             while (scan < loceol && !isSPACE(*scan))
4163                 scan++;
4164             break;
4165         }
4166     case NSPACEL:
4167         PL_reg_flags |= RF_tainted;
4168         if (do_utf8) {
4169             loceol = PL_regeol;
4170             while (hardcount < max && scan < loceol &&
4171                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4172                 scan += UTF8SKIP(scan);
4173                 hardcount++;
4174             }
4175         } else {
4176             while (scan < loceol && !isSPACE_LC(*scan))
4177                 scan++;
4178         }
4179         break;
4180     case DIGIT:
4181         if (do_utf8) {
4182             loceol = PL_regeol;
4183             LOAD_UTF8_CHARCLASS(digit,"0");
4184             while (hardcount < max && scan < loceol &&
4185                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4186                 scan += UTF8SKIP(scan);
4187                 hardcount++;
4188             }
4189         } else {
4190             while (scan < loceol && isDIGIT(*scan))
4191                 scan++;
4192         }
4193         break;
4194     case NDIGIT:
4195         if (do_utf8) {
4196             loceol = PL_regeol;
4197             LOAD_UTF8_CHARCLASS(digit,"0");
4198             while (hardcount < max && scan < loceol &&
4199                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4200                 scan += UTF8SKIP(scan);
4201                 hardcount++;
4202             }
4203         } else {
4204             while (scan < loceol && !isDIGIT(*scan))
4205                 scan++;
4206         }
4207         break;
4208     default:            /* Called on something of 0 width. */
4209         break;          /* So match right here or not at all. */
4210     }
4211
4212     if (hardcount)
4213         c = hardcount;
4214     else
4215         c = scan - PL_reginput;
4216     PL_reginput = scan;
4217
4218     DEBUG_r(
4219         {
4220                 SV *prop = sv_newmortal();
4221
4222                 regprop(prop, p);
4223                 PerlIO_printf(Perl_debug_log,
4224                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4225                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
4226         });
4227
4228     return(c);
4229 }
4230
4231 /*
4232  - regrepeat_hard - repeatedly match something, report total lenth and length
4233  *
4234  * The repeater is supposed to have constant length.
4235  */
4236
4237 STATIC I32
4238 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4239 {
4240     register char *scan = Nullch;
4241     register char *start;
4242     register char *loceol = PL_regeol;
4243     I32 l = 0;
4244     I32 count = 0, res = 1;
4245
4246     if (!max)
4247         return 0;
4248
4249     start = PL_reginput;
4250     if (PL_reg_match_utf8) {
4251         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4252             if (!count++) {
4253                 l = 0;
4254                 while (start < PL_reginput) {
4255                     l++;
4256                     start += UTF8SKIP(start);
4257                 }
4258                 *lp = l;
4259                 if (l == 0)
4260                     return max;
4261             }
4262             if (count == max)
4263                 return count;
4264         }
4265     }
4266     else {
4267         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4268             if (!count++) {
4269                 *lp = l = PL_reginput - start;
4270                 if (max != REG_INFTY && l*max < loceol - scan)
4271                     loceol = scan + l*max;
4272                 if (l == 0)
4273                     return max;
4274             }
4275         }
4276     }
4277     if (!res)
4278         PL_reginput = scan;
4279
4280     return count;
4281 }
4282
4283 /*
4284 - regclass_swash - prepare the utf8 swash
4285 */
4286
4287 SV *
4288 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4289 {
4290     SV *sw  = NULL;
4291     SV *si  = NULL;
4292     SV *alt = NULL;
4293
4294     if (PL_regdata && PL_regdata->count) {
4295         U32 n = ARG(node);
4296
4297         if (PL_regdata->what[n] == 's') {
4298             SV *rv = (SV*)PL_regdata->data[n];
4299             AV *av = (AV*)SvRV((SV*)rv);
4300             SV **ary = AvARRAY(av);
4301             SV **a, **b;
4302         
4303             /* See the end of regcomp.c:S_reglass() for
4304              * documentation of these array elements. */
4305
4306             si = *ary;
4307             a  = SvTYPE(ary[1]) == SVt_RV   ? &ary[1] : 0;
4308             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4309
4310             if (a)
4311                 sw = *a;
4312             else if (si && doinit) {
4313                 sw = swash_init("utf8", "", si, 1, 0);
4314                 (void)av_store(av, 1, sw);
4315             }
4316             if (b)
4317                 alt = *b;
4318         }
4319     }
4320         
4321     if (listsvp)
4322         *listsvp = si;
4323     if (altsvp)
4324         *altsvp  = alt;
4325
4326     return sw;
4327 }
4328
4329 /*
4330  - reginclass - determine if a character falls into a character class
4331  
4332   The n is the ANYOF regnode, the p is the target string, lenp
4333   is pointer to the maximum length of how far to go in the p
4334   (if the lenp is zero, UTF8SKIP(p) is used),
4335   do_utf8 tells whether the target string is in UTF-8.
4336
4337  */
4338
4339 STATIC bool
4340 S_reginclass(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register bool do_utf8)
4341 {
4342     char flags = ANYOF_FLAGS(n);
4343     bool match = FALSE;
4344     UV c = *p;
4345     STRLEN len = 0;
4346     STRLEN plen;
4347
4348     if (do_utf8 && !UTF8_IS_INVARIANT(c))
4349          c = utf8n_to_uvchr(p, UTF8_MAXLEN, &len,
4350                             ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
4351
4352     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4353     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4354         if (lenp)
4355             *lenp = 0;
4356         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4357             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4358                 match = TRUE;
4359         }
4360         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4361             match = TRUE;
4362         if (!match) {
4363             AV *av;
4364             SV *sw = regclass_swash(n, TRUE, 0, (SV**)&av);
4365         
4366             if (sw) {
4367                 if (swash_fetch(sw, p, do_utf8))
4368                     match = TRUE;
4369                 else if (flags & ANYOF_FOLD) {
4370                     if (!match && lenp && av) {
4371                         I32 i;
4372                       
4373                         for (i = 0; i <= av_len(av); i++) {
4374                             SV* sv = *av_fetch(av, i, FALSE);
4375                             STRLEN len;
4376                             char *s = SvPV(sv, len);
4377                         
4378                             if (len <= plen && memEQ(s, (char*)p, len)) {
4379                                 *lenp = len;
4380                                 match = TRUE;
4381                                 break;
4382                             }
4383                         }
4384                     }
4385                     if (!match) {
4386                         U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
4387                         STRLEN tmplen;
4388
4389                         to_utf8_fold(p, tmpbuf, &tmplen);
4390                         if (swash_fetch(sw, tmpbuf, do_utf8))
4391                             match = TRUE;
4392                     }
4393                 }
4394             }
4395         }
4396         if (match && lenp && *lenp == 0)
4397             *lenp = UNISKIP(NATIVE_TO_UNI(c));
4398     }
4399     if (!match && c < 256) {
4400         if (ANYOF_BITMAP_TEST(n, c))
4401             match = TRUE;
4402         else if (flags & ANYOF_FOLD) {
4403             U8 f;
4404
4405             if (flags & ANYOF_LOCALE) {
4406                 PL_reg_flags |= RF_tainted;
4407                 f = PL_fold_locale[c];
4408             }
4409             else
4410                 f = PL_fold[c];
4411             if (f != c && ANYOF_BITMAP_TEST(n, f))
4412                 match = TRUE;
4413         }
4414         
4415         if (!match && (flags & ANYOF_CLASS)) {
4416             PL_reg_flags |= RF_tainted;
4417             if (
4418                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4419                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4420                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4421                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4422                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4423                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4424                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4425                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4426                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4427                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4428                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4429                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4430                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4431                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4432                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4433                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4434                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4435                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4436                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4437                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4438                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4439                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4440                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4441                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4442                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4443                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4444                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4445                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4446                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4447                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4448                 ) /* How's that for a conditional? */
4449             {
4450                 match = TRUE;
4451             }
4452         }
4453     }
4454
4455     return (flags & ANYOF_INVERT) ? !match : match;
4456 }
4457
4458 STATIC U8 *
4459 S_reghop(pTHX_ U8 *s, I32 off)
4460 {
4461     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4462 }
4463
4464 STATIC U8 *
4465 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4466 {
4467     if (off >= 0) {
4468         while (off-- && s < lim) {
4469             /* XXX could check well-formedness here */
4470             s += UTF8SKIP(s);
4471         }
4472     }
4473     else {
4474         while (off++) {
4475             if (s > lim) {
4476                 s--;
4477                 if (UTF8_IS_CONTINUED(*s)) {
4478                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4479                         s--;
4480                 }
4481                 /* XXX could check well-formedness here */
4482             }
4483         }
4484     }
4485     return s;
4486 }
4487
4488 STATIC U8 *
4489 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4490 {
4491     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4492 }
4493
4494 STATIC U8 *
4495 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4496 {
4497     if (off >= 0) {
4498         while (off-- && s < lim) {
4499             /* XXX could check well-formedness here */
4500             s += UTF8SKIP(s);
4501         }
4502         if (off >= 0)
4503             return 0;
4504     }
4505     else {
4506         while (off++) {
4507             if (s > lim) {
4508                 s--;
4509                 if (UTF8_IS_CONTINUED(*s)) {
4510                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4511                         s--;
4512                 }
4513                 /* XXX could check well-formedness here */
4514             }
4515             else
4516                 break;
4517         }
4518         if (off <= 0)
4519             return 0;
4520     }
4521     return s;
4522 }
4523
4524 static void
4525 restore_pos(pTHX_ void *arg)
4526 {
4527     if (PL_reg_eval_set) {
4528         if (PL_reg_oldsaved) {
4529             PL_reg_re->subbeg = PL_reg_oldsaved;
4530             PL_reg_re->sublen = PL_reg_oldsavedlen;
4531             RX_MATCH_COPIED_on(PL_reg_re);
4532         }
4533         PL_reg_magic->mg_len = PL_reg_oldpos;
4534         PL_reg_eval_set = 0;
4535         PL_curpm = PL_reg_oldcurpm;
4536     }   
4537 }
4538
4539 STATIC void
4540 S_to_utf8_substr(pTHX_ register regexp *prog)
4541 {
4542     SV* sv;
4543     if (prog->float_substr && !prog->float_utf8) {
4544         prog->float_utf8 = sv = NEWSV(117, 0);
4545         SvSetSV(sv, prog->float_substr);
4546         sv_utf8_upgrade(sv);
4547         if (SvTAIL(prog->float_substr))
4548             SvTAIL_on(sv);
4549         if (prog->float_substr == prog->check_substr)
4550             prog->check_utf8 = sv;
4551     }
4552     if (prog->anchored_substr && !prog->anchored_utf8) {
4553         prog->anchored_utf8 = sv = NEWSV(118, 0);
4554         SvSetSV(sv, prog->anchored_substr);
4555         sv_utf8_upgrade(sv);
4556         if (SvTAIL(prog->anchored_substr))
4557             SvTAIL_on(sv);
4558         if (prog->anchored_substr == prog->check_substr)
4559             prog->check_utf8 = sv;
4560     }
4561 }
4562
4563 STATIC void
4564 S_to_byte_substr(pTHX_ register regexp *prog)
4565 {
4566     SV* sv;
4567     if (prog->float_utf8 && !prog->float_substr) {
4568         prog->float_substr = sv = NEWSV(117, 0);
4569         SvSetSV(sv, prog->float_utf8);
4570         if (sv_utf8_downgrade(sv, TRUE)) {
4571             if (SvTAIL(prog->float_utf8))
4572                 SvTAIL_on(sv);
4573         } else {
4574             SvREFCNT_dec(sv);
4575             prog->float_substr = sv = &PL_sv_undef;
4576         }
4577         if (prog->float_utf8 == prog->check_utf8)
4578             prog->check_substr = sv;
4579     }
4580     if (prog->anchored_utf8 && !prog->anchored_substr) {
4581         prog->anchored_substr = sv = NEWSV(118, 0);
4582         SvSetSV(sv, prog->anchored_utf8);
4583         if (sv_utf8_downgrade(sv, TRUE)) {
4584             if (SvTAIL(prog->anchored_utf8))
4585                 SvTAIL_on(sv);
4586         } else {
4587             SvREFCNT_dec(sv);
4588             prog->anchored_substr = sv = &PL_sv_undef;
4589         }
4590         if (prog->anchored_utf8 == prog->check_utf8)
4591             prog->check_substr = sv;
4592     }
4593 }