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