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