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