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