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