Fix RT69056 - postive GPOS leads to segv on first match
[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  *     [p.v of _The Lord of the Rings_, opening poem]
8  *     [p.50 of _The Lord of the Rings_, I/iii: "The Shadow of the Past"]
9  *     [p.254 of _The Lord of the Rings_, II/ii: "The Council of Elrond"]
10  */
11
12 /* This file contains functions for executing a regular expression.  See
13  * also regcomp.c which funnily enough, contains functions for compiling
14  * a regular expression.
15  *
16  * This file is also copied at build time to ext/re/re_exec.c, where
17  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
18  * This causes the main functions to be compiled under new names and with
19  * debugging support added, which makes "use re 'debug'" work.
20  */
21
22 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
23  * confused with the original package (see point 3 below).  Thanks, Henry!
24  */
25
26 /* Additional note: this code is very heavily munged from Henry's version
27  * in places.  In some spots I've traded clarity for efficiency, so don't
28  * blame Henry for some of the lack of readability.
29  */
30
31 /* The names of the functions have been changed from regcomp and
32  * regexec to  pregcomp and pregexec in order to avoid conflicts
33  * with the POSIX routines of the same names.
34 */
35
36 #ifdef PERL_EXT_RE_BUILD
37 #include "re_top.h"
38 #endif
39
40 /*
41  * pregcomp and pregexec -- regsub and regerror are not used in perl
42  *
43  *      Copyright (c) 1986 by University of Toronto.
44  *      Written by Henry Spencer.  Not derived from licensed software.
45  *
46  *      Permission is granted to anyone to use this software for any
47  *      purpose on any computer system, and to redistribute it freely,
48  *      subject to the following restrictions:
49  *
50  *      1. The author is not responsible for the consequences of use of
51  *              this software, no matter how awful, even if they arise
52  *              from defects in it.
53  *
54  *      2. The origin of this software must not be misrepresented, either
55  *              by explicit claim or by omission.
56  *
57  *      3. Altered versions must be plainly marked as such, and must not
58  *              be misrepresented as being the original software.
59  *
60  ****    Alterations to Henry's code are...
61  ****
62  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
63  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
64  ****    by Larry Wall and others
65  ****
66  ****    You may distribute under the terms of either the GNU General Public
67  ****    License or the Artistic License, as specified in the README file.
68  *
69  * Beware that some of this code is subtly aware of the way operator
70  * precedence is structured in regular expressions.  Serious changes in
71  * regular-expression syntax might require a total rethink.
72  */
73 #include "EXTERN.h"
74 #define PERL_IN_REGEXEC_C
75 #include "perl.h"
76
77 #ifdef PERL_IN_XSUB_RE
78 #  include "re_comp.h"
79 #else
80 #  include "regcomp.h"
81 #endif
82
83 #define RF_tainted      1               /* tainted information used? */
84 #define RF_warned       2               /* warned about big count? */
85
86 #define RF_utf8         8               /* Pattern contains multibyte chars? */
87
88 #define UTF ((PL_reg_flags & RF_utf8) != 0)
89
90 #define RS_init         1               /* eval environment created */
91 #define RS_set          2               /* replsv value is set */
92
93 #ifndef STATIC
94 #define STATIC  static
95 #endif
96
97 #define REGINCLASS(prog,p,c)  (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
98
99 /*
100  * Forwards.
101  */
102
103 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
104 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
105
106 #define HOPc(pos,off) \
107         (char *)(PL_reg_match_utf8 \
108             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
109             : (U8*)(pos + off))
110 #define HOPBACKc(pos, off) \
111         (char*)(PL_reg_match_utf8\
112             ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
113             : (pos - off >= PL_bostr)           \
114                 ? (U8*)pos - off                \
115                 : NULL)
116
117 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
118 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
119
120 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
121     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
122 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
123 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
124 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
125 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
126
127 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
128
129 /* for use after a quantifier and before an EXACT-like node -- japhy */
130 /* it would be nice to rework regcomp.sym to generate this stuff. sigh */
131 #define JUMPABLE(rn) (      \
132     OP(rn) == OPEN ||       \
133     (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
134     OP(rn) == EVAL ||   \
135     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
136     OP(rn) == PLUS || OP(rn) == MINMOD || \
137     OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
138     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
139 )
140 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
141
142 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
143
144 #if 0 
145 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
146    we don't need this definition. */
147 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
148 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  || OP(rn)==REFF  || OP(rn)==NREFF  )
149 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
150
151 #else
152 /* ... so we use this as its faster. */
153 #define IS_TEXT(rn)   ( OP(rn)==EXACT   )
154 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
155 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
156
157 #endif
158
159 /*
160   Search for mandatory following text node; for lookahead, the text must
161   follow but for lookbehind (rn->flags != 0) we skip to the next step.
162 */
163 #define FIND_NEXT_IMPT(rn) STMT_START { \
164     while (JUMPABLE(rn)) { \
165         const OPCODE type = OP(rn); \
166         if (type == SUSPEND || PL_regkind[type] == CURLY) \
167             rn = NEXTOPER(NEXTOPER(rn)); \
168         else if (type == PLUS) \
169             rn = NEXTOPER(rn); \
170         else if (type == IFMATCH) \
171             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
172         else rn += NEXT_OFF(rn); \
173     } \
174 } STMT_END 
175
176
177 static void restore_pos(pTHX_ void *arg);
178
179 STATIC CHECKPOINT
180 S_regcppush(pTHX_ I32 parenfloor)
181 {
182     dVAR;
183     const int retval = PL_savestack_ix;
184 #define REGCP_PAREN_ELEMS 4
185     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
186     int p;
187     GET_RE_DEBUG_FLAGS_DECL;
188
189     if (paren_elems_to_push < 0)
190         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
191
192 #define REGCP_OTHER_ELEMS 7
193     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
194     
195     for (p = PL_regsize; p > parenfloor; p--) {
196 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
197         SSPUSHINT(PL_regoffs[p].end);
198         SSPUSHINT(PL_regoffs[p].start);
199         SSPUSHPTR(PL_reg_start_tmp[p]);
200         SSPUSHINT(p);
201         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
202           "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
203                       (UV)p, (IV)PL_regoffs[p].start,
204                       (IV)(PL_reg_start_tmp[p] - PL_bostr),
205                       (IV)PL_regoffs[p].end
206         ));
207     }
208 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
209     SSPUSHPTR(PL_regoffs);
210     SSPUSHINT(PL_regsize);
211     SSPUSHINT(*PL_reglastparen);
212     SSPUSHINT(*PL_reglastcloseparen);
213     SSPUSHPTR(PL_reginput);
214 #define REGCP_FRAME_ELEMS 2
215 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
216  * are needed for the regexp context stack bookkeeping. */
217     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
218     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
219
220     return retval;
221 }
222
223 /* These are needed since we do not localize EVAL nodes: */
224 #define REGCP_SET(cp)                                           \
225     DEBUG_STATE_r(                                              \
226             PerlIO_printf(Perl_debug_log,                       \
227                 "  Setting an EVAL scope, savestack=%"IVdf"\n", \
228                 (IV)PL_savestack_ix));                          \
229     cp = PL_savestack_ix
230
231 #define REGCP_UNWIND(cp)                                        \
232     DEBUG_STATE_r(                                              \
233         if (cp != PL_savestack_ix)                              \
234             PerlIO_printf(Perl_debug_log,                       \
235                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
236                 (IV)(cp), (IV)PL_savestack_ix));                \
237     regcpblow(cp)
238
239 STATIC char *
240 S_regcppop(pTHX_ const regexp *rex)
241 {
242     dVAR;
243     U32 i;
244     char *input;
245     GET_RE_DEBUG_FLAGS_DECL;
246
247     PERL_ARGS_ASSERT_REGCPPOP;
248
249     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
250     i = SSPOPINT;
251     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
252     i = SSPOPINT; /* Parentheses elements to pop. */
253     input = (char *) SSPOPPTR;
254     *PL_reglastcloseparen = SSPOPINT;
255     *PL_reglastparen = SSPOPINT;
256     PL_regsize = SSPOPINT;
257     PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
258
259     
260     /* Now restore the parentheses context. */
261     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
262          i > 0; i -= REGCP_PAREN_ELEMS) {
263         I32 tmps;
264         U32 paren = (U32)SSPOPINT;
265         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
266         PL_regoffs[paren].start = SSPOPINT;
267         tmps = SSPOPINT;
268         if (paren <= *PL_reglastparen)
269             PL_regoffs[paren].end = tmps;
270         DEBUG_BUFFERS_r(
271             PerlIO_printf(Perl_debug_log,
272                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
273                           (UV)paren, (IV)PL_regoffs[paren].start,
274                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
275                           (IV)PL_regoffs[paren].end,
276                           (paren > *PL_reglastparen ? "(no)" : ""));
277         );
278     }
279     DEBUG_BUFFERS_r(
280         if (*PL_reglastparen + 1 <= rex->nparens) {
281             PerlIO_printf(Perl_debug_log,
282                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
283                           (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
284         }
285     );
286 #if 1
287     /* It would seem that the similar code in regtry()
288      * already takes care of this, and in fact it is in
289      * a better location to since this code can #if 0-ed out
290      * but the code in regtry() is needed or otherwise tests
291      * requiring null fields (pat.t#187 and split.t#{13,14}
292      * (as of patchlevel 7877)  will fail.  Then again,
293      * this code seems to be necessary or otherwise
294      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
295      * --jhi updated by dapm */
296     for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
297         if (i > PL_regsize)
298             PL_regoffs[i].start = -1;
299         PL_regoffs[i].end = -1;
300     }
301 #endif
302     return input;
303 }
304
305 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
306
307 /*
308  * pregexec and friends
309  */
310
311 #ifndef PERL_IN_XSUB_RE
312 /*
313  - pregexec - match a regexp against a string
314  */
315 I32
316 Perl_pregexec(pTHX_ REGEXP * const 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     PERL_ARGS_ASSERT_PREGEXEC;
324
325     return
326         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
327                       nosave ? 0 : REXEC_COPY_STR);
328 }
329 #endif
330
331 /*
332  * Need to implement the following flags for reg_anch:
333  *
334  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
335  * USE_INTUIT_ML
336  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
337  * INTUIT_AUTORITATIVE_ML
338  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
339  * INTUIT_ONCE_ML
340  *
341  * Another flag for this function: SECOND_TIME (so that float substrs
342  * with giant delta may be not rechecked).
343  */
344
345 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
346
347 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
348    Otherwise, only SvCUR(sv) is used to get strbeg. */
349
350 /* XXXX We assume that strpos is strbeg unless sv. */
351
352 /* XXXX Some places assume that there is a fixed substring.
353         An update may be needed if optimizer marks as "INTUITable"
354         RExen without fixed substrings.  Similarly, it is assumed that
355         lengths of all the strings are no more than minlen, thus they
356         cannot come from lookahead.
357         (Or minlen should take into account lookahead.) 
358   NOTE: Some of this comment is not correct. minlen does now take account
359   of lookahead/behind. Further research is required. -- demerphq
360
361 */
362
363 /* A failure to find a constant substring means that there is no need to make
364    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
365    finding a substring too deep into the string means that less calls to
366    regtry() should be needed.
367
368    REx compiler's optimizer found 4 possible hints:
369         a) Anchored substring;
370         b) Fixed substring;
371         c) Whether we are anchored (beginning-of-line or \G);
372         d) First node (of those at offset 0) which may distingush positions;
373    We use a)b)d) and multiline-part of c), and try to find a position in the
374    string which does not contradict any of them.
375  */
376
377 /* Most of decisions we do here should have been done at compile time.
378    The nodes of the REx which we used for the search should have been
379    deleted from the finite automaton. */
380
381 char *
382 Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
383                      char *strend, const U32 flags, re_scream_pos_data *data)
384 {
385     dVAR;
386     struct regexp *const prog = (struct regexp *)SvANY(rx);
387     register I32 start_shift = 0;
388     /* Should be nonnegative! */
389     register I32 end_shift   = 0;
390     register char *s;
391     register SV *check;
392     char *strbeg;
393     char *t;
394     const bool do_utf8 = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
395     I32 ml_anch;
396     register char *other_last = NULL;   /* other substr checked before this */
397     char *check_at = NULL;              /* check substr found at this pos */
398     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
399     RXi_GET_DECL(prog,progi);
400 #ifdef DEBUGGING
401     const char * const i_strpos = strpos;
402 #endif
403     GET_RE_DEBUG_FLAGS_DECL;
404
405     PERL_ARGS_ASSERT_RE_INTUIT_START;
406
407     RX_MATCH_UTF8_set(rx,do_utf8);
408
409     if (RX_UTF8(rx)) {
410         PL_reg_flags |= RF_utf8;
411     }
412     DEBUG_EXECUTE_r( 
413         debug_start_match(rx, do_utf8, strpos, strend, 
414             sv ? "Guessing start of match in sv for"
415                : "Guessing start of match in string for");
416               );
417
418     /* CHR_DIST() would be more correct here but it makes things slow. */
419     if (prog->minlen > strend - strpos) {
420         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
421                               "String too short... [re_intuit_start]\n"));
422         goto fail;
423     }
424                 
425     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
426     PL_regeol = strend;
427     if (do_utf8) {
428         if (!prog->check_utf8 && prog->check_substr)
429             to_utf8_substr(prog);
430         check = prog->check_utf8;
431     } else {
432         if (!prog->check_substr && prog->check_utf8)
433             to_byte_substr(prog);
434         check = prog->check_substr;
435     }
436     if (check == &PL_sv_undef) {
437         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
438                 "Non-utf8 string cannot match utf8 check string\n"));
439         goto fail;
440     }
441     if (prog->extflags & RXf_ANCH) {    /* Match at beg-of-str or after \n */
442         ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
443                      || ( (prog->extflags & RXf_ANCH_BOL)
444                           && !multiline ) );    /* Check after \n? */
445
446         if (!ml_anch) {
447           if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
448                 && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
449                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
450                && sv && !SvROK(sv)
451                && (strpos != strbeg)) {
452               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
453               goto fail;
454           }
455           if (prog->check_offset_min == prog->check_offset_max &&
456               !(prog->extflags & RXf_CANY_SEEN)) {
457             /* Substring at constant offset from beg-of-str... */
458             I32 slen;
459
460             s = HOP3c(strpos, prog->check_offset_min, strend);
461             
462             if (SvTAIL(check)) {
463                 slen = SvCUR(check);    /* >= 1 */
464
465                 if ( strend - s > slen || strend - s < slen - 1
466                      || (strend - s == slen && strend[-1] != '\n')) {
467                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
468                     goto fail_finish;
469                 }
470                 /* Now should match s[0..slen-2] */
471                 slen--;
472                 if (slen && (*SvPVX_const(check) != *s
473                              || (slen > 1
474                                  && memNE(SvPVX_const(check), s, slen)))) {
475                   report_neq:
476                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
477                     goto fail_finish;
478                 }
479             }
480             else if (*SvPVX_const(check) != *s
481                      || ((slen = SvCUR(check)) > 1
482                          && memNE(SvPVX_const(check), s, slen)))
483                 goto report_neq;
484             check_at = s;
485             goto success_at_start;
486           }
487         }
488         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
489         s = strpos;
490         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
491         end_shift = prog->check_end_shift;
492         
493         if (!ml_anch) {
494             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
495                                          - (SvTAIL(check) != 0);
496             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
497
498             if (end_shift < eshift)
499                 end_shift = eshift;
500         }
501     }
502     else {                              /* Can match at random position */
503         ml_anch = 0;
504         s = strpos;
505         start_shift = prog->check_offset_min;  /* okay to underestimate on CC */
506         end_shift = prog->check_end_shift;
507         
508         /* end shift should be non negative here */
509     }
510
511 #ifdef QDEBUGGING       /* 7/99: reports of failure (with the older version) */
512     if (end_shift < 0)
513         Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
514                    (IV)end_shift, RX_PRECOMP(prog));
515 #endif
516
517   restart:
518     /* Find a possible match in the region s..strend by looking for
519        the "check" substring in the region corrected by start/end_shift. */
520     
521     {
522         I32 srch_start_shift = start_shift;
523         I32 srch_end_shift = end_shift;
524         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
525             srch_end_shift -= ((strbeg - s) - srch_start_shift); 
526             srch_start_shift = strbeg - s;
527         }
528     DEBUG_OPTIMISE_MORE_r({
529         PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
530             (IV)prog->check_offset_min,
531             (IV)srch_start_shift,
532             (IV)srch_end_shift, 
533             (IV)prog->check_end_shift);
534     });       
535         
536     if (flags & REXEC_SCREAM) {
537         I32 p = -1;                     /* Internal iterator of scream. */
538         I32 * const pp = data ? data->scream_pos : &p;
539
540         if (PL_screamfirst[BmRARE(check)] >= 0
541             || ( BmRARE(check) == '\n'
542                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
543                  && SvTAIL(check) ))
544             s = screaminstr(sv, check,
545                             srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
546         else
547             goto fail_finish;
548         /* we may be pointing at the wrong string */
549         if (s && RXp_MATCH_COPIED(prog))
550             s = strbeg + (s - SvPVX_const(sv));
551         if (data)
552             *data->scream_olds = s;
553     }
554     else {
555         U8* start_point;
556         U8* end_point;
557         if (prog->extflags & RXf_CANY_SEEN) {
558             start_point= (U8*)(s + srch_start_shift);
559             end_point= (U8*)(strend - srch_end_shift);
560         } else {
561             start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
562             end_point= HOP3(strend, -srch_end_shift, strbeg);
563         }
564         DEBUG_OPTIMISE_MORE_r({
565             PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n", 
566                 (int)(end_point - start_point),
567                 (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point), 
568                 start_point);
569         });
570
571         s = fbm_instr( start_point, end_point,
572                       check, multiline ? FBMrf_MULTILINE : 0);
573     }
574     }
575     /* Update the count-of-usability, remove useless subpatterns,
576         unshift s.  */
577
578     DEBUG_EXECUTE_r({
579         RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), 
580             SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
581         PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
582                           (s ? "Found" : "Did not find"),
583             (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) 
584                 ? "anchored" : "floating"),
585             quoted,
586             RE_SV_TAIL(check),
587             (s ? " at offset " : "...\n") ); 
588     });
589
590     if (!s)
591         goto fail_finish;
592     /* Finish the diagnostic message */
593     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
594
595     /* XXX dmq: first branch is for positive lookbehind...
596        Our check string is offset from the beginning of the pattern.
597        So we need to do any stclass tests offset forward from that 
598        point. I think. :-(
599      */
600     
601         
602     
603     check_at=s;
604      
605
606     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
607        Start with the other substr.
608        XXXX no SCREAM optimization yet - and a very coarse implementation
609        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
610                 *always* match.  Probably should be marked during compile...
611        Probably it is right to do no SCREAM here...
612      */
613
614     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) 
615                 : (prog->float_substr && prog->anchored_substr)) 
616     {
617         /* Take into account the "other" substring. */
618         /* XXXX May be hopelessly wrong for UTF... */
619         if (!other_last)
620             other_last = strpos;
621         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
622           do_other_anchored:
623             {
624                 char * const last = HOP3c(s, -start_shift, strbeg);
625                 char *last1, *last2;
626                 char * const saved_s = s;
627                 SV* must;
628
629                 t = s - prog->check_offset_max;
630                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
631                     && (!do_utf8
632                         || ((t = (char*)reghopmaybe3((U8*)s, -(prog->check_offset_max), (U8*)strpos))
633                             && t > strpos)))
634                     NOOP;
635                 else
636                     t = strpos;
637                 t = HOP3c(t, prog->anchored_offset, strend);
638                 if (t < other_last)     /* These positions already checked */
639                     t = other_last;
640                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
641                 if (last < last1)
642                     last1 = last;
643                 /* XXXX It is not documented what units *_offsets are in.  
644                    We assume bytes, but this is clearly wrong. 
645                    Meaning this code needs to be carefully reviewed for errors.
646                    dmq.
647                   */
648  
649                 /* On end-of-str: see comment below. */
650                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
651                 if (must == &PL_sv_undef) {
652                     s = (char*)NULL;
653                     DEBUG_r(must = prog->anchored_utf8);        /* for debug */
654                 }
655                 else
656                     s = fbm_instr(
657                         (unsigned char*)t,
658                         HOP3(HOP3(last1, prog->anchored_offset, strend)
659                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
660                         must,
661                         multiline ? FBMrf_MULTILINE : 0
662                     );
663                 DEBUG_EXECUTE_r({
664                     RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), 
665                         SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
666                     PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
667                         (s ? "Found" : "Contradicts"),
668                         quoted, RE_SV_TAIL(must));
669                 });                 
670                 
671                             
672                 if (!s) {
673                     if (last1 >= last2) {
674                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
675                                                 ", giving up...\n"));
676                         goto fail_finish;
677                     }
678                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
679                         ", trying floating at offset %ld...\n",
680                         (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
681                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
682                     s = HOP3c(last, 1, strend);
683                     goto restart;
684                 }
685                 else {
686                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
687                           (long)(s - i_strpos)));
688                     t = HOP3c(s, -prog->anchored_offset, strbeg);
689                     other_last = HOP3c(s, 1, strend);
690                     s = saved_s;
691                     if (t == strpos)
692                         goto try_at_start;
693                     goto try_at_offset;
694                 }
695             }
696         }
697         else {          /* Take into account the floating substring. */
698             char *last, *last1;
699             char * const saved_s = s;
700             SV* must;
701
702             t = HOP3c(s, -start_shift, strbeg);
703             last1 = last =
704                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
705             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
706                 last = HOP3c(t, prog->float_max_offset, strend);
707             s = HOP3c(t, prog->float_min_offset, strend);
708             if (s < other_last)
709                 s = other_last;
710  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
711             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
712             /* fbm_instr() takes into account exact value of end-of-str
713                if the check is SvTAIL(ed).  Since false positives are OK,
714                and end-of-str is not later than strend we are OK. */
715             if (must == &PL_sv_undef) {
716                 s = (char*)NULL;
717                 DEBUG_r(must = prog->float_utf8);       /* for debug message */
718             }
719             else
720                 s = fbm_instr((unsigned char*)s,
721                               (unsigned char*)last + SvCUR(must)
722                                   - (SvTAIL(must)!=0),
723                               must, multiline ? FBMrf_MULTILINE : 0);
724             DEBUG_EXECUTE_r({
725                 RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), 
726                     SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
727                 PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
728                     (s ? "Found" : "Contradicts"),
729                     quoted, RE_SV_TAIL(must));
730             });
731             if (!s) {
732                 if (last1 == last) {
733                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
734                                             ", giving up...\n"));
735                     goto fail_finish;
736                 }
737                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
738                     ", trying anchored starting at offset %ld...\n",
739                     (long)(saved_s + 1 - i_strpos)));
740                 other_last = last;
741                 s = HOP3c(t, 1, strend);
742                 goto restart;
743             }
744             else {
745                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
746                       (long)(s - i_strpos)));
747                 other_last = s; /* Fix this later. --Hugo */
748                 s = saved_s;
749                 if (t == strpos)
750                     goto try_at_start;
751                 goto try_at_offset;
752             }
753         }
754     }
755
756     
757     t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
758         
759     DEBUG_OPTIMISE_MORE_r(
760         PerlIO_printf(Perl_debug_log, 
761             "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
762             (IV)prog->check_offset_min,
763             (IV)prog->check_offset_max,
764             (IV)(s-strpos),
765             (IV)(t-strpos),
766             (IV)(t-s),
767             (IV)(strend-strpos)
768         )
769     );
770
771     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
772         && (!do_utf8
773             || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
774                  && t > strpos))) 
775     {
776         /* Fixed substring is found far enough so that the match
777            cannot start at strpos. */
778       try_at_offset:
779         if (ml_anch && t[-1] != '\n') {
780             /* Eventually fbm_*() should handle this, but often
781                anchored_offset is not 0, so this check will not be wasted. */
782             /* XXXX In the code below we prefer to look for "^" even in
783                presence of anchored substrings.  And we search even
784                beyond the found float position.  These pessimizations
785                are historical artefacts only.  */
786           find_anchor:
787             while (t < strend - prog->minlen) {
788                 if (*t == '\n') {
789                     if (t < check_at - prog->check_offset_min) {
790                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
791                             /* Since we moved from the found position,
792                                we definitely contradict the found anchored
793                                substr.  Due to the above check we do not
794                                contradict "check" substr.
795                                Thus we can arrive here only if check substr
796                                is float.  Redo checking for "other"=="fixed".
797                              */
798                             strpos = t + 1;                     
799                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
800                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
801                             goto do_other_anchored;
802                         }
803                         /* We don't contradict the found floating substring. */
804                         /* XXXX Why not check for STCLASS? */
805                         s = t + 1;
806                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
807                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
808                         goto set_useful;
809                     }
810                     /* Position contradicts check-string */
811                     /* XXXX probably better to look for check-string
812                        than for "\n", so one should lower the limit for t? */
813                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
814                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
815                     other_last = strpos = s = t + 1;
816                     goto restart;
817                 }
818                 t++;
819             }
820             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
821                         PL_colors[0], PL_colors[1]));
822             goto fail_finish;
823         }
824         else {
825             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
826                         PL_colors[0], PL_colors[1]));
827         }
828         s = t;
829       set_useful:
830         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
831     }
832     else {
833         /* The found string does not prohibit matching at strpos,
834            - no optimization of calling REx engine can be performed,
835            unless it was an MBOL and we are not after MBOL,
836            or a future STCLASS check will fail this. */
837       try_at_start:
838         /* Even in this situation we may use MBOL flag if strpos is offset
839            wrt the start of the string. */
840         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
841             && (strpos != strbeg) && strpos[-1] != '\n'
842             /* May be due to an implicit anchor of m{.*foo}  */
843             && !(prog->intflags & PREGf_IMPLICIT))
844         {
845             t = strpos;
846             goto find_anchor;
847         }
848         DEBUG_EXECUTE_r( if (ml_anch)
849             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
850                           (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
851         );
852       success_at_start:
853         if (!(prog->intflags & PREGf_NAUGHTY)   /* XXXX If strpos moved? */
854             && (do_utf8 ? (
855                 prog->check_utf8                /* Could be deleted already */
856                 && --BmUSEFUL(prog->check_utf8) < 0
857                 && (prog->check_utf8 == prog->float_utf8)
858             ) : (
859                 prog->check_substr              /* Could be deleted already */
860                 && --BmUSEFUL(prog->check_substr) < 0
861                 && (prog->check_substr == prog->float_substr)
862             )))
863         {
864             /* If flags & SOMETHING - do not do it many times on the same match */
865             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
866             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
867             if (do_utf8 ? prog->check_substr : prog->check_utf8)
868                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
869             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
870             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
871             check = NULL;                       /* abort */
872             s = strpos;
873             /* XXXX This is a remnant of the old implementation.  It
874                     looks wasteful, since now INTUIT can use many
875                     other heuristics. */
876             prog->extflags &= ~RXf_USE_INTUIT;
877         }
878         else
879             s = strpos;
880     }
881
882     /* Last resort... */
883     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
884     /* trie stclasses are too expensive to use here, we are better off to
885        leave it to regmatch itself */
886     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
887         /* minlen == 0 is possible if regstclass is \b or \B,
888            and the fixed substr is ''$.
889            Since minlen is already taken into account, s+1 is before strend;
890            accidentally, minlen >= 1 guaranties no false positives at s + 1
891            even for \b or \B.  But (minlen? 1 : 0) below assumes that
892            regstclass does not come from lookahead...  */
893         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
894            This leaves EXACTF only, which is dealt with in find_byclass().  */
895         const U8* const str = (U8*)STRING(progi->regstclass);
896         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
897                     ? CHR_DIST(str+STR_LEN(progi->regstclass), str)
898                     : 1);
899         char * endpos;
900         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
901             endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
902         else if (prog->float_substr || prog->float_utf8)
903             endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
904         else 
905             endpos= strend;
906                     
907         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" s: %"IVdf" endpos: %"IVdf"\n",
908                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg)));
909         
910         t = s;
911         s = find_byclass(prog, progi->regstclass, s, endpos, NULL);
912         if (!s) {
913 #ifdef DEBUGGING
914             const char *what = NULL;
915 #endif
916             if (endpos == strend) {
917                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
918                                 "Could not match STCLASS...\n") );
919                 goto fail;
920             }
921             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
922                                    "This position contradicts STCLASS...\n") );
923             if ((prog->extflags & RXf_ANCH) && !ml_anch)
924                 goto fail;
925             /* Contradict one of substrings */
926             if (prog->anchored_substr || prog->anchored_utf8) {
927                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
928                     DEBUG_EXECUTE_r( what = "anchored" );
929                   hop_and_restart:
930                     s = HOP3c(t, 1, strend);
931                     if (s + start_shift + end_shift > strend) {
932                         /* XXXX Should be taken into account earlier? */
933                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
934                                                "Could not match STCLASS...\n") );
935                         goto fail;
936                     }
937                     if (!check)
938                         goto giveup;
939                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
940                                 "Looking for %s substr starting at offset %ld...\n",
941                                  what, (long)(s + start_shift - i_strpos)) );
942                     goto restart;
943                 }
944                 /* Have both, check_string is floating */
945                 if (t + start_shift >= check_at) /* Contradicts floating=check */
946                     goto retry_floating_check;
947                 /* Recheck anchored substring, but not floating... */
948                 s = check_at;
949                 if (!check)
950                     goto giveup;
951                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
952                           "Looking for anchored substr starting at offset %ld...\n",
953                           (long)(other_last - i_strpos)) );
954                 goto do_other_anchored;
955             }
956             /* Another way we could have checked stclass at the
957                current position only: */
958             if (ml_anch) {
959                 s = t = t + 1;
960                 if (!check)
961                     goto giveup;
962                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
963                           "Looking for /%s^%s/m starting at offset %ld...\n",
964                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
965                 goto try_at_offset;
966             }
967             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
968                 goto fail;
969             /* Check is floating subtring. */
970           retry_floating_check:
971             t = check_at - start_shift;
972             DEBUG_EXECUTE_r( what = "floating" );
973             goto hop_and_restart;
974         }
975         if (t != s) {
976             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
977                         "By STCLASS: moving %ld --> %ld\n",
978                                   (long)(t - i_strpos), (long)(s - i_strpos))
979                    );
980         }
981         else {
982             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
983                                   "Does not contradict STCLASS...\n"); 
984                    );
985         }
986     }
987   giveup:
988     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
989                           PL_colors[4], (check ? "Guessed" : "Giving up"),
990                           PL_colors[5], (long)(s - i_strpos)) );
991     return s;
992
993   fail_finish:                          /* Substring not found */
994     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
995         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
996   fail:
997     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
998                           PL_colors[4], PL_colors[5]));
999     return NULL;
1000 }
1001
1002 #define DECL_TRIE_TYPE(scan) \
1003     const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold } \
1004                     trie_type = (scan->flags != EXACT) \
1005                               ? (do_utf8 ? trie_utf8_fold : (UTF ? trie_latin_utf8_fold : trie_plain)) \
1006                               : (do_utf8 ? trie_utf8 : trie_plain)
1007
1008 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
1009 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
1010     UV uvc_unfolded = 0;                                                    \
1011     switch (trie_type) {                                                    \
1012     case trie_utf8_fold:                                                    \
1013         if ( foldlen>0 ) {                                                  \
1014             uvc_unfolded = uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
1015             foldlen -= len;                                                 \
1016             uscan += len;                                                   \
1017             len=0;                                                          \
1018         } else {                                                            \
1019             uvc_unfolded = uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
1020             uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
1021             foldlen -= UNISKIP( uvc );                                      \
1022             uscan = foldbuf + UNISKIP( uvc );                               \
1023         }                                                                   \
1024         break;                                                              \
1025     case trie_latin_utf8_fold:                                              \
1026         if ( foldlen>0 ) {                                                  \
1027             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
1028             foldlen -= len;                                                 \
1029             uscan += len;                                                   \
1030             len=0;                                                          \
1031         } else {                                                            \
1032             len = 1;                                                        \
1033             uvc = to_uni_fold( *(U8*)uc, foldbuf, &foldlen );               \
1034             foldlen -= UNISKIP( uvc );                                      \
1035             uscan = foldbuf + UNISKIP( uvc );                               \
1036         }                                                                   \
1037         break;                                                              \
1038     case trie_utf8:                                                         \
1039         uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );       \
1040         break;                                                              \
1041     case trie_plain:                                                        \
1042         uvc = (UV)*uc;                                                      \
1043         len = 1;                                                            \
1044     }                                                                       \
1045                                                                             \
1046     if (uvc < 256) {                                                        \
1047         charid = trie->charmap[ uvc ];                                      \
1048     }                                                                       \
1049     else {                                                                  \
1050         charid = 0;                                                         \
1051         if (widecharmap) {                                                  \
1052             SV** const svpp = hv_fetch(widecharmap,                         \
1053                         (char*)&uvc, sizeof(UV), 0);                        \
1054             if (svpp)                                                       \
1055                 charid = (U16)SvIV(*svpp);                                  \
1056         }                                                                   \
1057     }                                                                       \
1058     if (!charid && trie_type == trie_utf8_fold && !UTF) {                   \
1059         charid = trie->charmap[uvc_unfolded];                               \
1060     }                                                                       \
1061 } STMT_END
1062
1063 #define REXEC_FBC_EXACTISH_CHECK(CoNd)                 \
1064 {                                                      \
1065     char *my_strend= (char *)strend;                   \
1066     if ( (CoNd)                                        \
1067          && (ln == len ||                              \
1068              !ibcmp_utf8(s, &my_strend, 0,  do_utf8,   \
1069                         m, NULL, ln, (bool)UTF))       \
1070          && (!reginfo || regtry(reginfo, &s)) )        \
1071         goto got_it;                                   \
1072     else {                                             \
1073          U8 foldbuf[UTF8_MAXBYTES_CASE+1];             \
1074          uvchr_to_utf8(tmpbuf, c);                     \
1075          f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);  \
1076          if ( f != c                                   \
1077               && (f == c1 || f == c2)                  \
1078               && (ln == len ||                         \
1079                 !ibcmp_utf8(s, &my_strend, 0,  do_utf8,\
1080                               m, NULL, ln, (bool)UTF)) \
1081               && (!reginfo || regtry(reginfo, &s)) )   \
1082               goto got_it;                             \
1083     }                                                  \
1084 }                                                      \
1085 s += len
1086
1087 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
1088 STMT_START {                                              \
1089     while (s <= e) {                                      \
1090         if ( (CoNd)                                       \
1091              && (ln == 1 || !(OP(c) == EXACTF             \
1092                               ? ibcmp(s, m, ln)           \
1093                               : ibcmp_locale(s, m, ln)))  \
1094              && (!reginfo || regtry(reginfo, &s)) )        \
1095             goto got_it;                                  \
1096         s++;                                              \
1097     }                                                     \
1098 } STMT_END
1099
1100 #define REXEC_FBC_UTF8_SCAN(CoDe)                     \
1101 STMT_START {                                          \
1102     while (s + (uskip = UTF8SKIP(s)) <= strend) {     \
1103         CoDe                                          \
1104         s += uskip;                                   \
1105     }                                                 \
1106 } STMT_END
1107
1108 #define REXEC_FBC_SCAN(CoDe)                          \
1109 STMT_START {                                          \
1110     while (s < strend) {                              \
1111         CoDe                                          \
1112         s++;                                          \
1113     }                                                 \
1114 } STMT_END
1115
1116 #define REXEC_FBC_UTF8_CLASS_SCAN(CoNd)               \
1117 REXEC_FBC_UTF8_SCAN(                                  \
1118     if (CoNd) {                                       \
1119         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1120             goto got_it;                              \
1121         else                                          \
1122             tmp = doevery;                            \
1123     }                                                 \
1124     else                                              \
1125         tmp = 1;                                      \
1126 )
1127
1128 #define REXEC_FBC_CLASS_SCAN(CoNd)                    \
1129 REXEC_FBC_SCAN(                                       \
1130     if (CoNd) {                                       \
1131         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1132             goto got_it;                              \
1133         else                                          \
1134             tmp = doevery;                            \
1135     }                                                 \
1136     else                                              \
1137         tmp = 1;                                      \
1138 )
1139
1140 #define REXEC_FBC_TRYIT               \
1141 if ((!reginfo || regtry(reginfo, &s))) \
1142     goto got_it
1143
1144 #define REXEC_FBC_CSCAN(CoNdUtF8,CoNd)                         \
1145     if (do_utf8) {                                             \
1146         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1147     }                                                          \
1148     else {                                                     \
1149         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1150     }                                                          \
1151     break
1152     
1153 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
1154     if (do_utf8) {                                             \
1155         UtFpReLoAd;                                            \
1156         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1157     }                                                          \
1158     else {                                                     \
1159         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1160     }                                                          \
1161     break
1162
1163 #define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd)                   \
1164     PL_reg_flags |= RF_tainted;                                \
1165     if (do_utf8) {                                             \
1166         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1167     }                                                          \
1168     else {                                                     \
1169         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1170     }                                                          \
1171     break
1172
1173 #define DUMP_EXEC_POS(li,s,doutf8) \
1174     dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
1175
1176 /* We know what class REx starts with.  Try to find this position... */
1177 /* if reginfo is NULL, its a dryrun */
1178 /* annoyingly all the vars in this routine have different names from their counterparts
1179    in regmatch. /grrr */
1180
1181 STATIC char *
1182 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, 
1183     const char *strend, regmatch_info *reginfo)
1184 {
1185         dVAR;
1186         const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
1187         char *m;
1188         STRLEN ln;
1189         STRLEN lnc;
1190         register STRLEN uskip;
1191         unsigned int c1;
1192         unsigned int c2;
1193         char *e;
1194         register I32 tmp = 1;   /* Scratch variable? */
1195         register const bool do_utf8 = PL_reg_match_utf8;
1196         RXi_GET_DECL(prog,progi);
1197
1198         PERL_ARGS_ASSERT_FIND_BYCLASS;
1199         
1200         /* We know what class it must start with. */
1201         switch (OP(c)) {
1202         case ANYOF:
1203             if (do_utf8) {
1204                  REXEC_FBC_UTF8_CLASS_SCAN((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
1205                           !UTF8_IS_INVARIANT((U8)s[0]) ?
1206                           reginclass(prog, c, (U8*)s, 0, do_utf8) :
1207                           REGINCLASS(prog, c, (U8*)s));
1208             }
1209             else {
1210                  while (s < strend) {
1211                       STRLEN skip = 1;
1212
1213                       if (REGINCLASS(prog, c, (U8*)s) ||
1214                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1215                            /* The assignment of 2 is intentional:
1216                             * for the folded sharp s, the skip is 2. */
1217                            (skip = SHARP_S_SKIP))) {
1218                            if (tmp && (!reginfo || regtry(reginfo, &s)))
1219                                 goto got_it;
1220                            else
1221                                 tmp = doevery;
1222                       }
1223                       else 
1224                            tmp = 1;
1225                       s += skip;
1226                  }
1227             }
1228             break;
1229         case CANY:
1230             REXEC_FBC_SCAN(
1231                 if (tmp && (!reginfo || regtry(reginfo, &s)))
1232                     goto got_it;
1233                 else
1234                     tmp = doevery;
1235             );
1236             break;
1237         case EXACTF:
1238             m   = STRING(c);
1239             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1240             lnc = (I32) ln;     /* length to match in characters */
1241             if (UTF) {
1242                 STRLEN ulen1, ulen2;
1243                 U8 *sm = (U8 *) m;
1244                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1245                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1246                 /* used by commented-out code below */
1247                 /*const U32 uniflags = UTF8_ALLOW_DEFAULT;*/
1248                 
1249                 /* XXX: Since the node will be case folded at compile
1250                    time this logic is a little odd, although im not 
1251                    sure that its actually wrong. --dmq */
1252                    
1253                 c1 = to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1254                 c2 = to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1255
1256                 /* XXX: This is kinda strange. to_utf8_XYZ returns the 
1257                    codepoint of the first character in the converted
1258                    form, yet originally we did the extra step. 
1259                    No tests fail by commenting this code out however
1260                    so Ive left it out. -- dmq.
1261                    
1262                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, 
1263                                     0, uniflags);
1264                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1265                                     0, uniflags);
1266                 */
1267                 
1268                 lnc = 0;
1269                 while (sm < ((U8 *) m + ln)) {
1270                     lnc++;
1271                     sm += UTF8SKIP(sm);
1272                 }
1273             }
1274             else {
1275                 c1 = *(U8*)m;
1276                 c2 = PL_fold[c1];
1277             }
1278             goto do_exactf;
1279         case EXACTFL:
1280             m   = STRING(c);
1281             ln  = STR_LEN(c);
1282             lnc = (I32) ln;
1283             c1 = *(U8*)m;
1284             c2 = PL_fold_locale[c1];
1285           do_exactf:
1286             e = HOP3c(strend, -((I32)lnc), s);
1287
1288             if (!reginfo && e < s)
1289                 e = s;                  /* Due to minlen logic of intuit() */
1290
1291             /* The idea in the EXACTF* cases is to first find the
1292              * first character of the EXACTF* node and then, if
1293              * necessary, case-insensitively compare the full
1294              * text of the node.  The c1 and c2 are the first
1295              * characters (though in Unicode it gets a bit
1296              * more complicated because there are more cases
1297              * than just upper and lower: one needs to use
1298              * the so-called folding case for case-insensitive
1299              * matching (called "loose matching" in Unicode).
1300              * ibcmp_utf8() will do just that. */
1301
1302             if (do_utf8 || UTF) {
1303                 UV c, f;
1304                 U8 tmpbuf [UTF8_MAXBYTES+1];
1305                 STRLEN len = 1;
1306                 STRLEN foldlen;
1307                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1308                 if (c1 == c2) {
1309                     /* Upper and lower of 1st char are equal -
1310                      * probably not a "letter". */
1311                     while (s <= e) {
1312                         if (do_utf8) {
1313                             c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1314                                            uniflags);
1315                         } else {
1316                             c = *((U8*)s);
1317                         }                                         
1318                         REXEC_FBC_EXACTISH_CHECK(c == c1);
1319                     }
1320                 }
1321                 else {
1322                     while (s <= e) {
1323                         if (do_utf8) {
1324                             c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1325                                            uniflags);
1326                         } else {
1327                             c = *((U8*)s);
1328                         }
1329
1330                         /* Handle some of the three Greek sigmas cases.
1331                          * Note that not all the possible combinations
1332                          * are handled here: some of them are handled
1333                          * by the standard folding rules, and some of
1334                          * them (the character class or ANYOF cases)
1335                          * are handled during compiletime in
1336                          * regexec.c:S_regclass(). */
1337                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1338                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1339                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1340
1341                         REXEC_FBC_EXACTISH_CHECK(c == c1 || c == c2);
1342                     }
1343                 }
1344             }
1345             else {
1346                 /* Neither pattern nor string are UTF8 */
1347                 if (c1 == c2)
1348                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
1349                 else
1350                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
1351             }
1352             break;
1353         case BOUNDL:
1354             PL_reg_flags |= RF_tainted;
1355             /* FALL THROUGH */
1356         case BOUND:
1357             if (do_utf8) {
1358                 if (s == PL_bostr)
1359                     tmp = '\n';
1360                 else {
1361                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1362                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1363                 }
1364                 tmp = ((OP(c) == BOUND ?
1365                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1366                 LOAD_UTF8_CHARCLASS_ALNUM();
1367                 REXEC_FBC_UTF8_SCAN(
1368                     if (tmp == !(OP(c) == BOUND ?
1369                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1370                                  isALNUM_LC_utf8((U8*)s)))
1371                     {
1372                         tmp = !tmp;
1373                         REXEC_FBC_TRYIT;
1374                 }
1375                 );
1376             }
1377             else {
1378                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1379                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1380                 REXEC_FBC_SCAN(
1381                     if (tmp ==
1382                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1383                         tmp = !tmp;
1384                         REXEC_FBC_TRYIT;
1385                 }
1386                 );
1387             }
1388             if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s)))
1389                 goto got_it;
1390             break;
1391         case NBOUNDL:
1392             PL_reg_flags |= RF_tainted;
1393             /* FALL THROUGH */
1394         case NBOUND:
1395             if (do_utf8) {
1396                 if (s == PL_bostr)
1397                     tmp = '\n';
1398                 else {
1399                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1400                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1401                 }
1402                 tmp = ((OP(c) == NBOUND ?
1403                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1404                 LOAD_UTF8_CHARCLASS_ALNUM();
1405                 REXEC_FBC_UTF8_SCAN(
1406                     if (tmp == !(OP(c) == NBOUND ?
1407                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1408                                  isALNUM_LC_utf8((U8*)s)))
1409                         tmp = !tmp;
1410                     else REXEC_FBC_TRYIT;
1411                 );
1412             }
1413             else {
1414                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1415                 tmp = ((OP(c) == NBOUND ?
1416                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1417                 REXEC_FBC_SCAN(
1418                     if (tmp ==
1419                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1420                         tmp = !tmp;
1421                     else REXEC_FBC_TRYIT;
1422                 );
1423             }
1424             if ((!prog->minlen && !tmp) && (!reginfo || regtry(reginfo, &s)))
1425                 goto got_it;
1426             break;
1427         case ALNUM:
1428             REXEC_FBC_CSCAN_PRELOAD(
1429                 LOAD_UTF8_CHARCLASS_ALNUM(),
1430                 swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1431                 isALNUM(*s)
1432             );
1433         case ALNUML:
1434             REXEC_FBC_CSCAN_TAINT(
1435                 isALNUM_LC_utf8((U8*)s),
1436                 isALNUM_LC(*s)
1437             );
1438         case NALNUM:
1439             REXEC_FBC_CSCAN_PRELOAD(
1440                 LOAD_UTF8_CHARCLASS_ALNUM(),
1441                 !swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1442                 !isALNUM(*s)
1443             );
1444         case NALNUML:
1445             REXEC_FBC_CSCAN_TAINT(
1446                 !isALNUM_LC_utf8((U8*)s),
1447                 !isALNUM_LC(*s)
1448             );
1449         case SPACE:
1450             REXEC_FBC_CSCAN_PRELOAD(
1451                 LOAD_UTF8_CHARCLASS_SPACE(),
1452                 *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8),
1453                 isSPACE(*s)
1454             );
1455         case SPACEL:
1456             REXEC_FBC_CSCAN_TAINT(
1457                 *s == ' ' || isSPACE_LC_utf8((U8*)s),
1458                 isSPACE_LC(*s)
1459             );
1460         case NSPACE:
1461             REXEC_FBC_CSCAN_PRELOAD(
1462                 LOAD_UTF8_CHARCLASS_SPACE(),
1463                 !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)),
1464                 !isSPACE(*s)
1465             );
1466         case NSPACEL:
1467             REXEC_FBC_CSCAN_TAINT(
1468                 !(*s == ' ' || isSPACE_LC_utf8((U8*)s)),
1469                 !isSPACE_LC(*s)
1470             );
1471         case DIGIT:
1472             REXEC_FBC_CSCAN_PRELOAD(
1473                 LOAD_UTF8_CHARCLASS_DIGIT(),
1474                 swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1475                 isDIGIT(*s)
1476             );
1477         case DIGITL:
1478             REXEC_FBC_CSCAN_TAINT(
1479                 isDIGIT_LC_utf8((U8*)s),
1480                 isDIGIT_LC(*s)
1481             );
1482         case NDIGIT:
1483             REXEC_FBC_CSCAN_PRELOAD(
1484                 LOAD_UTF8_CHARCLASS_DIGIT(),
1485                 !swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1486                 !isDIGIT(*s)
1487             );
1488         case NDIGITL:
1489             REXEC_FBC_CSCAN_TAINT(
1490                 !isDIGIT_LC_utf8((U8*)s),
1491                 !isDIGIT_LC(*s)
1492             );
1493         case LNBREAK:
1494             REXEC_FBC_CSCAN(
1495                 is_LNBREAK_utf8(s),
1496                 is_LNBREAK_latin1(s)
1497             );
1498         case VERTWS:
1499             REXEC_FBC_CSCAN(
1500                 is_VERTWS_utf8(s),
1501                 is_VERTWS_latin1(s)
1502             );
1503         case NVERTWS:
1504             REXEC_FBC_CSCAN(
1505                 !is_VERTWS_utf8(s),
1506                 !is_VERTWS_latin1(s)
1507             );
1508         case HORIZWS:
1509             REXEC_FBC_CSCAN(
1510                 is_HORIZWS_utf8(s),
1511                 is_HORIZWS_latin1(s)
1512             );
1513         case NHORIZWS:
1514             REXEC_FBC_CSCAN(
1515                 !is_HORIZWS_utf8(s),
1516                 !is_HORIZWS_latin1(s)
1517             );      
1518         case AHOCORASICKC:
1519         case AHOCORASICK: 
1520             {
1521                 DECL_TRIE_TYPE(c);
1522                 /* what trie are we using right now */
1523                 reg_ac_data *aho
1524                     = (reg_ac_data*)progi->data->data[ ARG( c ) ];
1525                 reg_trie_data *trie
1526                     = (reg_trie_data*)progi->data->data[ aho->trie ];
1527                 HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
1528
1529                 const char *last_start = strend - trie->minlen;
1530 #ifdef DEBUGGING
1531                 const char *real_start = s;
1532 #endif
1533                 STRLEN maxlen = trie->maxlen;
1534                 SV *sv_points;
1535                 U8 **points; /* map of where we were in the input string
1536                                 when reading a given char. For ASCII this
1537                                 is unnecessary overhead as the relationship
1538                                 is always 1:1, but for Unicode, especially
1539                                 case folded Unicode this is not true. */
1540                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1541                 U8 *bitmap=NULL;
1542
1543
1544                 GET_RE_DEBUG_FLAGS_DECL;
1545
1546                 /* We can't just allocate points here. We need to wrap it in
1547                  * an SV so it gets freed properly if there is a croak while
1548                  * running the match */
1549                 ENTER;
1550                 SAVETMPS;
1551                 sv_points=newSV(maxlen * sizeof(U8 *));
1552                 SvCUR_set(sv_points,
1553                     maxlen * sizeof(U8 *));
1554                 SvPOK_on(sv_points);
1555                 sv_2mortal(sv_points);
1556                 points=(U8**)SvPV_nolen(sv_points );
1557                 if ( trie_type != trie_utf8_fold 
1558                      && (trie->bitmap || OP(c)==AHOCORASICKC) ) 
1559                 {
1560                     if (trie->bitmap) 
1561                         bitmap=(U8*)trie->bitmap;
1562                     else
1563                         bitmap=(U8*)ANYOF_BITMAP(c);
1564                 }
1565                 /* this is the Aho-Corasick algorithm modified a touch
1566                    to include special handling for long "unknown char" 
1567                    sequences. The basic idea being that we use AC as long
1568                    as we are dealing with a possible matching char, when
1569                    we encounter an unknown char (and we have not encountered
1570                    an accepting state) we scan forward until we find a legal 
1571                    starting char. 
1572                    AC matching is basically that of trie matching, except
1573                    that when we encounter a failing transition, we fall back
1574                    to the current states "fail state", and try the current char 
1575                    again, a process we repeat until we reach the root state, 
1576                    state 1, or a legal transition. If we fail on the root state 
1577                    then we can either terminate if we have reached an accepting 
1578                    state previously, or restart the entire process from the beginning 
1579                    if we have not.
1580
1581                  */
1582                 while (s <= last_start) {
1583                     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1584                     U8 *uc = (U8*)s;
1585                     U16 charid = 0;
1586                     U32 base = 1;
1587                     U32 state = 1;
1588                     UV uvc = 0;
1589                     STRLEN len = 0;
1590                     STRLEN foldlen = 0;
1591                     U8 *uscan = (U8*)NULL;
1592                     U8 *leftmost = NULL;
1593 #ifdef DEBUGGING                    
1594                     U32 accepted_word= 0;
1595 #endif
1596                     U32 pointpos = 0;
1597
1598                     while ( state && uc <= (U8*)strend ) {
1599                         int failed=0;
1600                         U32 word = aho->states[ state ].wordnum;
1601
1602                         if( state==1 ) {
1603                             if ( bitmap ) {
1604                                 DEBUG_TRIE_EXECUTE_r(
1605                                     if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1606                                         dump_exec_pos( (char *)uc, c, strend, real_start, 
1607                                             (char *)uc, do_utf8 );
1608                                         PerlIO_printf( Perl_debug_log,
1609                                             " Scanning for legal start char...\n");
1610                                     }
1611                                 );            
1612                                 while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
1613                                     uc++;
1614                                 }
1615                                 s= (char *)uc;
1616                             }
1617                             if (uc >(U8*)last_start) break;
1618                         }
1619                                             
1620                         if ( word ) {
1621                             U8 *lpos= points[ (pointpos - trie->wordlen[word-1] ) % maxlen ];
1622                             if (!leftmost || lpos < leftmost) {
1623                                 DEBUG_r(accepted_word=word);
1624                                 leftmost= lpos;
1625                             }
1626                             if (base==0) break;
1627                             
1628                         }
1629                         points[pointpos++ % maxlen]= uc;
1630                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
1631                                              uscan, len, uvc, charid, foldlen,
1632                                              foldbuf, uniflags);
1633                         DEBUG_TRIE_EXECUTE_r({
1634                             dump_exec_pos( (char *)uc, c, strend, real_start, 
1635                                 s,   do_utf8 );
1636                             PerlIO_printf(Perl_debug_log,
1637                                 " Charid:%3u CP:%4"UVxf" ",
1638                                  charid, uvc);
1639                         });
1640
1641                         do {
1642 #ifdef DEBUGGING
1643                             word = aho->states[ state ].wordnum;
1644 #endif
1645                             base = aho->states[ state ].trans.base;
1646
1647                             DEBUG_TRIE_EXECUTE_r({
1648                                 if (failed) 
1649                                     dump_exec_pos( (char *)uc, c, strend, real_start, 
1650                                         s,   do_utf8 );
1651                                 PerlIO_printf( Perl_debug_log,
1652                                     "%sState: %4"UVxf", word=%"UVxf,
1653                                     failed ? " Fail transition to " : "",
1654                                     (UV)state, (UV)word);
1655                             });
1656                             if ( base ) {
1657                                 U32 tmp;
1658                                 if (charid &&
1659                                      (base + charid > trie->uniquecharcount )
1660                                      && (base + charid - 1 - trie->uniquecharcount
1661                                             < trie->lasttrans)
1662                                      && trie->trans[base + charid - 1 -
1663                                             trie->uniquecharcount].check == state
1664                                      && (tmp=trie->trans[base + charid - 1 -
1665                                         trie->uniquecharcount ].next))
1666                                 {
1667                                     DEBUG_TRIE_EXECUTE_r(
1668                                         PerlIO_printf( Perl_debug_log," - legal\n"));
1669                                     state = tmp;
1670                                     break;
1671                                 }
1672                                 else {
1673                                     DEBUG_TRIE_EXECUTE_r(
1674                                         PerlIO_printf( Perl_debug_log," - fail\n"));
1675                                     failed = 1;
1676                                     state = aho->fail[state];
1677                                 }
1678                             }
1679                             else {
1680                                 /* we must be accepting here */
1681                                 DEBUG_TRIE_EXECUTE_r(
1682                                         PerlIO_printf( Perl_debug_log," - accepting\n"));
1683                                 failed = 1;
1684                                 break;
1685                             }
1686                         } while(state);
1687                         uc += len;
1688                         if (failed) {
1689                             if (leftmost)
1690                                 break;
1691                             if (!state) state = 1;
1692                         }
1693                     }
1694                     if ( aho->states[ state ].wordnum ) {
1695                         U8 *lpos = points[ (pointpos - trie->wordlen[aho->states[ state ].wordnum-1]) % maxlen ];
1696                         if (!leftmost || lpos < leftmost) {
1697                             DEBUG_r(accepted_word=aho->states[ state ].wordnum);
1698                             leftmost = lpos;
1699                         }
1700                     }
1701                     if (leftmost) {
1702                         s = (char*)leftmost;
1703                         DEBUG_TRIE_EXECUTE_r({
1704                             PerlIO_printf( 
1705                                 Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
1706                                 (UV)accepted_word, (IV)(s - real_start)
1707                             );
1708                         });
1709                         if (!reginfo || regtry(reginfo, &s)) {
1710                             FREETMPS;
1711                             LEAVE;
1712                             goto got_it;
1713                         }
1714                         s = HOPc(s,1);
1715                         DEBUG_TRIE_EXECUTE_r({
1716                             PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
1717                         });
1718                     } else {
1719                         DEBUG_TRIE_EXECUTE_r(
1720                             PerlIO_printf( Perl_debug_log,"No match.\n"));
1721                         break;
1722                     }
1723                 }
1724                 FREETMPS;
1725                 LEAVE;
1726             }
1727             break;
1728         default:
1729             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1730             break;
1731         }
1732         return 0;
1733       got_it:
1734         return s;
1735 }
1736
1737
1738 /*
1739  - regexec_flags - match a regexp against a string
1740  */
1741 I32
1742 Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
1743               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1744 /* strend: pointer to null at end of string */
1745 /* strbeg: real beginning of string */
1746 /* minend: end of match must be >=minend after stringarg. */
1747 /* data: May be used for some additional optimizations. 
1748          Currently its only used, with a U32 cast, for transmitting 
1749          the ganch offset when doing a /g match. This will change */
1750 /* nosave: For optimizations. */
1751 {
1752     dVAR;
1753     struct regexp *const prog = (struct regexp *)SvANY(rx);
1754     /*register*/ char *s;
1755     register regnode *c;
1756     /*register*/ char *startpos = stringarg;
1757     I32 minlen;         /* must match at least this many chars */
1758     I32 dontbother = 0; /* how many characters not to try at end */
1759     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1760     I32 scream_pos = -1;                /* Internal iterator of scream. */
1761     char *scream_olds = NULL;
1762     const bool do_utf8 = (bool)DO_UTF8(sv);
1763     I32 multiline;
1764     RXi_GET_DECL(prog,progi);
1765     regmatch_info reginfo;  /* create some info to pass to regtry etc */
1766     regexp_paren_pair *swap = NULL;
1767     GET_RE_DEBUG_FLAGS_DECL;
1768
1769     PERL_ARGS_ASSERT_REGEXEC_FLAGS;
1770     PERL_UNUSED_ARG(data);
1771
1772     /* Be paranoid... */
1773     if (prog == NULL || startpos == NULL) {
1774         Perl_croak(aTHX_ "NULL regexp parameter");
1775         return 0;
1776     }
1777
1778     multiline = prog->extflags & RXf_PMf_MULTILINE;
1779     reginfo.prog = rx;   /* Yes, sorry that this is confusing.  */
1780
1781     RX_MATCH_UTF8_set(rx, do_utf8);
1782     DEBUG_EXECUTE_r( 
1783         debug_start_match(rx, do_utf8, startpos, strend, 
1784         "Matching");
1785     );
1786
1787     minlen = prog->minlen;
1788     
1789     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
1790         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1791                               "String too short [regexec_flags]...\n"));
1792         goto phooey;
1793     }
1794
1795     
1796     /* Check validity of program. */
1797     if (UCHARAT(progi->program) != REG_MAGIC) {
1798         Perl_croak(aTHX_ "corrupted regexp program");
1799     }
1800
1801     PL_reg_flags = 0;
1802     PL_reg_eval_set = 0;
1803     PL_reg_maxiter = 0;
1804
1805     if (RX_UTF8(rx))
1806         PL_reg_flags |= RF_utf8;
1807
1808     /* Mark beginning of line for ^ and lookbehind. */
1809     reginfo.bol = startpos; /* XXX not used ??? */
1810     PL_bostr  = strbeg;
1811     reginfo.sv = sv;
1812
1813     /* Mark end of line for $ (and such) */
1814     PL_regeol = strend;
1815
1816     /* see how far we have to get to not match where we matched before */
1817     reginfo.till = startpos+minend;
1818
1819     /* If there is a "must appear" string, look for it. */
1820     s = startpos;
1821
1822     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
1823         MAGIC *mg;
1824
1825         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1826             reginfo.ganch = startpos + prog->gofs;
1827         else if (sv && SvTYPE(sv) >= SVt_PVMG
1828                   && SvMAGIC(sv)
1829                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1830                   && mg->mg_len >= 0) {
1831             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
1832             if (prog->extflags & RXf_ANCH_GPOS) {
1833                 if (s > reginfo.ganch)
1834                     goto phooey;
1835                 s = reginfo.ganch - prog->gofs;
1836                 if (s < strbeg)
1837                     goto phooey;
1838             }
1839         }
1840         else if (data) {
1841             reginfo.ganch = strbeg + PTR2UV(data);
1842         } else                          /* pos() not defined */
1843             reginfo.ganch = strbeg;
1844     }
1845     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
1846         /* We have to be careful. If the previous successful match
1847            was from this regex we don't want a subsequent partially
1848            successful match to clobber the old results.
1849            So when we detect this possibility we add a swap buffer
1850            to the re, and switch the buffer each match. If we fail
1851            we switch it back, otherwise we leave it swapped.
1852         */
1853         swap = prog->offs;
1854         /* do we need a save destructor here for eval dies? */
1855         Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
1856     }
1857     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1858         re_scream_pos_data d;
1859
1860         d.scream_olds = &scream_olds;
1861         d.scream_pos = &scream_pos;
1862         s = re_intuit_start(rx, sv, s, strend, flags, &d);
1863         if (!s) {
1864             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1865             goto phooey;        /* not present */
1866         }
1867     }
1868
1869
1870
1871     /* Simplest case:  anchored match need be tried only once. */
1872     /*  [unless only anchor is BOL and multiline is set] */
1873     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
1874         if (s == startpos && regtry(&reginfo, &startpos))
1875             goto got_it;
1876         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
1877                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
1878         {
1879             char *end;
1880
1881             if (minlen)
1882                 dontbother = minlen - 1;
1883             end = HOP3c(strend, -dontbother, strbeg) - 1;
1884             /* for multiline we only have to try after newlines */
1885             if (prog->check_substr || prog->check_utf8) {
1886                 if (s == startpos)
1887                     goto after_try;
1888                 while (1) {
1889                     if (regtry(&reginfo, &s))
1890                         goto got_it;
1891                   after_try:
1892                     if (s > end)
1893                         goto phooey;
1894                     if (prog->extflags & RXf_USE_INTUIT) {
1895                         s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
1896                         if (!s)
1897                             goto phooey;
1898                     }
1899                     else
1900                         s++;
1901                 }               
1902             } else {
1903                 if (s > startpos)
1904                     s--;
1905                 while (s < end) {
1906                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1907                         if (regtry(&reginfo, &s))
1908                             goto got_it;
1909                     }
1910                 }               
1911             }
1912         }
1913         goto phooey;
1914     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK)) 
1915     {
1916         /* the warning about reginfo.ganch being used without intialization
1917            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN 
1918            and we only enter this block when the same bit is set. */
1919         char *tmp_s = reginfo.ganch - prog->gofs;
1920
1921         if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
1922             goto got_it;
1923         goto phooey;
1924     }
1925
1926     /* Messy cases:  unanchored match. */
1927     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
1928         /* we have /x+whatever/ */
1929         /* it must be a one character string (XXXX Except UTF?) */
1930         char ch;
1931 #ifdef DEBUGGING
1932         int did_match = 0;
1933 #endif
1934         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1935             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1936         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1937
1938         if (do_utf8) {
1939             REXEC_FBC_SCAN(
1940                 if (*s == ch) {
1941                     DEBUG_EXECUTE_r( did_match = 1 );
1942                     if (regtry(&reginfo, &s)) goto got_it;
1943                     s += UTF8SKIP(s);
1944                     while (s < strend && *s == ch)
1945                         s += UTF8SKIP(s);
1946                 }
1947             );
1948         }
1949         else {
1950             REXEC_FBC_SCAN(
1951                 if (*s == ch) {
1952                     DEBUG_EXECUTE_r( did_match = 1 );
1953                     if (regtry(&reginfo, &s)) goto got_it;
1954                     s++;
1955                     while (s < strend && *s == ch)
1956                         s++;
1957                 }
1958             );
1959         }
1960         DEBUG_EXECUTE_r(if (!did_match)
1961                 PerlIO_printf(Perl_debug_log,
1962                                   "Did not find anchored character...\n")
1963                );
1964     }
1965     else if (prog->anchored_substr != NULL
1966               || prog->anchored_utf8 != NULL
1967               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1968                   && prog->float_max_offset < strend - s)) {
1969         SV *must;
1970         I32 back_max;
1971         I32 back_min;
1972         char *last;
1973         char *last1;            /* Last position checked before */
1974 #ifdef DEBUGGING
1975         int did_match = 0;
1976 #endif
1977         if (prog->anchored_substr || prog->anchored_utf8) {
1978             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1979                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1980             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1981             back_max = back_min = prog->anchored_offset;
1982         } else {
1983             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1984                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1985             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1986             back_max = prog->float_max_offset;
1987             back_min = prog->float_min_offset;
1988         }
1989         
1990             
1991         if (must == &PL_sv_undef)
1992             /* could not downgrade utf8 check substring, so must fail */
1993             goto phooey;
1994
1995         if (back_min<0) {
1996             last = strend;
1997         } else {
1998             last = HOP3c(strend,        /* Cannot start after this */
1999                   -(I32)(CHR_SVLEN(must)
2000                          - (SvTAIL(must) != 0) + back_min), strbeg);
2001         }
2002         if (s > PL_bostr)
2003             last1 = HOPc(s, -1);
2004         else
2005             last1 = s - 1;      /* bogus */
2006
2007         /* XXXX check_substr already used to find "s", can optimize if
2008            check_substr==must. */
2009         scream_pos = -1;
2010         dontbother = end_shift;
2011         strend = HOPc(strend, -dontbother);
2012         while ( (s <= last) &&
2013                 ((flags & REXEC_SCREAM)
2014                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
2015                                     end_shift, &scream_pos, 0))
2016                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
2017                                   (unsigned char*)strend, must,
2018                                   multiline ? FBMrf_MULTILINE : 0))) ) {
2019             /* we may be pointing at the wrong string */
2020             if ((flags & REXEC_SCREAM) && RXp_MATCH_COPIED(prog))
2021                 s = strbeg + (s - SvPVX_const(sv));
2022             DEBUG_EXECUTE_r( did_match = 1 );
2023             if (HOPc(s, -back_max) > last1) {
2024                 last1 = HOPc(s, -back_min);
2025                 s = HOPc(s, -back_max);
2026             }
2027             else {
2028                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
2029
2030                 last1 = HOPc(s, -back_min);
2031                 s = t;
2032             }
2033             if (do_utf8) {
2034                 while (s <= last1) {
2035                     if (regtry(&reginfo, &s))
2036                         goto got_it;
2037                     s += UTF8SKIP(s);
2038                 }
2039             }
2040             else {
2041                 while (s <= last1) {
2042                     if (regtry(&reginfo, &s))
2043                         goto got_it;
2044                     s++;
2045                 }
2046             }
2047         }
2048         DEBUG_EXECUTE_r(if (!did_match) {
2049             RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), 
2050                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
2051             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
2052                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
2053                                ? "anchored" : "floating"),
2054                 quoted, RE_SV_TAIL(must));
2055         });                 
2056         goto phooey;
2057     }
2058     else if ( (c = progi->regstclass) ) {
2059         if (minlen) {
2060             const OPCODE op = OP(progi->regstclass);
2061             /* don't bother with what can't match */
2062             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
2063                 strend = HOPc(strend, -(minlen - 1));
2064         }
2065         DEBUG_EXECUTE_r({
2066             SV * const prop = sv_newmortal();
2067             regprop(prog, prop, c);
2068             {
2069                 RE_PV_QUOTED_DECL(quoted,do_utf8,PERL_DEBUG_PAD_ZERO(1),
2070                     s,strend-s,60);
2071                 PerlIO_printf(Perl_debug_log,
2072                     "Matching stclass %.*s against %s (%d chars)\n",
2073                     (int)SvCUR(prop), SvPVX_const(prop),
2074                      quoted, (int)(strend - s));
2075             }
2076         });
2077         if (find_byclass(prog, c, s, strend, &reginfo))
2078             goto got_it;
2079         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
2080     }
2081     else {
2082         dontbother = 0;
2083         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2084             /* Trim the end. */
2085             char *last;
2086             SV* float_real;
2087
2088             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
2089                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
2090             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
2091
2092             if (flags & REXEC_SCREAM) {
2093                 last = screaminstr(sv, float_real, s - strbeg,
2094                                    end_shift, &scream_pos, 1); /* last one */
2095                 if (!last)
2096                     last = scream_olds; /* Only one occurrence. */
2097                 /* we may be pointing at the wrong string */
2098                 else if (RXp_MATCH_COPIED(prog))
2099                     s = strbeg + (s - SvPVX_const(sv));
2100             }
2101             else {
2102                 STRLEN len;
2103                 const char * const little = SvPV_const(float_real, len);
2104
2105                 if (SvTAIL(float_real)) {
2106                     if (memEQ(strend - len + 1, little, len - 1))
2107                         last = strend - len + 1;
2108                     else if (!multiline)
2109                         last = memEQ(strend - len, little, len)
2110                             ? strend - len : NULL;
2111                     else
2112                         goto find_last;
2113                 } else {
2114                   find_last:
2115                     if (len)
2116                         last = rninstr(s, strend, little, little + len);
2117                     else
2118                         last = strend;  /* matching "$" */
2119                 }
2120             }
2121             if (last == NULL) {
2122                 DEBUG_EXECUTE_r(
2123                     PerlIO_printf(Perl_debug_log,
2124                         "%sCan't trim the tail, match fails (should not happen)%s\n",
2125                         PL_colors[4], PL_colors[5]));
2126                 goto phooey; /* Should not happen! */
2127             }
2128             dontbother = strend - last + prog->float_min_offset;
2129         }
2130         if (minlen && (dontbother < minlen))
2131             dontbother = minlen - 1;
2132         strend -= dontbother;              /* this one's always in bytes! */
2133         /* We don't know much -- general case. */
2134         if (do_utf8) {
2135             for (;;) {
2136                 if (regtry(&reginfo, &s))
2137                     goto got_it;
2138                 if (s >= strend)
2139                     break;
2140                 s += UTF8SKIP(s);
2141             };
2142         }
2143         else {
2144             do {
2145                 if (regtry(&reginfo, &s))
2146                     goto got_it;
2147             } while (s++ < strend);
2148         }
2149     }
2150
2151     /* Failure. */
2152     goto phooey;
2153
2154 got_it:
2155     Safefree(swap);
2156     RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
2157
2158     if (PL_reg_eval_set)
2159         restore_pos(aTHX_ prog);
2160     if (RXp_PAREN_NAMES(prog)) 
2161         (void)hv_iterinit(RXp_PAREN_NAMES(prog));
2162
2163     /* make sure $`, $&, $', and $digit will work later */
2164     if ( !(flags & REXEC_NOT_FIRST) ) {
2165         RX_MATCH_COPY_FREE(rx);
2166         if (flags & REXEC_COPY_STR) {
2167             const I32 i = PL_regeol - startpos + (stringarg - strbeg);
2168 #ifdef PERL_OLD_COPY_ON_WRITE
2169             if ((SvIsCOW(sv)
2170                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2171                 if (DEBUG_C_TEST) {
2172                     PerlIO_printf(Perl_debug_log,
2173                                   "Copy on write: regexp capture, type %d\n",
2174                                   (int) SvTYPE(sv));
2175                 }
2176                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2177                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2178                 assert (SvPOKp(prog->saved_copy));
2179             } else
2180 #endif
2181             {
2182                 RX_MATCH_COPIED_on(rx);
2183                 s = savepvn(strbeg, i);
2184                 prog->subbeg = s;
2185             }
2186             prog->sublen = i;
2187         }
2188         else {
2189             prog->subbeg = strbeg;
2190             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2191         }
2192     }
2193
2194     return 1;
2195
2196 phooey:
2197     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2198                           PL_colors[4], PL_colors[5]));
2199     if (PL_reg_eval_set)
2200         restore_pos(aTHX_ prog);
2201     if (swap) {
2202         /* we failed :-( roll it back */
2203         Safefree(prog->offs);
2204         prog->offs = swap;
2205     }
2206
2207     return 0;
2208 }
2209
2210
2211 /*
2212  - regtry - try match at specific point
2213  */
2214 STATIC I32                      /* 0 failure, 1 success */
2215 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
2216 {
2217     dVAR;
2218     CHECKPOINT lastcp;
2219     REGEXP *const rx = reginfo->prog;
2220     regexp *const prog = (struct regexp *)SvANY(rx);
2221     RXi_GET_DECL(prog,progi);
2222     GET_RE_DEBUG_FLAGS_DECL;
2223
2224     PERL_ARGS_ASSERT_REGTRY;
2225
2226     reginfo->cutpoint=NULL;
2227
2228     if ((prog->extflags & RXf_EVAL_SEEN) && !PL_reg_eval_set) {
2229         MAGIC *mg;
2230
2231         PL_reg_eval_set = RS_init;
2232         DEBUG_EXECUTE_r(DEBUG_s(
2233             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2234                           (IV)(PL_stack_sp - PL_stack_base));
2235             ));
2236         SAVESTACK_CXPOS();
2237         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2238         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2239         SAVETMPS;
2240         /* Apparently this is not needed, judging by wantarray. */
2241         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2242            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2243
2244         if (reginfo->sv) {
2245             /* Make $_ available to executed code. */
2246             if (reginfo->sv != DEFSV) {
2247                 SAVE_DEFSV;
2248                 DEFSV_set(reginfo->sv);
2249             }
2250         
2251             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2252                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2253                 /* prepare for quick setting of pos */
2254 #ifdef PERL_OLD_COPY_ON_WRITE
2255                 if (SvIsCOW(reginfo->sv))
2256                     sv_force_normal_flags(reginfo->sv, 0);
2257 #endif
2258                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2259                                  &PL_vtbl_mglob, NULL, 0);
2260                 mg->mg_len = -1;
2261             }
2262             PL_reg_magic    = mg;
2263             PL_reg_oldpos   = mg->mg_len;
2264             SAVEDESTRUCTOR_X(restore_pos, prog);
2265         }
2266         if (!PL_reg_curpm) {
2267             Newxz(PL_reg_curpm, 1, PMOP);
2268 #ifdef USE_ITHREADS
2269             {
2270                 SV* const repointer = &PL_sv_undef;
2271                 /* this regexp is also owned by the new PL_reg_curpm, which
2272                    will try to free it.  */
2273                 av_push(PL_regex_padav, repointer);
2274                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2275                 PL_regex_pad = AvARRAY(PL_regex_padav);
2276             }
2277 #endif      
2278         }
2279 #ifdef USE_ITHREADS
2280         /* It seems that non-ithreads works both with and without this code.
2281            So for efficiency reasons it seems best not to have the code
2282            compiled when it is not needed.  */
2283         /* This is safe against NULLs: */
2284         ReREFCNT_dec(PM_GETRE(PL_reg_curpm));
2285         /* PM_reg_curpm owns a reference to this regexp.  */
2286         ReREFCNT_inc(rx);
2287 #endif
2288         PM_SETRE(PL_reg_curpm, rx);
2289         PL_reg_oldcurpm = PL_curpm;
2290         PL_curpm = PL_reg_curpm;
2291         if (RXp_MATCH_COPIED(prog)) {
2292             /*  Here is a serious problem: we cannot rewrite subbeg,
2293                 since it may be needed if this match fails.  Thus
2294                 $` inside (?{}) could fail... */
2295             PL_reg_oldsaved = prog->subbeg;
2296             PL_reg_oldsavedlen = prog->sublen;
2297 #ifdef PERL_OLD_COPY_ON_WRITE
2298             PL_nrs = prog->saved_copy;
2299 #endif
2300             RXp_MATCH_COPIED_off(prog);
2301         }
2302         else
2303             PL_reg_oldsaved = NULL;
2304         prog->subbeg = PL_bostr;
2305         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2306     }
2307     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
2308     prog->offs[0].start = *startpos - PL_bostr;
2309     PL_reginput = *startpos;
2310     PL_reglastparen = &prog->lastparen;
2311     PL_reglastcloseparen = &prog->lastcloseparen;
2312     prog->lastparen = 0;
2313     prog->lastcloseparen = 0;
2314     PL_regsize = 0;
2315     PL_regoffs = prog->offs;
2316     if (PL_reg_start_tmpl <= prog->nparens) {
2317         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2318         if(PL_reg_start_tmp)
2319             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2320         else
2321             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2322     }
2323
2324     /* XXXX What this code is doing here?!!!  There should be no need
2325        to do this again and again, PL_reglastparen should take care of
2326        this!  --ilya*/
2327
2328     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2329      * Actually, the code in regcppop() (which Ilya may be meaning by
2330      * PL_reglastparen), is not needed at all by the test suite
2331      * (op/regexp, op/pat, op/split), but that code is needed otherwise
2332      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
2333      * Meanwhile, this code *is* needed for the
2334      * above-mentioned test suite tests to succeed.  The common theme
2335      * on those tests seems to be returning null fields from matches.
2336      * --jhi updated by dapm */
2337 #if 1
2338     if (prog->nparens) {
2339         regexp_paren_pair *pp = PL_regoffs;
2340         register I32 i;
2341         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2342             ++pp;
2343             pp->start = -1;
2344             pp->end = -1;
2345         }
2346     }
2347 #endif
2348     REGCP_SET(lastcp);
2349     if (regmatch(reginfo, progi->program + 1)) {
2350         PL_regoffs[0].end = PL_reginput - PL_bostr;
2351         return 1;
2352     }
2353     if (reginfo->cutpoint)
2354         *startpos= reginfo->cutpoint;
2355     REGCP_UNWIND(lastcp);
2356     return 0;
2357 }
2358
2359
2360 #define sayYES goto yes
2361 #define sayNO goto no
2362 #define sayNO_SILENT goto no_silent
2363
2364 /* we dont use STMT_START/END here because it leads to 
2365    "unreachable code" warnings, which are bogus, but distracting. */
2366 #define CACHEsayNO \
2367     if (ST.cache_mask) \
2368        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2369     sayNO
2370
2371 /* this is used to determine how far from the left messages like
2372    'failed...' are printed. It should be set such that messages 
2373    are inline with the regop output that created them.
2374 */
2375 #define REPORT_CODE_OFF 32
2376
2377
2378 /* Make sure there is a test for this +1 options in re_tests */
2379 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2380
2381 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2382 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2383
2384 #define SLAB_FIRST(s) (&(s)->states[0])
2385 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2386
2387 /* grab a new slab and return the first slot in it */
2388
2389 STATIC regmatch_state *
2390 S_push_slab(pTHX)
2391 {
2392 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2393     dMY_CXT;
2394 #endif
2395     regmatch_slab *s = PL_regmatch_slab->next;
2396     if (!s) {
2397         Newx(s, 1, regmatch_slab);
2398         s->prev = PL_regmatch_slab;
2399         s->next = NULL;
2400         PL_regmatch_slab->next = s;
2401     }
2402     PL_regmatch_slab = s;
2403     return SLAB_FIRST(s);
2404 }
2405
2406
2407 /* push a new state then goto it */
2408
2409 #define PUSH_STATE_GOTO(state, node) \
2410     scan = node; \
2411     st->resume_state = state; \
2412     goto push_state;
2413
2414 /* push a new state with success backtracking, then goto it */
2415
2416 #define PUSH_YES_STATE_GOTO(state, node) \
2417     scan = node; \
2418     st->resume_state = state; \
2419     goto push_yes_state;
2420
2421
2422
2423 /*
2424
2425 regmatch() - main matching routine
2426
2427 This is basically one big switch statement in a loop. We execute an op,
2428 set 'next' to point the next op, and continue. If we come to a point which
2429 we may need to backtrack to on failure such as (A|B|C), we push a
2430 backtrack state onto the backtrack stack. On failure, we pop the top
2431 state, and re-enter the loop at the state indicated. If there are no more
2432 states to pop, we return failure.
2433
2434 Sometimes we also need to backtrack on success; for example /A+/, where
2435 after successfully matching one A, we need to go back and try to
2436 match another one; similarly for lookahead assertions: if the assertion
2437 completes successfully, we backtrack to the state just before the assertion
2438 and then carry on.  In these cases, the pushed state is marked as
2439 'backtrack on success too'. This marking is in fact done by a chain of
2440 pointers, each pointing to the previous 'yes' state. On success, we pop to
2441 the nearest yes state, discarding any intermediate failure-only states.
2442 Sometimes a yes state is pushed just to force some cleanup code to be
2443 called at the end of a successful match or submatch; e.g. (??{$re}) uses
2444 it to free the inner regex.
2445
2446 Note that failure backtracking rewinds the cursor position, while
2447 success backtracking leaves it alone.
2448
2449 A pattern is complete when the END op is executed, while a subpattern
2450 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
2451 ops trigger the "pop to last yes state if any, otherwise return true"
2452 behaviour.
2453
2454 A common convention in this function is to use A and B to refer to the two
2455 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
2456 the subpattern to be matched possibly multiple times, while B is the entire
2457 rest of the pattern. Variable and state names reflect this convention.
2458
2459 The states in the main switch are the union of ops and failure/success of
2460 substates associated with with that op.  For example, IFMATCH is the op
2461 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
2462 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
2463 successfully matched A and IFMATCH_A_fail is a state saying that we have
2464 just failed to match A. Resume states always come in pairs. The backtrack
2465 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
2466 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
2467 on success or failure.
2468
2469 The struct that holds a backtracking state is actually a big union, with
2470 one variant for each major type of op. The variable st points to the
2471 top-most backtrack struct. To make the code clearer, within each
2472 block of code we #define ST to alias the relevant union.
2473
2474 Here's a concrete example of a (vastly oversimplified) IFMATCH
2475 implementation:
2476
2477     switch (state) {
2478     ....
2479
2480 #define ST st->u.ifmatch
2481
2482     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2483         ST.foo = ...; // some state we wish to save
2484         ...
2485         // push a yes backtrack state with a resume value of
2486         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
2487         // first node of A:
2488         PUSH_YES_STATE_GOTO(IFMATCH_A, A);
2489         // NOTREACHED
2490
2491     case IFMATCH_A: // we have successfully executed A; now continue with B
2492         next = B;
2493         bar = ST.foo; // do something with the preserved value
2494         break;
2495
2496     case IFMATCH_A_fail: // A failed, so the assertion failed
2497         ...;   // do some housekeeping, then ...
2498         sayNO; // propagate the failure
2499
2500 #undef ST
2501
2502     ...
2503     }
2504
2505 For any old-timers reading this who are familiar with the old recursive
2506 approach, the code above is equivalent to:
2507
2508     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2509     {
2510         int foo = ...
2511         ...
2512         if (regmatch(A)) {
2513             next = B;
2514             bar = foo;
2515             break;
2516         }
2517         ...;   // do some housekeeping, then ...
2518         sayNO; // propagate the failure
2519     }
2520
2521 The topmost backtrack state, pointed to by st, is usually free. If you
2522 want to claim it, populate any ST.foo fields in it with values you wish to
2523 save, then do one of
2524
2525         PUSH_STATE_GOTO(resume_state, node);
2526         PUSH_YES_STATE_GOTO(resume_state, node);
2527
2528 which sets that backtrack state's resume value to 'resume_state', pushes a
2529 new free entry to the top of the backtrack stack, then goes to 'node'.
2530 On backtracking, the free slot is popped, and the saved state becomes the
2531 new free state. An ST.foo field in this new top state can be temporarily
2532 accessed to retrieve values, but once the main loop is re-entered, it
2533 becomes available for reuse.
2534
2535 Note that the depth of the backtrack stack constantly increases during the
2536 left-to-right execution of the pattern, rather than going up and down with
2537 the pattern nesting. For example the stack is at its maximum at Z at the
2538 end of the pattern, rather than at X in the following:
2539
2540     /(((X)+)+)+....(Y)+....Z/
2541
2542 The only exceptions to this are lookahead/behind assertions and the cut,
2543 (?>A), which pop all the backtrack states associated with A before
2544 continuing.
2545  
2546 Bascktrack state structs are allocated in slabs of about 4K in size.
2547 PL_regmatch_state and st always point to the currently active state,
2548 and PL_regmatch_slab points to the slab currently containing
2549 PL_regmatch_state.  The first time regmatch() is called, the first slab is
2550 allocated, and is never freed until interpreter destruction. When the slab
2551 is full, a new one is allocated and chained to the end. At exit from
2552 regmatch(), slabs allocated since entry are freed.
2553
2554 */
2555  
2556
2557 #define DEBUG_STATE_pp(pp)                                  \
2558     DEBUG_STATE_r({                                         \
2559         DUMP_EXEC_POS(locinput, scan, do_utf8);             \
2560         PerlIO_printf(Perl_debug_log,                       \
2561             "    %*s"pp" %s%s%s%s%s\n",                     \
2562             depth*2, "",                                    \
2563             PL_reg_name[st->resume_state],                     \
2564             ((st==yes_state||st==mark_state) ? "[" : ""),   \
2565             ((st==yes_state) ? "Y" : ""),                   \
2566             ((st==mark_state) ? "M" : ""),                  \
2567             ((st==yes_state||st==mark_state) ? "]" : "")    \
2568         );                                                  \
2569     });
2570
2571
2572 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
2573
2574 #ifdef DEBUGGING
2575
2576 STATIC void
2577 S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8, 
2578     const char *start, const char *end, const char *blurb)
2579 {
2580     const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
2581
2582     PERL_ARGS_ASSERT_DEBUG_START_MATCH;
2583
2584     if (!PL_colorset)   
2585             reginitcolors();    
2586     {
2587         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
2588             RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);   
2589         
2590         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1), 
2591             start, end - start, 60); 
2592         
2593         PerlIO_printf(Perl_debug_log, 
2594             "%s%s REx%s %s against %s\n", 
2595                        PL_colors[4], blurb, PL_colors[5], s0, s1); 
2596         
2597         if (do_utf8||utf8_pat) 
2598             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
2599                 utf8_pat ? "pattern" : "",
2600                 utf8_pat && do_utf8 ? " and " : "",
2601                 do_utf8 ? "string" : ""
2602             ); 
2603     }
2604 }
2605
2606 STATIC void
2607 S_dump_exec_pos(pTHX_ const char *locinput, 
2608                       const regnode *scan, 
2609                       const char *loc_regeol, 
2610                       const char *loc_bostr, 
2611                       const char *loc_reg_starttry,
2612                       const bool do_utf8)
2613 {
2614     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
2615     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2616     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
2617     /* The part of the string before starttry has one color
2618        (pref0_len chars), between starttry and current
2619        position another one (pref_len - pref0_len chars),
2620        after the current position the third one.
2621        We assume that pref0_len <= pref_len, otherwise we
2622        decrease pref0_len.  */
2623     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
2624         ? (5 + taill) - l : locinput - loc_bostr;
2625     int pref0_len;
2626
2627     PERL_ARGS_ASSERT_DUMP_EXEC_POS;
2628
2629     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2630         pref_len++;
2631     pref0_len = pref_len  - (locinput - loc_reg_starttry);
2632     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
2633         l = ( loc_regeol - locinput > (5 + taill) - pref_len
2634               ? (5 + taill) - pref_len : loc_regeol - locinput);
2635     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2636         l--;
2637     if (pref0_len < 0)
2638         pref0_len = 0;
2639     if (pref0_len > pref_len)
2640         pref0_len = pref_len;
2641     {
2642         const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
2643
2644         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
2645             (locinput - pref_len),pref0_len, 60, 4, 5);
2646         
2647         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
2648                     (locinput - pref_len + pref0_len),
2649                     pref_len - pref0_len, 60, 2, 3);
2650         
2651         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
2652                     locinput, loc_regeol - locinput, 10, 0, 1);
2653
2654         const STRLEN tlen=len0+len1+len2;
2655         PerlIO_printf(Perl_debug_log,
2656                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
2657                     (IV)(locinput - loc_bostr),
2658                     len0, s0,
2659                     len1, s1,
2660                     (docolor ? "" : "> <"),
2661                     len2, s2,
2662                     (int)(tlen > 19 ? 0 :  19 - tlen),
2663                     "");
2664     }
2665 }
2666
2667 #endif
2668
2669 /* reg_check_named_buff_matched()
2670  * Checks to see if a named buffer has matched. The data array of 
2671  * buffer numbers corresponding to the buffer is expected to reside
2672  * in the regexp->data->data array in the slot stored in the ARG() of
2673  * node involved. Note that this routine doesn't actually care about the
2674  * name, that information is not preserved from compilation to execution.
2675  * Returns the index of the leftmost defined buffer with the given name
2676  * or 0 if non of the buffers matched.
2677  */
2678 STATIC I32
2679 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
2680 {
2681     I32 n;
2682     RXi_GET_DECL(rex,rexi);
2683     SV *sv_dat= MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
2684     I32 *nums=(I32*)SvPVX(sv_dat);
2685
2686     PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED;
2687
2688     for ( n=0; n<SvIVX(sv_dat); n++ ) {
2689         if ((I32)*PL_reglastparen >= nums[n] &&
2690             PL_regoffs[nums[n]].end != -1)
2691         {
2692             return nums[n];
2693         }
2694     }
2695     return 0;
2696 }
2697
2698
2699 /* free all slabs above current one  - called during LEAVE_SCOPE */
2700
2701 STATIC void
2702 S_clear_backtrack_stack(pTHX_ void *p)
2703 {
2704     regmatch_slab *s = PL_regmatch_slab->next;
2705     PERL_UNUSED_ARG(p);
2706
2707     if (!s)
2708         return;
2709     PL_regmatch_slab->next = NULL;
2710     while (s) {
2711         regmatch_slab * const osl = s;
2712         s = s->next;
2713         Safefree(osl);
2714     }
2715 }
2716
2717
2718 #define SETREX(Re1,Re2) \
2719     if (PL_reg_eval_set) PM_SETRE((PL_reg_curpm), (Re2)); \
2720     Re1 = (Re2)
2721
2722 STATIC I32                      /* 0 failure, 1 success */
2723 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
2724 {
2725 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2726     dMY_CXT;
2727 #endif
2728     dVAR;
2729     register const bool do_utf8 = PL_reg_match_utf8;
2730     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2731     REGEXP *rex_sv = reginfo->prog;
2732     regexp *rex = (struct regexp *)SvANY(rex_sv);
2733     RXi_GET_DECL(rex,rexi);
2734     I32 oldsave;
2735     /* the current state. This is a cached copy of PL_regmatch_state */
2736     register regmatch_state *st;
2737     /* cache heavy used fields of st in registers */
2738     register regnode *scan;
2739     register regnode *next;
2740     register U32 n = 0; /* general value; init to avoid compiler warning */
2741     register I32 ln = 0; /* len or last;  init to avoid compiler warning */
2742     register char *locinput = PL_reginput;
2743     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2744
2745     bool result = 0;        /* return value of S_regmatch */
2746     int depth = 0;          /* depth of backtrack stack */
2747     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
2748     const U32 max_nochange_depth =
2749         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
2750         3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
2751     regmatch_state *yes_state = NULL; /* state to pop to on success of
2752                                                             subpattern */
2753     /* mark_state piggy backs on the yes_state logic so that when we unwind 
2754        the stack on success we can update the mark_state as we go */
2755     regmatch_state *mark_state = NULL; /* last mark state we have seen */
2756     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
2757     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
2758     U32 state_num;
2759     bool no_final = 0;      /* prevent failure from backtracking? */
2760     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
2761     char *startpoint = PL_reginput;
2762     SV *popmark = NULL;     /* are we looking for a mark? */
2763     SV *sv_commit = NULL;   /* last mark name seen in failure */
2764     SV *sv_yes_mark = NULL; /* last mark name we have seen 
2765                                during a successfull match */
2766     U32 lastopen = 0;       /* last open we saw */
2767     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;   
2768     SV* const oreplsv = GvSV(PL_replgv);
2769     /* these three flags are set by various ops to signal information to
2770      * the very next op. They have a useful lifetime of exactly one loop
2771      * iteration, and are not preserved or restored by state pushes/pops
2772      */
2773     bool sw = 0;            /* the condition value in (?(cond)a|b) */
2774     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
2775     int logical = 0;        /* the following EVAL is:
2776                                 0: (?{...})
2777                                 1: (?(?{...})X|Y)
2778                                 2: (??{...})
2779                                or the following IFMATCH/UNLESSM is:
2780                                 false: plain (?=foo)
2781                                 true:  used as a condition: (?(?=foo))
2782                             */
2783 #ifdef DEBUGGING
2784     GET_RE_DEBUG_FLAGS_DECL;
2785 #endif
2786
2787     PERL_ARGS_ASSERT_REGMATCH;
2788
2789     DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
2790             PerlIO_printf(Perl_debug_log,"regmatch start\n");
2791     }));
2792     /* on first ever call to regmatch, allocate first slab */
2793     if (!PL_regmatch_slab) {
2794         Newx(PL_regmatch_slab, 1, regmatch_slab);
2795         PL_regmatch_slab->prev = NULL;
2796         PL_regmatch_slab->next = NULL;
2797         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
2798     }
2799
2800     oldsave = PL_savestack_ix;
2801     SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
2802     SAVEVPTR(PL_regmatch_slab);
2803     SAVEVPTR(PL_regmatch_state);
2804
2805     /* grab next free state slot */
2806     st = ++PL_regmatch_state;
2807     if (st >  SLAB_LAST(PL_regmatch_slab))
2808         st = PL_regmatch_state = S_push_slab(aTHX);
2809
2810     /* Note that nextchr is a byte even in UTF */
2811     nextchr = UCHARAT(locinput);
2812     scan = prog;
2813     while (scan != NULL) {
2814
2815         DEBUG_EXECUTE_r( {
2816             SV * const prop = sv_newmortal();
2817             regnode *rnext=regnext(scan);
2818             DUMP_EXEC_POS( locinput, scan, do_utf8 );
2819             regprop(rex, prop, scan);
2820             
2821             PerlIO_printf(Perl_debug_log,
2822                     "%3"IVdf":%*s%s(%"IVdf")\n",
2823                     (IV)(scan - rexi->program), depth*2, "",
2824                     SvPVX_const(prop),
2825                     (PL_regkind[OP(scan)] == END || !rnext) ? 
2826                         0 : (IV)(rnext - rexi->program));
2827         });
2828
2829         next = scan + NEXT_OFF(scan);
2830         if (next == scan)
2831             next = NULL;
2832         state_num = OP(scan);
2833
2834       reenter_switch:
2835
2836         assert(PL_reglastparen == &rex->lastparen);
2837         assert(PL_reglastcloseparen == &rex->lastcloseparen);
2838         assert(PL_regoffs == rex->offs);
2839
2840         switch (state_num) {
2841         case BOL:
2842             if (locinput == PL_bostr)
2843             {
2844                 /* reginfo->till = reginfo->bol; */
2845                 break;
2846             }
2847             sayNO;
2848         case MBOL:
2849             if (locinput == PL_bostr ||
2850                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2851             {
2852                 break;
2853             }
2854             sayNO;
2855         case SBOL:
2856             if (locinput == PL_bostr)
2857                 break;
2858             sayNO;
2859         case GPOS:
2860             if (locinput == reginfo->ganch)
2861                 break;
2862             sayNO;
2863
2864         case KEEPS:
2865             /* update the startpoint */
2866             st->u.keeper.val = PL_regoffs[0].start;
2867             PL_reginput = locinput;
2868             PL_regoffs[0].start = locinput - PL_bostr;
2869             PUSH_STATE_GOTO(KEEPS_next, next);
2870             /*NOT-REACHED*/
2871         case KEEPS_next_fail:
2872             /* rollback the start point change */
2873             PL_regoffs[0].start = st->u.keeper.val;
2874             sayNO_SILENT;
2875             /*NOT-REACHED*/
2876         case EOL:
2877                 goto seol;
2878         case MEOL:
2879             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2880                 sayNO;
2881             break;
2882         case SEOL:
2883           seol:
2884             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2885                 sayNO;
2886             if (PL_regeol - locinput > 1)
2887                 sayNO;
2888             break;
2889         case EOS:
2890             if (PL_regeol != locinput)
2891                 sayNO;
2892             break;
2893         case SANY:
2894             if (!nextchr && locinput >= PL_regeol)
2895                 sayNO;
2896             if (do_utf8) {
2897                 locinput += PL_utf8skip[nextchr];
2898                 if (locinput > PL_regeol)
2899                     sayNO;
2900                 nextchr = UCHARAT(locinput);
2901             }
2902             else
2903                 nextchr = UCHARAT(++locinput);
2904             break;
2905         case CANY:
2906             if (!nextchr && locinput >= PL_regeol)
2907                 sayNO;
2908             nextchr = UCHARAT(++locinput);
2909             break;
2910         case REG_ANY:
2911             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2912                 sayNO;
2913             if (do_utf8) {
2914                 locinput += PL_utf8skip[nextchr];
2915                 if (locinput > PL_regeol)
2916                     sayNO;
2917                 nextchr = UCHARAT(locinput);
2918             }
2919             else
2920                 nextchr = UCHARAT(++locinput);
2921             break;
2922
2923 #undef  ST
2924 #define ST st->u.trie
2925         case TRIEC:
2926             /* In this case the charclass data is available inline so
2927                we can fail fast without a lot of extra overhead. 
2928              */
2929             if (scan->flags == EXACT || !do_utf8) {
2930                 if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
2931                     DEBUG_EXECUTE_r(
2932                         PerlIO_printf(Perl_debug_log,
2933                                   "%*s  %sfailed to match trie start class...%s\n",
2934                                   REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2935                     );
2936                     sayNO_SILENT;
2937                     /* NOTREACHED */
2938                 }                       
2939             }
2940             /* FALL THROUGH */
2941         case TRIE:
2942             {
2943                 /* what type of TRIE am I? (utf8 makes this contextual) */
2944                 DECL_TRIE_TYPE(scan);
2945
2946                 /* what trie are we using right now */
2947                 reg_trie_data * const trie
2948                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
2949                 HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]);
2950                 U32 state = trie->startstate;
2951
2952                 if (trie->bitmap && trie_type != trie_utf8_fold &&
2953                     !TRIE_BITMAP_TEST(trie,*locinput)
2954                 ) {
2955                     if (trie->states[ state ].wordnum) {
2956                          DEBUG_EXECUTE_r(
2957                             PerlIO_printf(Perl_debug_log,
2958                                           "%*s  %smatched empty string...%s\n",
2959                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2960                         );
2961                         break;
2962                     } else {
2963                         DEBUG_EXECUTE_r(
2964                             PerlIO_printf(Perl_debug_log,
2965                                           "%*s  %sfailed to match trie start class...%s\n",
2966                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2967                         );
2968                         sayNO_SILENT;
2969                    }
2970                 }
2971
2972             { 
2973                 U8 *uc = ( U8* )locinput;
2974
2975                 STRLEN len = 0;
2976                 STRLEN foldlen = 0;
2977                 U8 *uscan = (U8*)NULL;
2978                 STRLEN bufflen=0;
2979                 SV *sv_accept_buff = NULL;
2980                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2981
2982                 ST.accepted = 0; /* how many accepting states we have seen */
2983                 ST.B = next;
2984                 ST.jump = trie->jump;
2985                 ST.me = scan;
2986                 /*
2987                    traverse the TRIE keeping track of all accepting states
2988                    we transition through until we get to a failing node.
2989                 */
2990
2991                 while ( state && uc <= (U8*)PL_regeol ) {
2992                     U32 base = trie->states[ state ].trans.base;
2993                     UV uvc = 0;
2994                     U16 charid;
2995                     /* We use charid to hold the wordnum as we don't use it
2996                        for charid until after we have done the wordnum logic. 
2997                        We define an alias just so that the wordnum logic reads
2998                        more naturally. */
2999
3000 #define got_wordnum charid
3001                     got_wordnum = trie->states[ state ].wordnum;
3002
3003                     if ( got_wordnum ) {
3004                         if ( ! ST.accepted ) {
3005                             ENTER;
3006                             SAVETMPS; /* XXX is this necessary? dmq */
3007                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
3008                             sv_accept_buff=newSV(bufflen *
3009                                             sizeof(reg_trie_accepted) - 1);
3010                             SvCUR_set(sv_accept_buff, 0);
3011                             SvPOK_on(sv_accept_buff);
3012                             sv_2mortal(sv_accept_buff);
3013                             SAVETMPS;
3014                             ST.accept_buff =
3015                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
3016                         }
3017                         do {
3018                             if (ST.accepted >= bufflen) {
3019                                 bufflen *= 2;
3020                                 ST.accept_buff =(reg_trie_accepted*)
3021                                     SvGROW(sv_accept_buff,
3022                                         bufflen * sizeof(reg_trie_accepted));
3023                             }
3024                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
3025                                 + sizeof(reg_trie_accepted));
3026
3027
3028                             ST.accept_buff[ST.accepted].wordnum = got_wordnum;
3029                             ST.accept_buff[ST.accepted].endpos = uc;
3030                             ++ST.accepted;
3031                         } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
3032                     }
3033 #undef got_wordnum 
3034
3035                     DEBUG_TRIE_EXECUTE_r({
3036                                 DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
3037                                 PerlIO_printf( Perl_debug_log,
3038                                     "%*s  %sState: %4"UVxf" Accepted: %4"UVxf" ",
3039                                     2+depth * 2, "", PL_colors[4],
3040                                     (UV)state, (UV)ST.accepted );
3041                     });
3042
3043                     if ( base ) {
3044                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
3045                                              uscan, len, uvc, charid, foldlen,
3046                                              foldbuf, uniflags);
3047
3048                         if (charid &&
3049                              (base + charid > trie->uniquecharcount )
3050                              && (base + charid - 1 - trie->uniquecharcount
3051                                     < trie->lasttrans)
3052                              && trie->trans[base + charid - 1 -
3053                                     trie->uniquecharcount].check == state)
3054                         {
3055                             state = trie->trans[base + charid - 1 -
3056                                 trie->uniquecharcount ].next;
3057                         }
3058                         else {
3059                             state = 0;
3060                         }
3061                         uc += len;
3062
3063                     }
3064                     else {
3065                         state = 0;
3066                     }
3067                     DEBUG_TRIE_EXECUTE_r(
3068                         PerlIO_printf( Perl_debug_log,
3069                             "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
3070                             charid, uvc, (UV)state, PL_colors[5] );
3071                     );
3072                 }
3073                 if (!ST.accepted )
3074                    sayNO;
3075
3076                 DEBUG_EXECUTE_r(
3077                     PerlIO_printf( Perl_debug_log,
3078                         "%*s  %sgot %"IVdf" possible matches%s\n",
3079                         REPORT_CODE_OFF + depth * 2, "",
3080                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
3081                 );
3082             }}
3083             goto trie_first_try; /* jump into the fail handler */
3084             /* NOTREACHED */
3085         case TRIE_next_fail: /* we failed - try next alterative */
3086             if ( ST.jump) {
3087                 REGCP_UNWIND(ST.cp);
3088                 for (n = *PL_reglastparen; n > ST.lastparen; n--)
3089                     PL_regoffs[n].end = -1;
3090                 *PL_reglastparen = n;
3091             }
3092           trie_first_try:
3093             if (do_cutgroup) {
3094                 do_cutgroup = 0;
3095                 no_final = 0;
3096             }
3097
3098             if ( ST.jump) {
3099                 ST.lastparen = *PL_reglastparen;
3100                 REGCP_SET(ST.cp);
3101             }           
3102             if ( ST.accepted == 1 ) {
3103                 /* only one choice left - just continue */
3104                 DEBUG_EXECUTE_r({
3105                     AV *const trie_words
3106                         = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
3107                     SV ** const tmp = av_fetch( trie_words, 
3108                         ST.accept_buff[ 0 ].wordnum-1, 0 );
3109                     SV *sv= tmp ? sv_newmortal() : NULL;
3110                     
3111                     PerlIO_printf( Perl_debug_log,
3112                         "%*s  %sonly one match left: #%d <%s>%s\n",
3113                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3114                         ST.accept_buff[ 0 ].wordnum,
3115                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0, 
3116                                 PL_colors[0], PL_colors[1],
3117                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3118                             ) 
3119                         : "not compiled under -Dr",
3120                         PL_colors[5] );
3121                 });
3122                 PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
3123                 /* in this case we free tmps/leave before we call regmatch
3124                    as we wont be using accept_buff again. */
3125                 
3126                 locinput = PL_reginput;
3127                 nextchr = UCHARAT(locinput);
3128                 if ( !ST.jump || !ST.jump[ST.accept_buff[0].wordnum]) 
3129                     scan = ST.B;
3130                 else
3131                     scan = ST.me + ST.jump[ST.accept_buff[0].wordnum];
3132                 if (!has_cutgroup) {
3133                     FREETMPS;
3134                     LEAVE;
3135                 } else {
3136                     ST.accepted--;
3137                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3138                 }
3139                 
3140                 continue; /* execute rest of RE */
3141             }
3142             
3143             if ( !ST.accepted-- ) {
3144                 DEBUG_EXECUTE_r({
3145                     PerlIO_printf( Perl_debug_log,
3146                         "%*s  %sTRIE failed...%s\n",
3147                         REPORT_CODE_OFF+depth*2, "", 
3148                         PL_colors[4],
3149                         PL_colors[5] );
3150                 });
3151                 FREETMPS;
3152                 LEAVE;
3153                 sayNO_SILENT;
3154                 /*NOTREACHED*/
3155             } 
3156
3157             /*
3158                There are at least two accepting states left.  Presumably
3159                the number of accepting states is going to be low,
3160                typically two. So we simply scan through to find the one
3161                with lowest wordnum.  Once we find it, we swap the last
3162                state into its place and decrement the size. We then try to
3163                match the rest of the pattern at the point where the word
3164                ends. If we succeed, control just continues along the
3165                regex; if we fail we return here to try the next accepting
3166                state
3167              */
3168
3169             {
3170                 U32 best = 0;
3171                 U32 cur;
3172                 for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
3173                     DEBUG_TRIE_EXECUTE_r(
3174                         PerlIO_printf( Perl_debug_log,
3175                             "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
3176                             REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
3177                             (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
3178                             ST.accept_buff[ cur ].wordnum, PL_colors[5] );
3179                     );
3180
3181                     if (ST.accept_buff[cur].wordnum <
3182                             ST.accept_buff[best].wordnum)
3183                         best = cur;
3184                 }
3185
3186                 DEBUG_EXECUTE_r({
3187                     AV *const trie_words
3188                         = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
3189                     SV ** const tmp = av_fetch( trie_words, 
3190                         ST.accept_buff[ best ].wordnum - 1, 0 );
3191                     regnode *nextop=(!ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) ? 
3192                                     ST.B : 
3193                                     ST.me + ST.jump[ST.accept_buff[best].wordnum];    
3194                     SV *sv= tmp ? sv_newmortal() : NULL;
3195                     
3196                     PerlIO_printf( Perl_debug_log, 
3197                         "%*s  %strying alternation #%d <%s> at node #%d %s\n",
3198                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3199                         ST.accept_buff[best].wordnum,
3200                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0, 
3201                                 PL_colors[0], PL_colors[1],
3202                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3203                             ) : "not compiled under -Dr", 
3204                             REG_NODE_NUM(nextop),
3205                         PL_colors[5] );
3206                 });
3207
3208                 if ( best<ST.accepted ) {
3209                     reg_trie_accepted tmp = ST.accept_buff[ best ];
3210                     ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
3211                     ST.accept_buff[ ST.accepted ] = tmp;
3212                     best = ST.accepted;
3213                 }
3214                 PL_reginput = (char *)ST.accept_buff[ best ].endpos;
3215                 if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
3216                     scan = ST.B;
3217                 } else {
3218                     scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
3219                 }
3220                 PUSH_YES_STATE_GOTO(TRIE_next, scan);    
3221                 /* NOTREACHED */
3222             }
3223             /* NOTREACHED */
3224         case TRIE_next:
3225             /* we dont want to throw this away, see bug 57042*/
3226             if (oreplsv != GvSV(PL_replgv))
3227                 sv_setsv(oreplsv, GvSV(PL_replgv));
3228             FREETMPS;
3229             LEAVE;
3230             sayYES;
3231 #undef  ST
3232
3233         case EXACT: {
3234             char *s = STRING(scan);
3235             ln = STR_LEN(scan);
3236             if (do_utf8 != UTF) {
3237                 /* The target and the pattern have differing utf8ness. */
3238                 char *l = locinput;
3239                 const char * const e = s + ln;
3240
3241                 if (do_utf8) {
3242                     /* The target is utf8, the pattern is not utf8. */
3243                     while (s < e) {
3244                         STRLEN ulen;
3245                         if (l >= PL_regeol)
3246                              sayNO;
3247                         if (NATIVE_TO_UNI(*(U8*)s) !=
3248                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
3249                                             uniflags))
3250                              sayNO;
3251                         l += ulen;
3252                         s ++;
3253                     }
3254                 }
3255                 else {
3256                     /* The target is not utf8, the pattern is utf8. */
3257                     while (s < e) {
3258                         STRLEN ulen;
3259                         if (l >= PL_regeol)
3260                             sayNO;
3261                         if (NATIVE_TO_UNI(*((U8*)l)) !=
3262                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
3263                                            uniflags))
3264                             sayNO;
3265                         s += ulen;
3266                         l ++;
3267                     }
3268                 }
3269                 locinput = l;
3270                 nextchr = UCHARAT(locinput);
3271                 break;
3272             }
3273             /* The target and the pattern have the same utf8ness. */
3274             /* Inline the first character, for speed. */
3275             if (UCHARAT(s) != nextchr)
3276                 sayNO;
3277             if (PL_regeol - locinput < ln)
3278                 sayNO;
3279             if (ln > 1 && memNE(s, locinput, ln))
3280                 sayNO;
3281             locinput += ln;
3282             nextchr = UCHARAT(locinput);
3283             break;
3284             }
3285         case EXACTFL:
3286             PL_reg_flags |= RF_tainted;
3287             /* FALL THROUGH */
3288         case EXACTF: {
3289             char * const s = STRING(scan);
3290             ln = STR_LEN(scan);
3291
3292             if (do_utf8 || UTF) {
3293               /* Either target or the pattern are utf8. */
3294                 const char * const l = locinput;
3295                 char *e = PL_regeol;
3296
3297                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
3298                                l, &e, 0,  do_utf8)) {
3299                      /* One more case for the sharp s:
3300                       * pack("U0U*", 0xDF) =~ /ss/i,
3301                       * the 0xC3 0x9F are the UTF-8
3302                       * byte sequence for the U+00DF. */
3303
3304                      if (!(do_utf8 &&
3305                            toLOWER(s[0]) == 's' &&
3306                            ln >= 2 &&
3307                            toLOWER(s[1]) == 's' &&
3308                            (U8)l[0] == 0xC3 &&
3309                            e - l >= 2 &&
3310                            (U8)l[1] == 0x9F))
3311                           sayNO;
3312                 }
3313                 locinput = e;
3314                 nextchr = UCHARAT(locinput);
3315                 break;
3316             }
3317
3318             /* Neither the target and the pattern are utf8. */
3319
3320             /* Inline the first character, for speed. */
3321             if (UCHARAT(s) != nextchr &&
3322                 UCHARAT(s) != ((OP(scan) == EXACTF)
3323                                ? PL_fold : PL_fold_locale)[nextchr])
3324                 sayNO;
3325             if (PL_regeol - locinput < ln)
3326                 sayNO;
3327             if (ln > 1 && (OP(scan) == EXACTF
3328                            ? ibcmp(s, locinput, ln)
3329                            : ibcmp_locale(s, locinput, ln)))
3330                 sayNO;
3331             locinput += ln;
3332             nextchr = UCHARAT(locinput);
3333             break;
3334             }
3335         case ANYOF:
3336             if (do_utf8) {
3337                 STRLEN inclasslen = PL_regeol - locinput;
3338
3339                 if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, do_utf8))
3340                     goto anyof_fail;
3341                 if (locinput >= PL_regeol)
3342                     sayNO;
3343                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
3344                 nextchr = UCHARAT(locinput);
3345                 break;
3346             }
3347             else {
3348                 if (nextchr < 0)
3349                     nextchr = UCHARAT(locinput);
3350                 if (!REGINCLASS(rex, scan, (U8*)locinput))
3351                     goto anyof_fail;
3352                 if (!nextchr && locinput >= PL_regeol)
3353                     sayNO;
3354                 nextchr = UCHARAT(++locinput);
3355                 break;
3356             }
3357         anyof_fail:
3358             /* If we might have the case of the German sharp s
3359              * in a casefolding Unicode character class. */
3360
3361             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
3362                  locinput += SHARP_S_SKIP;
3363                  nextchr = UCHARAT(locinput);
3364             }
3365             else
3366                  sayNO;
3367             break;
3368         case ALNUML:
3369             PL_reg_flags |= RF_tainted;
3370             /* FALL THROUGH */
3371         case ALNUM:
3372             if (!nextchr)
3373                 sayNO;
3374             if (do_utf8) {
3375                 LOAD_UTF8_CHARCLASS_ALNUM();
3376                 if (!(OP(scan) == ALNUM
3377                       ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3378                       : isALNUM_LC_utf8((U8*)locinput)))
3379                 {
3380                     sayNO;
3381                 }
3382                 locinput += PL_utf8skip[nextchr];
3383                 nextchr = UCHARAT(locinput);
3384                 break;
3385             }
3386             if (!(OP(scan) == ALNUM
3387                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3388                 sayNO;
3389             nextchr = UCHARAT(++locinput);
3390             break;
3391         case NALNUML:
3392             PL_reg_flags |= RF_tainted;
3393             /* FALL THROUGH */
3394         case NALNUM:
3395             if (!nextchr && locinput >= PL_regeol)
3396                 sayNO;
3397             if (do_utf8) {
3398                 LOAD_UTF8_CHARCLASS_ALNUM();
3399                 if (OP(scan) == NALNUM
3400                     ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3401                     : isALNUM_LC_utf8((U8*)locinput))
3402                 {
3403                     sayNO;
3404                 }
3405                 locinput += PL_utf8skip[nextchr];
3406                 nextchr = UCHARAT(locinput);
3407                 break;
3408             }
3409             if (OP(scan) == NALNUM
3410                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3411                 sayNO;
3412             nextchr = UCHARAT(++locinput);
3413             break;
3414         case BOUNDL:
3415         case NBOUNDL:
3416             PL_reg_flags |= RF_tainted;
3417             /* FALL THROUGH */
3418         case BOUND:
3419         case NBOUND:
3420             /* was last char in word? */
3421             if (do_utf8) {
3422                 if (locinput == PL_bostr)
3423                     ln = '\n';
3424                 else {
3425                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3426                 
3427                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3428                 }
3429                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3430                     ln = isALNUM_uni(ln);
3431                     LOAD_UTF8_CHARCLASS_ALNUM();
3432                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3433                 }
3434                 else {
3435                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
3436                     n = isALNUM_LC_utf8((U8*)locinput);
3437                 }
3438             }
3439             else {
3440                 ln = (locinput != PL_bostr) ?
3441                     UCHARAT(locinput - 1) : '\n';
3442                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3443                     ln = isALNUM(ln);
3444                     n = isALNUM(nextchr);
3445                 }
3446                 else {
3447                     ln = isALNUM_LC(ln);
3448                     n = isALNUM_LC(nextchr);
3449                 }
3450             }
3451             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3452                                     OP(scan) == BOUNDL))
3453                     sayNO;
3454             break;
3455         case SPACEL:
3456             PL_reg_flags |= RF_tainted;
3457             /* FALL THROUGH */
3458         case SPACE:
3459             if (!nextchr)
3460                 sayNO;
3461             if (do_utf8) {
3462                 if (UTF8_IS_CONTINUED(nextchr)) {
3463                     LOAD_UTF8_CHARCLASS_SPACE();
3464                     if (!(OP(scan) == SPACE
3465                           ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3466                           : isSPACE_LC_utf8((U8*)locinput)))
3467                     {
3468                         sayNO;
3469                     }
3470                     locinput += PL_utf8skip[nextchr];
3471                     nextchr = UCHARAT(locinput);
3472                     break;
3473                 }
3474                 if (!(OP(scan) == SPACE
3475                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3476                     sayNO;
3477                 nextchr = UCHARAT(++locinput);
3478             }
3479             else {
3480                 if (!(OP(scan) == SPACE
3481                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3482                     sayNO;
3483                 nextchr = UCHARAT(++locinput);
3484             }
3485             break;
3486         case NSPACEL:
3487             PL_reg_flags |= RF_tainted;
3488             /* FALL THROUGH */
3489         case NSPACE:
3490             if (!nextchr && locinput >= PL_regeol)
3491                 sayNO;
3492             if (do_utf8) {
3493                 LOAD_UTF8_CHARCLASS_SPACE();
3494                 if (OP(scan) == NSPACE
3495                     ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3496                     : isSPACE_LC_utf8((U8*)locinput))
3497                 {
3498                     sayNO;
3499                 }
3500                 locinput += PL_utf8skip[nextchr];
3501                 nextchr = UCHARAT(locinput);
3502                 break;
3503             }
3504             if (OP(scan) == NSPACE
3505                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3506                 sayNO;
3507             nextchr = UCHARAT(++locinput);
3508             break;
3509         case DIGITL:
3510             PL_reg_flags |= RF_tainted;
3511             /* FALL THROUGH */
3512         case DIGIT:
3513             if (!nextchr)
3514                 sayNO;
3515             if (do_utf8) {
3516                 LOAD_UTF8_CHARCLASS_DIGIT();
3517                 if (!(OP(scan) == DIGIT
3518                       ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3519                       : isDIGIT_LC_utf8((U8*)locinput)))
3520                 {
3521                     sayNO;
3522                 }
3523                 locinput += PL_utf8skip[nextchr];
3524                 nextchr = UCHARAT(locinput);
3525                 break;
3526             }
3527             if (!(OP(scan) == DIGIT
3528                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3529                 sayNO;
3530             nextchr = UCHARAT(++locinput);
3531             break;
3532         case NDIGITL:
3533             PL_reg_flags |= RF_tainted;
3534             /* FALL THROUGH */
3535         case NDIGIT:
3536             if (!nextchr && locinput >= PL_regeol)
3537                 sayNO;
3538             if (do_utf8) {
3539                 LOAD_UTF8_CHARCLASS_DIGIT();
3540                 if (OP(scan) == NDIGIT
3541                     ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3542                     : isDIGIT_LC_utf8((U8*)locinput))
3543                 {
3544                     sayNO;
3545                 }
3546                 locinput += PL_utf8skip[nextchr];
3547                 nextchr = UCHARAT(locinput);
3548                 break;
3549             }
3550             if (OP(scan) == NDIGIT
3551                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3552                 sayNO;
3553             nextchr = UCHARAT(++locinput);
3554             break;
3555         case CLUMP:
3556             if (locinput >= PL_regeol)
3557                 sayNO;
3558             if  (do_utf8) {
3559                 LOAD_UTF8_CHARCLASS_MARK();
3560                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3561                     sayNO;
3562                 locinput += PL_utf8skip[nextchr];
3563                 while (locinput < PL_regeol &&
3564                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3565                     locinput += UTF8SKIP(locinput);
3566                 if (locinput > PL_regeol)
3567                     sayNO;
3568             } 
3569             else
3570                locinput++;
3571             nextchr = UCHARAT(locinput);
3572             break;
3573             
3574         case NREFFL:
3575         {
3576             char *s;
3577             char type;
3578             PL_reg_flags |= RF_tainted;
3579             /* FALL THROUGH */
3580         case NREF:
3581         case NREFF:
3582             type = OP(scan);
3583             n = reg_check_named_buff_matched(rex,scan);
3584
3585             if ( n ) {
3586                 type = REF + ( type - NREF );
3587                 goto do_ref;
3588             } else {
3589                 sayNO;
3590             }
3591             /* unreached */
3592         case REFFL:
3593             PL_reg_flags |= RF_tainted;
3594             /* FALL THROUGH */
3595         case REF:
3596         case REFF: 
3597             n = ARG(scan);  /* which paren pair */
3598             type = OP(scan);
3599           do_ref:  
3600             ln = PL_regoffs[n].start;
3601             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3602             if (*PL_reglastparen < n || ln == -1)
3603                 sayNO;                  /* Do not match unless seen CLOSEn. */
3604             if (ln == PL_regoffs[n].end)
3605                 break;
3606
3607             s = PL_bostr + ln;
3608             if (do_utf8 && type != REF) {       /* REF can do byte comparison */
3609                 char *l = locinput;
3610                 const char *e = PL_bostr + PL_regoffs[n].end;
3611                 /*
3612                  * Note that we can't do the "other character" lookup trick as
3613                  * in the 8-bit case (no pun intended) because in Unicode we
3614                  * have to map both upper and title case to lower case.
3615                  */
3616                 if (type == REFF) {
3617                     while (s < e) {
3618                         STRLEN ulen1, ulen2;
3619                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3620                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3621
3622                         if (l >= PL_regeol)
3623                             sayNO;
3624                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3625                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3626                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3627                             sayNO;
3628                         s += ulen1;
3629                         l += ulen2;
3630                     }
3631                 }
3632                 locinput = l;
3633                 nextchr = UCHARAT(locinput);
3634                 break;
3635             }
3636
3637             /* Inline the first character, for speed. */
3638             if (UCHARAT(s) != nextchr &&
3639                 (type == REF ||
3640                  (UCHARAT(s) != (type == REFF
3641                                   ? PL_fold : PL_fold_locale)[nextchr])))
3642                 sayNO;
3643             ln = PL_regoffs[n].end - ln;
3644             if (locinput + ln > PL_regeol)
3645                 sayNO;
3646             if (ln > 1 && (type == REF
3647                            ? memNE(s, locinput, ln)
3648                            : (type == REFF
3649                               ? ibcmp(s, locinput, ln)
3650                               : ibcmp_locale(s, locinput, ln))))
3651                 sayNO;
3652             locinput += ln;
3653             nextchr = UCHARAT(locinput);
3654             break;
3655         }
3656         case NOTHING:
3657         case TAIL:
3658             break;
3659         case BACK:
3660             break;
3661
3662 #undef  ST
3663 #define ST st->u.eval
3664         {
3665             SV *ret;
3666             REGEXP *re_sv;
3667             regexp *re;
3668             regexp_internal *rei;
3669             regnode *startpoint;
3670
3671         case GOSTART:
3672         case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
3673             if (cur_eval && cur_eval->locinput==locinput) {
3674                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan)) 
3675                     Perl_croak(aTHX_ "Infinite recursion in regex");
3676                 if ( ++nochange_depth > max_nochange_depth )
3677                     Perl_croak(aTHX_ 
3678                         "Pattern subroutine nesting without pos change"
3679                         " exceeded limit in regex");
3680             } else {
3681                 nochange_depth = 0;
3682             }
3683             re_sv = rex_sv;
3684             re = rex;
3685             rei = rexi;
3686             (void)ReREFCNT_inc(rex_sv);
3687             if (OP(scan)==GOSUB) {
3688                 startpoint = scan + ARG2L(scan);
3689                 ST.close_paren = ARG(scan);
3690             } else {
3691                 startpoint = rei->program+1;
3692                 ST.close_paren = 0;
3693             }
3694             goto eval_recurse_doit;
3695             /* NOTREACHED */
3696         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */        
3697             if (cur_eval && cur_eval->locinput==locinput) {
3698                 if ( ++nochange_depth > max_nochange_depth )
3699                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
3700             } else {
3701                 nochange_depth = 0;
3702             }    
3703             {
3704                 /* execute the code in the {...} */
3705                 dSP;
3706                 SV ** const before = SP;
3707                 OP_4tree * const oop = PL_op;
3708                 COP * const ocurcop = PL_curcop;
3709                 PAD *old_comppad;
3710                 char *saved_regeol = PL_regeol;
3711             
3712                 n = ARG(scan);
3713                 PL_op = (OP_4tree*)rexi->data->data[n];
3714                 DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, 
3715                     "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3716                 PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
3717                 PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
3718
3719                 if (sv_yes_mark) {
3720                     SV *sv_mrk = get_sv("REGMARK", 1);
3721                     sv_setsv(sv_mrk, sv_yes_mark);
3722                 }
3723
3724                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3725                 SPAGAIN;
3726                 if (SP == before)
3727                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3728                 else {
3729                     ret = POPs;
3730                     PUTBACK;
3731                 }
3732
3733                 PL_op = oop;
3734                 PAD_RESTORE_LOCAL(old_comppad);
3735                 PL_curcop = ocurcop;
3736                 PL_regeol = saved_regeol;
3737                 if (!logical) {
3738                     /* /(?{...})/ */
3739                     sv_setsv(save_scalar(PL_replgv), ret);
3740                     break;
3741                 }
3742             }
3743             if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
3744                 logical = 0;
3745                 {
3746                     /* extract RE object from returned value; compiling if
3747                      * necessary */
3748                     MAGIC *mg = NULL;
3749                     REGEXP *rx = NULL;
3750
3751                     if (SvROK(ret)) {
3752                         SV *const sv = SvRV(ret);
3753
3754                         if (SvTYPE(sv) == SVt_REGEXP) {
3755                             rx = (REGEXP*) sv;
3756                         } else if (SvSMAGICAL(sv)) {
3757                             mg = mg_find(sv, PERL_MAGIC_qr);
3758                             assert(mg);
3759                         }
3760                     } else if (SvTYPE(ret) == SVt_REGEXP) {
3761                         rx = (REGEXP*) ret;
3762                     } else if (SvSMAGICAL(ret)) {
3763                         if (SvGMAGICAL(ret)) {
3764                             /* I don't believe that there is ever qr magic
3765                                here.  */
3766                             assert(!mg_find(ret, PERL_MAGIC_qr));
3767                             sv_unmagic(ret, PERL_MAGIC_qr);
3768                         }
3769                         else {
3770                             mg = mg_find(ret, PERL_MAGIC_qr);
3771                             /* testing suggests mg only ends up non-NULL for
3772                                scalars who were upgraded and compiled in the
3773                                else block below. In turn, this is only
3774                                triggered in the "postponed utf8 string" tests
3775                                in t/op/pat.t  */
3776                         }
3777                     }
3778
3779                     if (mg) {
3780                         rx = (REGEXP *) mg->mg_obj; /*XXX:dmq*/
3781                         assert(rx);
3782                     }
3783                     if (rx) {
3784                         rx = reg_temp_copy(rx);
3785                     }
3786                     else {
3787                         U32 pm_flags = 0;
3788                         const I32 osize = PL_regsize;
3789
3790                         if (DO_UTF8(ret)) {
3791                             assert (SvUTF8(ret));
3792                         } else if (SvUTF8(ret)) {
3793                             /* Not doing UTF-8, despite what the SV says. Is
3794                                this only if we're trapped in use 'bytes'?  */
3795                             /* Make a copy of the octet sequence, but without
3796                                the flag on, as the compiler now honours the
3797                                SvUTF8 flag on ret.  */
3798                             STRLEN len;
3799                             const char *const p = SvPV(ret, len);
3800                             ret = newSVpvn_flags(p, len, SVs_TEMP);
3801                         }
3802                         rx = CALLREGCOMP(ret, pm_flags);
3803                         if (!(SvFLAGS(ret)
3804                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3805                                  | SVs_GMG))) {
3806                             /* This isn't a first class regexp. Instead, it's
3807                                caching a regexp onto an existing, Perl visible
3808                                scalar.  */
3809                             sv_magic(ret, MUTABLE_SV(rx), PERL_MAGIC_qr, 0, 0);
3810                         }
3811                         PL_regsize = osize;
3812                     }
3813                     re_sv = rx;
3814                     re = (struct regexp *)SvANY(rx);
3815                 }
3816                 RXp_MATCH_COPIED_off(re);
3817                 re->subbeg = rex->subbeg;
3818                 re->sublen = rex->sublen;
3819                 rei = RXi_GET(re);
3820                 DEBUG_EXECUTE_r(
3821                     debug_start_match(re_sv, do_utf8, locinput, PL_regeol, 
3822                         "Matching embedded");
3823                 );              
3824                 startpoint = rei->program + 1;
3825                 ST.close_paren = 0; /* only used for GOSUB */
3826                 /* borrowed from regtry */
3827                 if (PL_reg_start_tmpl <= re->nparens) {
3828                     PL_reg_start_tmpl = re->nparens*3/2 + 3;
3829                     if(PL_reg_start_tmp)
3830                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3831                     else
3832                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3833                 }                       
3834
3835         eval_recurse_doit: /* Share code with GOSUB below this line */                          
3836                 /* run the pattern returned from (??{...}) */
3837                 ST.cp = regcppush(0);   /* Save *all* the positions. */
3838                 REGCP_SET(ST.lastcp);
3839                 
3840                 PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
3841                 
3842                 /* see regtry, specifically PL_reglast(?:close)?paren is a pointer! (i dont know why) :dmq */
3843                 PL_reglastparen = &re->lastparen;
3844                 PL_reglastcloseparen = &re->lastcloseparen;
3845                 re->lastparen = 0;
3846                 re->lastcloseparen = 0;
3847
3848                 PL_reginput = locinput;
3849                 PL_regsize = 0;
3850
3851                 /* XXXX This is too dramatic a measure... */
3852                 PL_reg_maxiter = 0;
3853
3854                 ST.toggle_reg_flags = PL_reg_flags;
3855                 if (RX_UTF8(re_sv))
3856                     PL_reg_flags |= RF_utf8;
3857                 else
3858                     PL_reg_flags &= ~RF_utf8;
3859                 ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
3860
3861                 ST.prev_rex = rex_sv;
3862                 ST.prev_curlyx = cur_curlyx;
3863                 SETREX(rex_sv,re_sv);
3864                 rex = re;
3865                 rexi = rei;
3866                 cur_curlyx = NULL;
3867                 ST.B = next;
3868                 ST.prev_eval = cur_eval;
3869                 cur_eval = st;
3870                 /* now continue from first node in postoned RE */
3871                 PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
3872                 /* NOTREACHED */
3873             }
3874             /* logical is 1,   /(?(?{...})X|Y)/ */
3875             sw = (bool)SvTRUE(ret);
3876             logical = 0;
3877             break;
3878         }
3879
3880         case EVAL_AB: /* cleanup after a successful (??{A})B */
3881             /* note: this is called twice; first after popping B, then A */
3882             PL_reg_flags ^= ST.toggle_reg_flags; 
3883             ReREFCNT_dec(rex_sv);
3884             SETREX(rex_sv,ST.prev_rex);
3885             rex = (struct regexp *)SvANY(rex_sv);
3886             rexi = RXi_GET(rex);
3887             regcpblow(ST.cp);
3888             cur_eval = ST.prev_eval;
3889             cur_curlyx = ST.prev_curlyx;
3890
3891             /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
3892             PL_reglastparen = &rex->lastparen;
3893             PL_reglastcloseparen = &rex->lastcloseparen;
3894             /* also update PL_regoffs */
3895             PL_regoffs = rex->offs;
3896             
3897             /* XXXX This is too dramatic a measure... */
3898             PL_reg_maxiter = 0;
3899             if ( nochange_depth )
3900                 nochange_depth--;
3901             sayYES;
3902
3903
3904         case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
3905             /* note: this is called twice; first after popping B, then A */
3906             PL_reg_flags ^= ST.toggle_reg_flags; 
3907             ReREFCNT_dec(rex_sv);
3908             SETREX(rex_sv,ST.prev_rex);
3909             rex = (struct regexp *)SvANY(rex_sv);
3910             rexi = RXi_GET(rex); 
3911             /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
3912             PL_reglastparen = &rex->lastparen;
3913             PL_reglastcloseparen = &rex->lastcloseparen;
3914
3915             PL_reginput = locinput;
3916             REGCP_UNWIND(ST.lastcp);
3917             regcppop(rex);
3918             cur_eval = ST.prev_eval;
3919             cur_curlyx = ST.prev_curlyx;
3920             /* XXXX This is too dramatic a measure... */
3921             PL_reg_maxiter = 0;
3922             if ( nochange_depth )
3923                 nochange_depth--;
3924             sayNO_SILENT;
3925 #undef ST
3926
3927         case OPEN:
3928             n = ARG(scan);  /* which paren pair */
3929             PL_reg_start_tmp[n] = locinput;
3930             if (n > PL_regsize)
3931                 PL_regsize = n;
3932             lastopen = n;
3933             break;
3934         case CLOSE:
3935             n = ARG(scan);  /* which paren pair */
3936             PL_regoffs[n].start = PL_reg_start_tmp[n] - PL_bostr;
3937             PL_regoffs[n].end = locinput - PL_bostr;
3938             /*if (n > PL_regsize)
3939                 PL_regsize = n;*/
3940             if (n > *PL_reglastparen)
3941                 *PL_reglastparen = n;
3942             *PL_reglastcloseparen = n;
3943             if (cur_eval && cur_eval->u.eval.close_paren == n) {
3944                 goto fake_end;
3945             }    
3946             break;
3947         case ACCEPT:
3948             if (ARG(scan)){
3949                 regnode *cursor;
3950                 for (cursor=scan;
3951                      cursor && OP(cursor)!=END; 
3952                      cursor=regnext(cursor)) 
3953                 {
3954                     if ( OP(cursor)==CLOSE ){
3955                         n = ARG(cursor);
3956                         if ( n <= lastopen ) {
3957                             PL_regoffs[n].start
3958                                 = PL_reg_start_tmp[n] - PL_bostr;
3959                             PL_regoffs[n].end = locinput - PL_bostr;
3960                             /*if (n > PL_regsize)
3961                             PL_regsize = n;*/
3962                             if (n > *PL_reglastparen)
3963                                 *PL_reglastparen = n;
3964                             *PL_reglastcloseparen = n;
3965                             if ( n == ARG(scan) || (cur_eval &&
3966                                 cur_eval->u.eval.close_paren == n))
3967                                 break;
3968                         }
3969                     }
3970                 }
3971             }
3972             goto fake_end;
3973             /*NOTREACHED*/          
3974         case GROUPP:
3975             n = ARG(scan);  /* which paren pair */
3976             sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
3977             break;
3978         case NGROUPP:
3979             /* reg_check_named_buff_matched returns 0 for no match */
3980             sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
3981             break;
3982         case INSUBP:
3983             n = ARG(scan);
3984             sw = (cur_eval && (!n || cur_eval->u.eval.close_paren == n));
3985             break;
3986         case DEFINEP:
3987             sw = 0;
3988             break;
3989         case IFTHEN:
3990             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3991             if (sw)
3992                 next = NEXTOPER(NEXTOPER(scan));
3993             else {
3994                 next = scan + ARG(scan);
3995                 if (OP(next) == IFTHEN) /* Fake one. */
3996                     next = NEXTOPER(NEXTOPER(next));
3997             }
3998             break;
3999         case LOGICAL:
4000             logical = scan->flags;
4001             break;
4002
4003 /*******************************************************************
4004
4005 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
4006 pattern, where A and B are subpatterns. (For simple A, CURLYM or
4007 STAR/PLUS/CURLY/CURLYN are used instead.)
4008
4009 A*B is compiled as <CURLYX><A><WHILEM><B>
4010
4011 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
4012 state, which contains the current count, initialised to -1. It also sets
4013 cur_curlyx to point to this state, with any previous value saved in the
4014 state block.
4015
4016 CURLYX then jumps straight to the WHILEM op, rather than executing A,
4017 since the pattern may possibly match zero times (i.e. it's a while {} loop
4018 rather than a do {} while loop).
4019
4020 Each entry to WHILEM represents a successful match of A. The count in the
4021 CURLYX block is incremented, another WHILEM state is pushed, and execution
4022 passes to A or B depending on greediness and the current count.
4023
4024 For example, if matching against the string a1a2a3b (where the aN are
4025 substrings that match /A/), then the match progresses as follows: (the
4026 pushed states are interspersed with the bits of strings matched so far):
4027
4028     <CURLYX cnt=-1>
4029     <CURLYX cnt=0><WHILEM>
4030     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
4031     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
4032     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
4033     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
4034
4035 (Contrast this with something like CURLYM, which maintains only a single
4036 backtrack state:
4037
4038     <CURLYM cnt=0> a1
4039     a1 <CURLYM cnt=1> a2
4040     a1 a2 <CURLYM cnt=2> a3
4041     a1 a2 a3 <CURLYM cnt=3> b
4042 )
4043
4044 Each WHILEM state block marks a point to backtrack to upon partial failure
4045 of A or B, and also contains some minor state data related to that
4046 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
4047 overall state, such as the count, and pointers to the A and B ops.
4048
4049 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
4050 must always point to the *current* CURLYX block, the rules are:
4051
4052 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
4053 and set cur_curlyx to point the new block.
4054
4055 When popping the CURLYX block after a successful or unsuccessful match,
4056 restore the previous cur_curlyx.
4057
4058 When WHILEM is about to execute B, save the current cur_curlyx, and set it
4059 to the outer one saved in the CURLYX block.
4060
4061 When popping the WHILEM block after a successful or unsuccessful B match,
4062 restore the previous cur_curlyx.
4063
4064 Here's an example for the pattern (AI* BI)*BO
4065 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
4066
4067 cur_
4068 curlyx backtrack stack
4069 ------ ---------------
4070 NULL   
4071 CO     <CO prev=NULL> <WO>
4072 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai 
4073 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi 
4074 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
4075
4076 At this point the pattern succeeds, and we work back down the stack to
4077 clean up, restoring as we go:
4078
4079 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi 
4080 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai 
4081 CO     <CO prev=NULL> <WO>
4082 NULL   
4083
4084 *******************************************************************/
4085
4086 #define ST st->u.curlyx
4087
4088         case CURLYX:    /* start of /A*B/  (for complex A) */
4089         {
4090             /* No need to save/restore up to this paren */
4091             I32 parenfloor = scan->flags;
4092             
4093             assert(next); /* keep Coverity happy */
4094             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
4095                 next += ARG(next);
4096
4097             /* XXXX Probably it is better to teach regpush to support
4098                parenfloor > PL_regsize... */
4099             if (parenfloor > (I32)*PL_reglastparen)
4100                 parenfloor = *PL_reglastparen; /* Pessimization... */
4101
4102             ST.prev_curlyx= cur_curlyx;
4103             cur_curlyx = st;
4104             ST.cp = PL_savestack_ix;
4105
4106             /* these fields contain the state of the current curly.
4107              * they are accessed by subsequent WHILEMs */
4108             ST.parenfloor = parenfloor;
4109             ST.min = ARG1(scan);
4110             ST.max = ARG2(scan);
4111             ST.A = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
4112             ST.B = next;
4113             ST.minmod = minmod;
4114             minmod = 0;
4115             ST.count = -1;      /* this will be updated by WHILEM */
4116             ST.lastloc = NULL;  /* this will be updated by WHILEM */
4117
4118             PL_reginput = locinput;
4119             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next));
4120             /* NOTREACHED */
4121         }
4122
4123         case CURLYX_end: /* just finished matching all of A*B */
4124             cur_curlyx = ST.prev_curlyx;
4125             sayYES;
4126             /* NOTREACHED */
4127
4128         case CURLYX_end_fail: /* just failed to match all of A*B */
4129             regcpblow(ST.cp);
4130             cur_curlyx = ST.prev_curlyx;
4131             sayNO;
4132             /* NOTREACHED */
4133
4134
4135 #undef ST
4136 #define ST st->u.whilem
4137
4138         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
4139         {
4140             /* see the discussion above about CURLYX/WHILEM */
4141             I32 n;
4142             assert(cur_curlyx); /* keep Coverity happy */
4143             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
4144             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
4145             ST.cache_offset = 0;
4146             ST.cache_mask = 0;
4147             
4148             PL_reginput = locinput;
4149
4150             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4151                   "%*s  whilem: matched %ld out of %ld..%ld\n",
4152                   REPORT_CODE_OFF+depth*2, "", (long)n,
4153                   (long)cur_curlyx->u.curlyx.min,
4154                   (long)cur_curlyx->u.curlyx.max)
4155             );
4156
4157             /* First just match a string of min A's. */
4158
4159             if (n < cur_curlyx->u.curlyx.min) {
4160                 cur_curlyx->u.curlyx.lastloc = locinput;
4161                 PUSH_STATE_GOTO(WHILEM_A_pre, cur_curlyx->u.curlyx.A);
4162                 /* NOTREACHED */
4163             }
4164
4165             /* If degenerate A matches "", assume A done. */
4166
4167             if (locinput == cur_curlyx->u.curlyx.lastloc) {
4168                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4169                    "%*s  whilem: empty match detected, trying continuation...\n",
4170                    REPORT_CODE_OFF+depth*2, "")
4171                 );
4172                 goto do_whilem_B_max;
4173             }
4174
4175             /* super-linear cache processing */
4176
4177             if (scan->flags) {
4178
4179                 if (!PL_reg_maxiter) {
4180                     /* start the countdown: Postpone detection until we
4181                      * know the match is not *that* much linear. */
4182                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
4183                     /* possible overflow for long strings and many CURLYX's */
4184                     if (PL_reg_maxiter < 0)
4185                         PL_reg_maxiter = I32_MAX;
4186                     PL_reg_leftiter = PL_reg_maxiter;
4187                 }
4188
4189                 if (PL_reg_leftiter-- == 0) {
4190                     /* initialise cache */
4191                     const I32 size = (PL_reg_maxiter + 7)/8;
4192                     if (PL_reg_poscache) {
4193                         if ((I32)PL_reg_poscache_size < size) {
4194                             Renew(PL_reg_poscache, size, char);
4195                             PL_reg_poscache_size = size;
4196                         }
4197                         Zero(PL_reg_poscache, size, char);
4198                     }
4199                     else {
4200                         PL_reg_poscache_size = size;
4201                         Newxz(PL_reg_poscache, size, char);
4202                     }
4203                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4204       "%swhilem: Detected a super-linear match, switching on caching%s...\n",
4205                               PL_colors[4], PL_colors[5])
4206                     );
4207                 }
4208
4209                 if (PL_reg_leftiter < 0) {
4210                     /* have we already failed at this position? */
4211                     I32 offset, mask;
4212                     offset  = (scan->flags & 0xf) - 1
4213                                 + (locinput - PL_bostr)  * (scan->flags>>4);
4214                     mask    = 1 << (offset % 8);
4215                     offset /= 8;
4216                     if (PL_reg_poscache[offset] & mask) {
4217                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4218                             "%*s  whilem: (cache) already tried at this position...\n",
4219                             REPORT_CODE_OFF+depth*2, "")
4220                         );
4221                         sayNO; /* cache records failure */
4222                     }
4223                     ST.cache_offset = offset;
4224                     ST.cache_mask   = mask;
4225                 }
4226             }
4227
4228             /* Prefer B over A for minimal matching. */
4229
4230             if (cur_curlyx->u.curlyx.minmod) {
4231                 ST.save_curlyx = cur_curlyx;
4232                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4233                 ST.cp = regcppush(ST.save_curlyx->u.curlyx.parenfloor);
4234                 REGCP_SET(ST.lastcp);
4235                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B);
4236                 /* NOTREACHED */
4237             }
4238
4239             /* Prefer A over B for maximal matching. */
4240
4241             if (n < cur_curlyx->u.curlyx.max) { /* More greed allowed? */
4242                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4243                 cur_curlyx->u.curlyx.lastloc = locinput;
4244                 REGCP_SET(ST.lastcp);
4245                 PUSH_STATE_GOTO(WHILEM_A_max, cur_curlyx->u.curlyx.A);
4246                 /* NOTREACHED */
4247             }
4248             goto do_whilem_B_max;
4249         }
4250         /* NOTREACHED */
4251
4252         case WHILEM_B_min: /* just matched B in a minimal match */
4253         case WHILEM_B_max: /* just matched B in a maximal match */
4254             cur_curlyx = ST.save_curlyx;
4255             sayYES;
4256             /* NOTREACHED */
4257
4258         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
4259             cur_curlyx = ST.save_curlyx;
4260             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4261             cur_curlyx->u.curlyx.count--;
4262             CACHEsayNO;
4263             /* NOTREACHED */
4264
4265         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
4266             REGCP_UNWIND(ST.lastcp);
4267             regcppop(rex);
4268             /* FALL THROUGH */
4269         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
4270             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4271             cur_curlyx->u.curlyx.count--;
4272             CACHEsayNO;
4273             /* NOTREACHED */
4274
4275         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
4276             REGCP_UNWIND(ST.lastcp);
4277             regcppop(rex);      /* Restore some previous $<digit>s? */
4278             PL_reginput = locinput;
4279             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4280                 "%*s  whilem: failed, trying continuation...\n",
4281                 REPORT_CODE_OFF+depth*2, "")
4282             );
4283           do_whilem_B_max:
4284             if (cur_curlyx->u.curlyx.count >= REG_INFTY
4285                 && ckWARN(WARN_REGEXP)
4286                 && !(PL_reg_flags & RF_warned))
4287             {
4288                 PL_reg_flags |= RF_warned;
4289                 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
4290                      "Complex regular subexpression recursion",
4291                      REG_INFTY - 1);
4292             }
4293
4294             /* now try B */
4295             ST.save_curlyx = cur_curlyx;
4296             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4297             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B);
4298             /* NOTREACHED */
4299
4300         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
4301             cur_curlyx = ST.save_curlyx;
4302             REGCP_UNWIND(ST.lastcp);
4303             regcppop(rex);
4304
4305             if (cur_curlyx->u.curlyx.count >= cur_curlyx->u.curlyx.max) {
4306                 /* Maximum greed exceeded */
4307                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
4308                     && ckWARN(WARN_REGEXP)
4309                     && !(PL_reg_flags & RF_warned))
4310                 {
4311                     PL_reg_flags |= RF_warned;
4312                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
4313                         "%s limit (%d) exceeded",
4314                         "Complex regular subexpression recursion",
4315                         REG_INFTY - 1);
4316                 }
4317                 cur_curlyx->u.curlyx.count--;
4318                 CACHEsayNO;
4319             }
4320
4321             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4322                 "%*s  trying longer...\n", REPORT_CODE_OFF+depth*2, "")
4323             );
4324             /* Try grabbing another A and see if it helps. */
4325             PL_reginput = locinput;
4326             cur_curlyx->u.curlyx.lastloc = locinput;
4327             ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4328             REGCP_SET(ST.lastcp);
4329             PUSH_STATE_GOTO(WHILEM_A_min, ST.save_curlyx->u.curlyx.A);
4330             /* NOTREACHED */
4331
4332 #undef  ST
4333 #define ST st->u.branch
4334
4335         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
4336             next = scan + ARG(scan);
4337             if (next == scan)
4338                 next = NULL;
4339             scan = NEXTOPER(scan);
4340             /* FALL THROUGH */
4341
4342         case BRANCH:        /*  /(...|A|...)/ */
4343             scan = NEXTOPER(scan); /* scan now points to inner node */
4344             ST.lastparen = *PL_reglastparen;
4345             ST.next_branch = next;
4346             REGCP_SET(ST.cp);
4347             PL_reginput = locinput;
4348
4349             /* Now go into the branch */
4350             if (has_cutgroup) {
4351                 PUSH_YES_STATE_GOTO(BRANCH_next, scan);    
4352             } else {
4353                 PUSH_STATE_GOTO(BRANCH_next, scan);
4354             }
4355             /* NOTREACHED */
4356         case CUTGROUP:
4357             PL_reginput = locinput;
4358             sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
4359                 MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
4360             PUSH_STATE_GOTO(CUTGROUP_next,next);
4361             /* NOTREACHED */
4362         case CUTGROUP_next_fail:
4363             do_cutgroup = 1;
4364             no_final = 1;
4365             if (st->u.mark.mark_name)
4366                 sv_commit = st->u.mark.mark_name;
4367             sayNO;          
4368             /* NOTREACHED */
4369         case BRANCH_next:
4370             sayYES;
4371             /* NOTREACHED */
4372         case BRANCH_next_fail: /* that branch failed; try the next, if any */
4373             if (do_cutgroup) {
4374                 do_cutgroup = 0;
4375                 no_final = 0;
4376             }
4377             REGCP_UNWIND(ST.cp);
4378             for (n = *PL_reglastparen; n > ST.lastparen; n--)
4379                 PL_regoffs[n].end = -1;
4380             *PL_reglastparen = n;
4381             /*dmq: *PL_reglastcloseparen = n; */
4382             scan = ST.next_branch;
4383             /* no more branches? */
4384             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
4385                 DEBUG_EXECUTE_r({
4386                     PerlIO_printf( Perl_debug_log,
4387                         "%*s  %sBRANCH failed...%s\n",
4388                         REPORT_CODE_OFF+depth*2, "", 
4389                         PL_colors[4],
4390                         PL_colors[5] );
4391                 });
4392                 sayNO_SILENT;
4393             }
4394             continue; /* execute next BRANCH[J] op */
4395             /* NOTREACHED */
4396     
4397         case MINMOD:
4398             minmod = 1;
4399             break;
4400
4401 #undef  ST
4402 #define ST st->u.curlym
4403
4404         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
4405
4406             /* This is an optimisation of CURLYX that enables us to push
4407              * only a single backtracking state, no matter how many matches
4408              * there are in {m,n}. It relies on the pattern being constant
4409              * length, with no parens to influence future backrefs
4410              */
4411
4412             ST.me = scan;
4413             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4414
4415             /* if paren positive, emulate an OPEN/CLOSE around A */
4416             if (ST.me->flags) {
4417                 U32 paren = ST.me->flags;
4418                 if (paren > PL_regsize)
4419                     PL_regsize = paren;
4420                 if (paren > *PL_reglastparen)
4421                     *PL_reglastparen = paren;
4422                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
4423             }
4424             ST.A = scan;
4425             ST.B = next;
4426             ST.alen = 0;
4427             ST.count = 0;
4428             ST.minmod = minmod;
4429             minmod = 0;
4430             ST.c1 = CHRTEST_UNINIT;
4431             REGCP_SET(ST.cp);
4432
4433             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
4434                 goto curlym_do_B;
4435
4436           curlym_do_A: /* execute the A in /A{m,n}B/  */
4437             PL_reginput = locinput;
4438             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
4439             /* NOTREACHED */
4440
4441         case CURLYM_A: /* we've just matched an A */
4442             locinput = st->locinput;
4443             nextchr = UCHARAT(locinput);
4444
4445             ST.count++;
4446             /* after first match, determine A's length: u.curlym.alen */
4447             if (ST.count == 1) {
4448                 if (PL_reg_match_utf8) {
4449                     char *s = locinput;
4450                     while (s < PL_reginput) {
4451                         ST.alen++;
4452                         s += UTF8SKIP(s);
4453                     }
4454                 }
4455                 else {
4456                     ST.alen = PL_reginput - locinput;
4457                 }
4458                 if (ST.alen == 0)
4459                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
4460             }
4461             DEBUG_EXECUTE_r(
4462                 PerlIO_printf(Perl_debug_log,
4463                           "%*s  CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
4464                           (int)(REPORT_CODE_OFF+(depth*2)), "",
4465                           (IV) ST.count, (IV)ST.alen)
4466             );
4467
4468             locinput = PL_reginput;
4469                         
4470             if (cur_eval && cur_eval->u.eval.close_paren && 
4471                 cur_eval->u.eval.close_paren == (U32)ST.me->flags) 
4472                 goto fake_end;
4473                 
4474             {
4475                 I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me));
4476                 if ( max == REG_INFTY || ST.count < max )
4477                     goto curlym_do_A; /* try to match another A */
4478             }
4479             goto curlym_do_B; /* try to match B */
4480
4481         case CURLYM_A_fail: /* just failed to match an A */
4482             REGCP_UNWIND(ST.cp);
4483
4484             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ 
4485                 || (cur_eval && cur_eval->u.eval.close_paren &&
4486                     cur_eval->u.eval.close_paren == (U32)ST.me->flags))
4487                 sayNO;
4488
4489           curlym_do_B: /* execute the B in /A{m,n}B/  */
4490             PL_reginput = locinput;
4491             if (ST.c1 == CHRTEST_UNINIT) {
4492                 /* calculate c1 and c2 for possible match of 1st char
4493                  * following curly */
4494                 ST.c1 = ST.c2 = CHRTEST_VOID;
4495                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
4496                     regnode *text_node = ST.B;
4497                     if (! HAS_TEXT(text_node))
4498                         FIND_NEXT_IMPT(text_node);
4499                     /* this used to be 
4500                         
4501                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
4502                         
4503                         But the former is redundant in light of the latter.
4504                         
4505                         if this changes back then the macro for 
4506                         IS_TEXT and friends need to change.
4507                      */
4508                     if (PL_regkind[OP(text_node)] == EXACT)
4509                     {
4510                         
4511                         ST.c1 = (U8)*STRING(text_node);
4512                         ST.c2 =
4513                             (IS_TEXTF(text_node))
4514                             ? PL_fold[ST.c1]
4515                             : (IS_TEXTFL(text_node))
4516                                 ? PL_fold_locale[ST.c1]
4517                                 : ST.c1;
4518                     }
4519                 }
4520             }
4521
4522             DEBUG_EXECUTE_r(
4523                 PerlIO_printf(Perl_debug_log,
4524                     "%*s  CURLYM trying tail with matches=%"IVdf"...\n",
4525                     (int)(REPORT_CODE_OFF+(depth*2)),
4526                     "", (IV)ST.count)
4527                 );
4528             if (ST.c1 != CHRTEST_VOID
4529                     && UCHARAT(PL_reginput) != ST.c1
4530                     && UCHARAT(PL_reginput) != ST.c2)
4531             {
4532                 /* simulate B failing */
4533                 DEBUG_OPTIMISE_r(
4534                     PerlIO_printf(Perl_debug_log,
4535                         "%*s  CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
4536                         (int)(REPORT_CODE_OFF+(depth*2)),"",
4537                         (IV)ST.c1,(IV)ST.c2
4538                 ));
4539                 state_num = CURLYM_B_fail;
4540                 goto reenter_switch;
4541             }
4542
4543             if (ST.me->flags) {
4544                 /* mark current A as captured */
4545                 I32 paren = ST.me->flags;
4546                 if (ST.count) {
4547                     PL_regoffs[paren].start
4548                         = HOPc(PL_reginput, -ST.alen) - PL_bostr;
4549                     PL_regoffs[paren].end = PL_reginput - PL_bostr;
4550                     /*dmq: *PL_reglastcloseparen = paren; */
4551                 }
4552                 else
4553                     PL_regoffs[paren].end = -1;
4554                 if (cur_eval && cur_eval->u.eval.close_paren &&
4555                     cur_eval->u.eval.close_paren == (U32)ST.me->flags) 
4556                 {
4557                     if (ST.count) 
4558                         goto fake_end;
4559                     else
4560                         sayNO;
4561                 }
4562             }
4563             
4564             PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
4565             /* NOTREACHED */
4566
4567         case CURLYM_B_fail: /* just failed to match a B */
4568             REGCP_UNWIND(ST.cp);
4569             if (ST.minmod) {
4570                 I32 max = ARG2(ST.me);
4571                 if (max != REG_INFTY && ST.count == max)
4572                     sayNO;
4573                 goto curlym_do_A; /* try to match a further A */
4574             }
4575             /* backtrack one A */
4576             if (ST.count == ARG1(ST.me) /* min */)
4577                 sayNO;
4578             ST.count--;
4579             locinput = HOPc(locinput, -ST.alen);
4580             goto curlym_do_B; /* try to match B */
4581
4582 #undef ST
4583 #define ST st->u.curly
4584
4585 #define CURLY_SETPAREN(paren, success) \
4586     if (paren) { \
4587         if (success) { \
4588             PL_regoffs[paren].start = HOPc(locinput, -1) - PL_bostr; \
4589             PL_regoffs[paren].end = locinput - PL_bostr; \
4590             *PL_reglastcloseparen = paren; \
4591         } \
4592         else \
4593             PL_regoffs[paren].end = -1; \
4594     }
4595
4596         case STAR:              /*  /A*B/ where A is width 1 */
4597             ST.paren = 0;
4598             ST.min = 0;
4599             ST.max = REG_INFTY;
4600             scan = NEXTOPER(scan);
4601             goto repeat;
4602         case PLUS:              /*  /A+B/ where A is width 1 */
4603             ST.paren = 0;
4604             ST.min = 1;
4605             ST.max = REG_INFTY;
4606             scan = NEXTOPER(scan);
4607             goto repeat;
4608         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 */
4609             ST.paren = scan->flags;     /* Which paren to set */
4610             if (ST.paren > PL_regsize)
4611                 PL_regsize = ST.paren;
4612             if (ST.paren > *PL_reglastparen)
4613                 *PL_reglastparen = ST.paren;
4614             ST.min = ARG1(scan);  /* min to match */
4615             ST.max = ARG2(scan);  /* max to match */
4616             if (cur_eval && cur_eval->u.eval.close_paren &&
4617                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4618                 ST.min=1;
4619                 ST.max=1;
4620             }
4621             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
4622             goto repeat;
4623         case CURLY:             /*  /A{m,n}B/ where A is width 1 */
4624             ST.paren = 0;
4625             ST.min = ARG1(scan);  /* min to match */
4626             ST.max = ARG2(scan);  /* max to match */
4627             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4628           repeat:
4629             /*
4630             * Lookahead to avoid useless match attempts
4631             * when we know what character comes next.
4632             *
4633             * Used to only do .*x and .*?x, but now it allows
4634             * for )'s, ('s and (?{ ... })'s to be in the way
4635             * of the quantifier and the EXACT-like node.  -- japhy
4636             */
4637
4638             if (ST.min > ST.max) /* XXX make this a compile-time check? */
4639                 sayNO;
4640             if (HAS_TEXT(next) || JUMPABLE(next)) {
4641                 U8 *s;
4642                 regnode *text_node = next;
4643
4644                 if (! HAS_TEXT(text_node)) 
4645                     FIND_NEXT_IMPT(text_node);
4646
4647                 if (! HAS_TEXT(text_node))
4648                     ST.c1 = ST.c2 = CHRTEST_VOID;
4649                 else {
4650                     if ( PL_regkind[OP(text_node)] != EXACT ) {
4651                         ST.c1 = ST.c2 = CHRTEST_VOID;
4652                         goto assume_ok_easy;
4653                     }
4654                     else
4655                         s = (U8*)STRING(text_node);
4656                     
4657                     /*  Currently we only get here when 
4658                         
4659                         PL_rekind[OP(text_node)] == EXACT
4660                     
4661                         if this changes back then the macro for IS_TEXT and 
4662                         friends need to change. */
4663                     if (!UTF) {
4664                         ST.c2 = ST.c1 = *s;
4665                         if (IS_TEXTF(text_node))
4666                             ST.c2 = PL_fold[ST.c1];
4667                         else if (IS_TEXTFL(text_node))
4668                             ST.c2 = PL_fold_locale[ST.c1];
4669                     }
4670                     else { /* UTF */
4671                         if (IS_TEXTF(text_node)) {
4672                              STRLEN ulen1, ulen2;
4673                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4674                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4675
4676                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4677                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4678 #ifdef EBCDIC
4679                              ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
4680                                                     ckWARN(WARN_UTF8) ?
4681                                                     0 : UTF8_ALLOW_ANY);
4682                              ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
4683                                                     ckWARN(WARN_UTF8) ?
4684                                                     0 : UTF8_ALLOW_ANY);
4685 #else
4686                              ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4687                                                     uniflags);
4688                              ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4689                                                     uniflags);
4690 #endif
4691                         }
4692                         else {
4693                             ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4694                                                      uniflags);
4695                         }
4696                     }
4697                 }
4698             }
4699             else
4700                 ST.c1 = ST.c2 = CHRTEST_VOID;
4701         assume_ok_easy:
4702
4703             ST.A = scan;
4704             ST.B = next;
4705             PL_reginput = locinput;
4706             if (minmod) {
4707                 minmod = 0;
4708                 if (ST.min && regrepeat(rex, ST.A, ST.min, depth) < ST.min)
4709                     sayNO;
4710                 ST.count = ST.min;
4711                 locinput = PL_reginput;
4712                 REGCP_SET(ST.cp);
4713                 if (ST.c1 == CHRTEST_VOID)
4714                     goto curly_try_B_min;
4715
4716                 ST.oldloc = locinput;
4717
4718                 /* set ST.maxpos to the furthest point along the
4719                  * string that could possibly match */
4720                 if  (ST.max == REG_INFTY) {
4721                     ST.maxpos = PL_regeol - 1;
4722                     if (do_utf8)
4723                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
4724                             ST.maxpos--;
4725                 }
4726                 else if (do_utf8) {
4727                     int m = ST.max - ST.min;
4728                     for (ST.maxpos = locinput;
4729                          m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
4730                         ST.maxpos += UTF8SKIP(ST.maxpos);
4731                 }
4732                 else {
4733                     ST.maxpos = locinput + ST.max - ST.min;
4734                     if (ST.maxpos >= PL_regeol)
4735                         ST.maxpos = PL_regeol - 1;
4736                 }
4737                 goto curly_try_B_min_known;
4738
4739             }
4740             else {
4741                 ST.count = regrepeat(rex, ST.A, ST.max, depth);
4742                 locinput = PL_reginput;
4743                 if (ST.count < ST.min)
4744                     sayNO;
4745                 if ((ST.count > ST.min)
4746                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
4747                 {
4748                     /* A{m,n} must come at the end of the string, there's
4749                      * no point in backing off ... */
4750                     ST.min = ST.count;
4751                     /* ...except that $ and \Z can match before *and* after
4752                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4753                        We may back off by one in this case. */
4754                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
4755                         ST.min--;
4756                 }
4757                 REGCP_SET(ST.cp);
4758                 goto curly_try_B_max;
4759             }
4760             /* NOTREACHED */
4761
4762
4763         case CURLY_B_min_known_fail:
4764             /* failed to find B in a non-greedy match where c1,c2 valid */
4765             if (ST.paren && ST.count)
4766                 PL_regoffs[ST.paren].end = -1;
4767
4768             PL_reginput = locinput;     /* Could be reset... */
4769             REGCP_UNWIND(ST.cp);
4770             /* Couldn't or didn't -- move forward. */
4771             ST.oldloc = locinput;
4772             if (do_utf8)
4773                 locinput += UTF8SKIP(locinput);
4774             else
4775                 locinput++;
4776             ST.count++;
4777           curly_try_B_min_known:
4778              /* find the next place where 'B' could work, then call B */
4779             {
4780                 int n;
4781                 if (do_utf8) {
4782                     n = (ST.oldloc == locinput) ? 0 : 1;
4783                     if (ST.c1 == ST.c2) {
4784                         STRLEN len;
4785                         /* set n to utf8_distance(oldloc, locinput) */
4786                         while (locinput <= ST.maxpos &&
4787                                utf8n_to_uvchr((U8*)locinput,
4788                                               UTF8_MAXBYTES, &len,
4789                                               uniflags) != (UV)ST.c1) {
4790                             locinput += len;
4791                             n++;
4792                         }
4793                     }
4794                     else {
4795                         /* set n to utf8_distance(oldloc, locinput) */
4796                         while (locinput <= ST.maxpos) {
4797                             STRLEN len;
4798                             const UV c = utf8n_to_uvchr((U8*)locinput,
4799                                                   UTF8_MAXBYTES, &len,
4800                                                   uniflags);
4801                             if (c == (UV)ST.c1 || c == (UV)ST.c2)
4802                                 break;
4803                             locinput += len;
4804                             n++;
4805                         }
4806                     }
4807                 }
4808                 else {
4809                     if (ST.c1 == ST.c2) {
4810                         while (locinput <= ST.maxpos &&
4811                                UCHARAT(locinput) != ST.c1)
4812                             locinput++;
4813                     }
4814                     else {
4815                         while (locinput <= ST.maxpos
4816                                && UCHARAT(locinput) != ST.c1
4817                                && UCHARAT(locinput) != ST.c2)
4818                             locinput++;
4819                     }
4820                     n = locinput - ST.oldloc;
4821                 }
4822                 if (locinput > ST.maxpos)
4823                     sayNO;
4824                 /* PL_reginput == oldloc now */
4825                 if (n) {
4826                     ST.count += n;
4827                     if (regrepeat(rex, ST.A, n, depth) < n)
4828                         sayNO;
4829                 }
4830                 PL_reginput = locinput;
4831                 CURLY_SETPAREN(ST.paren, ST.count);
4832                 if (cur_eval && cur_eval->u.eval.close_paren && 
4833                     cur_eval->u.eval.close_paren == (U32)ST.paren) {
4834                     goto fake_end;
4835                 }
4836                 PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
4837             }
4838             /* NOTREACHED */
4839
4840
4841         case CURLY_B_min_fail:
4842             /* failed to find B in a non-greedy match where c1,c2 invalid */
4843             if (ST.paren && ST.count)
4844                 PL_regoffs[ST.paren].end = -1;
4845
4846             REGCP_UNWIND(ST.cp);
4847             /* failed -- move forward one */
4848             PL_reginput = locinput;
4849             if (regrepeat(rex, ST.A, 1, depth)) {
4850                 ST.count++;
4851                 locinput = PL_reginput;
4852                 if (ST.count <= ST.max || (ST.max == REG_INFTY &&
4853                         ST.count > 0)) /* count overflow ? */
4854                 {
4855                   curly_try_B_min:
4856                     CURLY_SETPAREN(ST.paren, ST.count);
4857                     if (cur_eval && cur_eval->u.eval.close_paren &&
4858                         cur_eval->u.eval.close_paren == (U32)ST.paren) {
4859                         goto fake_end;
4860                     }
4861                     PUSH_STATE_GOTO(CURLY_B_min, ST.B);
4862                 }
4863             }
4864             sayNO;
4865             /* NOTREACHED */
4866
4867
4868         curly_try_B_max:
4869             /* a successful greedy match: now try to match B */
4870             if (cur_eval && cur_eval->u.eval.close_paren &&
4871                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4872                 goto fake_end;
4873             }
4874             {
4875                 UV c = 0;
4876                 if (ST.c1 != CHRTEST_VOID)
4877                     c = do_utf8 ? utf8n_to_uvchr((U8*)PL_reginput,
4878                                            UTF8_MAXBYTES, 0, uniflags)
4879                                 : (UV) UCHARAT(PL_reginput);
4880                 /* If it could work, try it. */
4881                 if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
4882                     CURLY_SETPAREN(ST.paren, ST.count);
4883                     PUSH_STATE_GOTO(CURLY_B_max, ST.B);
4884                     /* NOTREACHED */
4885                 }
4886             }
4887             /* FALL THROUGH */
4888         case CURLY_B_max_fail:
4889             /* failed to find B in a greedy match */
4890             if (ST.paren && ST.count)
4891                 PL_regoffs[ST.paren].end = -1;
4892
4893             REGCP_UNWIND(ST.cp);
4894             /*  back up. */
4895             if (--ST.count < ST.min)
4896                 sayNO;
4897             PL_reginput = locinput = HOPc(locinput, -1);
4898             goto curly_try_B_max;
4899
4900 #undef ST
4901
4902         case END:
4903             fake_end:
4904             if (cur_eval) {
4905                 /* we've just finished A in /(??{A})B/; now continue with B */
4906                 I32 tmpix;
4907                 st->u.eval.toggle_reg_flags
4908                             = cur_eval->u.eval.toggle_reg_flags;
4909                 PL_reg_flags ^= st->u.eval.toggle_reg_flags; 
4910
4911                 st->u.eval.prev_rex = rex_sv;           /* inner */
4912                 SETREX(rex_sv,cur_eval->u.eval.prev_rex);
4913                 rex = (struct regexp *)SvANY(rex_sv);
4914                 rexi = RXi_GET(rex);
4915                 cur_curlyx = cur_eval->u.eval.prev_curlyx;
4916                 ReREFCNT_inc(rex_sv);
4917                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
4918
4919                 /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
4920                 PL_reglastparen = &rex->lastparen;
4921                 PL_reglastcloseparen = &rex->lastcloseparen;
4922
4923                 REGCP_SET(st->u.eval.lastcp);
4924                 PL_reginput = locinput;
4925
4926                 /* Restore parens of the outer rex without popping the
4927                  * savestack */
4928                 tmpix = PL_savestack_ix;
4929                 PL_savestack_ix = cur_eval->u.eval.lastcp;
4930                 regcppop(rex);
4931                 PL_savestack_ix = tmpix;
4932
4933                 st->u.eval.prev_eval = cur_eval;
4934                 cur_eval = cur_eval->u.eval.prev_eval;
4935                 DEBUG_EXECUTE_r(
4936                     PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
4937                                       REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
4938                 if ( nochange_depth )
4939                     nochange_depth--;
4940
4941                 PUSH_YES_STATE_GOTO(EVAL_AB,
4942                         st->u.eval.prev_eval->u.eval.B); /* match B */
4943             }
4944
4945             if (locinput < reginfo->till) {
4946                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4947                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4948                                       PL_colors[4],
4949                                       (long)(locinput - PL_reg_starttry),
4950                                       (long)(reginfo->till - PL_reg_starttry),
4951                                       PL_colors[5]));
4952                                               
4953                 sayNO_SILENT;           /* Cannot match: too short. */
4954             }
4955             PL_reginput = locinput;     /* put where regtry can find it */
4956             sayYES;                     /* Success! */
4957
4958         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
4959             DEBUG_EXECUTE_r(
4960             PerlIO_printf(Perl_debug_log,
4961                 "%*s  %ssubpattern success...%s\n",
4962                 REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
4963             PL_reginput = locinput;     /* put where regtry can find it */
4964             sayYES;                     /* Success! */
4965
4966 #undef  ST
4967 #define ST st->u.ifmatch
4968
4969         case SUSPEND:   /* (?>A) */
4970             ST.wanted = 1;
4971             PL_reginput = locinput;
4972             goto do_ifmatch;    
4973
4974         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
4975             ST.wanted = 0;
4976             goto ifmatch_trivial_fail_test;
4977
4978         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
4979             ST.wanted = 1;
4980           ifmatch_trivial_fail_test:
4981             if (scan->flags) {
4982                 char * const s = HOPBACKc(locinput, scan->flags);
4983                 if (!s) {
4984                     /* trivial fail */
4985                     if (logical) {
4986                         logical = 0;
4987                         sw = 1 - (bool)ST.wanted;
4988                     }
4989                     else if (ST.wanted)
4990                         sayNO;
4991                     next = scan + ARG(scan);
4992                     if (next == scan)
4993                         next = NULL;
4994                     break;
4995                 }
4996                 PL_reginput = s;
4997             }
4998             else
4999                 PL_reginput = locinput;
5000
5001           do_ifmatch:
5002             ST.me = scan;
5003             ST.logical = logical;
5004             logical = 0; /* XXX: reset state of logical once it has been saved into ST */
5005             
5006             /* execute body of (?...A) */
5007             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
5008             /* NOTREACHED */
5009
5010         case IFMATCH_A_fail: /* body of (?...A) failed */
5011             ST.wanted = !ST.wanted;
5012             /* FALL THROUGH */
5013
5014         case IFMATCH_A: /* body of (?...A) succeeded */
5015             if (ST.logical) {
5016                 sw = (bool)ST.wanted;
5017             }
5018             else if (!ST.wanted)
5019                 sayNO;
5020
5021             if (OP(ST.me) == SUSPEND)
5022                 locinput = PL_reginput;
5023             else {
5024                 locinput = PL_reginput = st->locinput;
5025                 nextchr = UCHARAT(locinput);
5026             }
5027             scan = ST.me + ARG(ST.me);
5028             if (scan == ST.me)
5029                 scan = NULL;
5030             continue; /* execute B */
5031
5032 #undef ST
5033
5034         case LONGJMP:
5035             next = scan + ARG(scan);
5036             if (next == scan)
5037                 next = NULL;
5038             break;
5039         case COMMIT:
5040             reginfo->cutpoint = PL_regeol;
5041             /* FALLTHROUGH */
5042         case PRUNE:
5043             PL_reginput = locinput;
5044             if (!scan->flags)
5045                 sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5046             PUSH_STATE_GOTO(COMMIT_next,next);
5047             /* NOTREACHED */
5048         case COMMIT_next_fail:
5049             no_final = 1;    
5050             /* FALLTHROUGH */       
5051         case OPFAIL:
5052             sayNO;
5053             /* NOTREACHED */
5054
5055 #define ST st->u.mark
5056         case MARKPOINT:
5057             ST.prev_mark = mark_state;
5058             ST.mark_name = sv_commit = sv_yes_mark 
5059                 = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5060             mark_state = st;
5061             ST.mark_loc = PL_reginput = locinput;
5062             PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
5063             /* NOTREACHED */
5064         case MARKPOINT_next:
5065             mark_state = ST.prev_mark;
5066             sayYES;
5067             /* NOTREACHED */
5068         case MARKPOINT_next_fail:
5069             if (popmark && sv_eq(ST.mark_name,popmark)) 
5070             {
5071                 if (ST.mark_loc > startpoint)
5072                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5073                 popmark = NULL; /* we found our mark */
5074                 sv_commit = ST.mark_name;
5075
5076                 DEBUG_EXECUTE_r({
5077                         PerlIO_printf(Perl_debug_log,
5078                             "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
5079                             REPORT_CODE_OFF+depth*2, "", 
5080                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
5081                 });
5082             }
5083             mark_state = ST.prev_mark;
5084             sv_yes_mark = mark_state ? 
5085                 mark_state->u.mark.mark_name : NULL;
5086             sayNO;
5087             /* NOTREACHED */
5088         case SKIP:
5089             PL_reginput = locinput;
5090             if (scan->flags) {
5091                 /* (*SKIP) : if we fail we cut here*/
5092                 ST.mark_name = NULL;
5093                 ST.mark_loc = locinput;
5094                 PUSH_STATE_GOTO(SKIP_next,next);    
5095             } else {
5096                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, 
5097                    otherwise do nothing.  Meaning we need to scan 
5098                  */
5099                 regmatch_state *cur = mark_state;
5100                 SV *find = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5101                 
5102                 while (cur) {
5103                     if ( sv_eq( cur->u.mark.mark_name, 
5104                                 find ) ) 
5105                     {
5106                         ST.mark_name = find;
5107                         PUSH_STATE_GOTO( SKIP_next, next );
5108                     }
5109                     cur = cur->u.mark.prev_mark;
5110                 }
5111             }    
5112             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
5113             break;    
5114         case SKIP_next_fail:
5115             if (ST.mark_name) {
5116                 /* (*CUT:NAME) - Set up to search for the name as we 
5117                    collapse the stack*/
5118                 popmark = ST.mark_name;    
5119             } else {
5120                 /* (*CUT) - No name, we cut here.*/
5121                 if (ST.mark_loc > startpoint)
5122                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5123                 /* but we set sv_commit to latest mark_name if there
5124                    is one so they can test to see how things lead to this
5125                    cut */    
5126                 if (mark_state) 
5127                     sv_commit=mark_state->u.mark.mark_name;                 
5128             } 
5129             no_final = 1; 
5130             sayNO;
5131             /* NOTREACHED */
5132 #undef ST
5133         case FOLDCHAR:
5134             n = ARG(scan);
5135             if ( n == (U32)what_len_TRICKYFOLD(locinput,do_utf8,ln) ) {
5136                 locinput += ln;
5137             } else if ( 0xDF == n && !do_utf8 && !UTF ) {
5138                 sayNO;
5139             } else  {
5140                 U8 folded[UTF8_MAXBYTES_CASE+1];
5141                 STRLEN foldlen;
5142                 const char * const l = locinput;
5143                 char *e = PL_regeol;
5144                 to_uni_fold(n, folded, &foldlen);
5145
5146                 if (ibcmp_utf8((const char*) folded, 0,  foldlen, 1,
5147                                l, &e, 0,  do_utf8)) {
5148                         sayNO;
5149                 }
5150                 locinput = e;
5151             } 
5152             nextchr = UCHARAT(locinput);  
5153             break;
5154         case LNBREAK:
5155             if ((n=is_LNBREAK(locinput,do_utf8))) {
5156                 locinput += n;
5157                 nextchr = UCHARAT(locinput);
5158             } else
5159                 sayNO;
5160             break;
5161
5162 #define CASE_CLASS(nAmE)                              \
5163         case nAmE:                                    \
5164             if ((n=is_##nAmE(locinput,do_utf8))) {    \
5165                 locinput += n;                        \
5166                 nextchr = UCHARAT(locinput);          \
5167             } else                                    \
5168                 sayNO;                                \
5169             break;                                    \
5170         case N##nAmE:                                 \
5171             if ((n=is_##nAmE(locinput,do_utf8))) {    \
5172                 sayNO;                                \
5173             } else {                                  \
5174                 locinput += UTF8SKIP(locinput);       \
5175                 nextchr = UCHARAT(locinput);          \
5176             }                                         \
5177             break
5178
5179         CASE_CLASS(VERTWS);
5180         CASE_CLASS(HORIZWS);
5181 #undef CASE_CLASS
5182
5183         default:
5184             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
5185                           PTR2UV(scan), OP(scan));
5186             Perl_croak(aTHX_ "regexp memory corruption");
5187             
5188         } /* end switch */ 
5189
5190         /* switch break jumps here */
5191         scan = next; /* prepare to execute the next op and ... */
5192         continue;    /* ... jump back to the top, reusing st */
5193         /* NOTREACHED */
5194
5195       push_yes_state:
5196         /* push a state that backtracks on success */
5197         st->u.yes.prev_yes_state = yes_state;
5198         yes_state = st;
5199         /* FALL THROUGH */
5200       push_state:
5201         /* push a new regex state, then continue at scan  */
5202         {
5203             regmatch_state *newst;
5204
5205             DEBUG_STACK_r({
5206                 regmatch_state *cur = st;
5207                 regmatch_state *curyes = yes_state;
5208                 int curd = depth;
5209                 regmatch_slab *slab = PL_regmatch_slab;
5210                 for (;curd > -1;cur--,curd--) {
5211                     if (cur < SLAB_FIRST(slab)) {
5212                         slab = slab->prev;
5213                         cur = SLAB_LAST(slab);
5214                     }
5215                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
5216                         REPORT_CODE_OFF + 2 + depth * 2,"",
5217                         curd, PL_reg_name[cur->resume_state],
5218                         (curyes == cur) ? "yes" : ""
5219                     );
5220                     if (curyes == cur)
5221                         curyes = cur->u.yes.prev_yes_state;
5222                 }
5223             } else 
5224                 DEBUG_STATE_pp("push")
5225             );
5226             depth++;
5227             st->locinput = locinput;
5228             newst = st+1; 
5229             if (newst >  SLAB_LAST(PL_regmatch_slab))
5230                 newst = S_push_slab(aTHX);
5231             PL_regmatch_state = newst;
5232
5233             locinput = PL_reginput;
5234             nextchr = UCHARAT(locinput);
5235             st = newst;
5236             continue;
5237             /* NOTREACHED */
5238         }
5239     }
5240
5241     /*
5242     * We get here only if there's trouble -- normally "case END" is
5243     * the terminating point.
5244     */
5245     Perl_croak(aTHX_ "corrupted regexp pointers");
5246     /*NOTREACHED*/
5247     sayNO;
5248
5249 yes:
5250     if (yes_state) {
5251         /* we have successfully completed a subexpression, but we must now
5252          * pop to the state marked by yes_state and continue from there */
5253         assert(st != yes_state);
5254 #ifdef DEBUGGING
5255         while (st != yes_state) {
5256             st--;
5257             if (st < SLAB_FIRST(PL_regmatch_slab)) {
5258                 PL_regmatch_slab = PL_regmatch_slab->prev;
5259                 st = SLAB_LAST(PL_regmatch_slab);
5260             }
5261             DEBUG_STATE_r({
5262                 if (no_final) {
5263                     DEBUG_STATE_pp("pop (no final)");        
5264                 } else {
5265                     DEBUG_STATE_pp("pop (yes)");
5266                 }
5267             });
5268             depth--;
5269         }
5270 #else
5271         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
5272             || yes_state > SLAB_LAST(PL_regmatch_slab))
5273         {
5274             /* not in this slab, pop slab */
5275             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
5276             PL_regmatch_slab = PL_regmatch_slab->prev;
5277             st = SLAB_LAST(PL_regmatch_slab);
5278         }
5279         depth -= (st - yes_state);
5280 #endif
5281         st = yes_state;
5282         yes_state = st->u.yes.prev_yes_state;
5283         PL_regmatch_state = st;
5284         
5285         if (no_final) {
5286             locinput= st->locinput;
5287             nextchr = UCHARAT(locinput);
5288         }
5289         state_num = st->resume_state + no_final;
5290         goto reenter_switch;
5291     }
5292
5293     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
5294                           PL_colors[4], PL_colors[5]));
5295
5296     if (PL_reg_eval_set) {
5297         /* each successfully executed (?{...}) block does the equivalent of
5298          *   local $^R = do {...}
5299          * When popping the save stack, all these locals would be undone;
5300          * bypass this by setting the outermost saved $^R to the latest
5301          * value */
5302         if (oreplsv != GvSV(PL_replgv))
5303             sv_setsv(oreplsv, GvSV(PL_replgv));
5304     }
5305     result = 1;
5306     goto final_exit;
5307
5308 no:
5309     DEBUG_EXECUTE_r(
5310         PerlIO_printf(Perl_debug_log,
5311             "%*s  %sfailed...%s\n",
5312             REPORT_CODE_OFF+depth*2, "", 
5313             PL_colors[4], PL_colors[5])
5314         );
5315
5316 no_silent:
5317     if (no_final) {
5318         if (yes_state) {
5319             goto yes;
5320         } else {
5321             goto final_exit;
5322         }
5323     }    
5324     if (depth) {
5325         /* there's a previous state to backtrack to */
5326         st--;
5327         if (st < SLAB_FIRST(PL_regmatch_slab)) {
5328             PL_regmatch_slab = PL_regmatch_slab->prev;
5329             st = SLAB_LAST(PL_regmatch_slab);
5330         }
5331         PL_regmatch_state = st;
5332         locinput= st->locinput;
5333         nextchr = UCHARAT(locinput);
5334
5335         DEBUG_STATE_pp("pop");
5336         depth--;
5337         if (yes_state == st)
5338             yes_state = st->u.yes.prev_yes_state;
5339
5340         state_num = st->resume_state + 1; /* failure = success + 1 */
5341         goto reenter_switch;
5342     }
5343     result = 0;
5344
5345   final_exit:
5346     if (rex->intflags & PREGf_VERBARG_SEEN) {
5347         SV *sv_err = get_sv("REGERROR", 1);
5348         SV *sv_mrk = get_sv("REGMARK", 1);
5349         if (result) {
5350             sv_commit = &PL_sv_no;
5351             if (!sv_yes_mark) 
5352                 sv_yes_mark = &PL_sv_yes;
5353         } else {
5354             if (!sv_commit) 
5355                 sv_commit = &PL_sv_yes;
5356             sv_yes_mark = &PL_sv_no;
5357         }
5358         sv_setsv(sv_err, sv_commit);
5359         sv_setsv(sv_mrk, sv_yes_mark);
5360     }
5361
5362     /* clean up; in particular, free all slabs above current one */
5363     LEAVE_SCOPE(oldsave);
5364
5365     return result;
5366 }
5367
5368 /*
5369  - regrepeat - repeatedly match something simple, report how many
5370  */
5371 /*
5372  * [This routine now assumes that it will only match on things of length 1.
5373  * That was true before, but now we assume scan - reginput is the count,
5374  * rather than incrementing count on every character.  [Er, except utf8.]]
5375  */
5376 STATIC I32
5377 S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
5378 {
5379     dVAR;
5380     register char *scan;
5381     register I32 c;
5382     register char *loceol = PL_regeol;
5383     register I32 hardcount = 0;
5384     register bool do_utf8 = PL_reg_match_utf8;
5385 #ifndef DEBUGGING
5386     PERL_UNUSED_ARG(depth);
5387 #endif
5388
5389     PERL_ARGS_ASSERT_REGREPEAT;
5390
5391     scan = PL_reginput;
5392     if (max == REG_INFTY)
5393         max = I32_MAX;
5394     else if (max < loceol - scan)
5395         loceol = scan + max;
5396     switch (OP(p)) {
5397     case REG_ANY:
5398         if (do_utf8) {
5399             loceol = PL_regeol;
5400             while (scan < loceol && hardcount < max && *scan != '\n') {
5401                 scan += UTF8SKIP(scan);
5402                 hardcount++;
5403             }
5404         } else {
5405             while (scan < loceol && *scan != '\n')
5406                 scan++;
5407         }
5408         break;
5409     case SANY:
5410         if (do_utf8) {
5411             loceol = PL_regeol;
5412             while (scan < loceol && hardcount < max) {
5413                 scan += UTF8SKIP(scan);
5414                 hardcount++;
5415             }
5416         }
5417         else
5418             scan = loceol;
5419         break;
5420     case CANY:
5421         scan = loceol;
5422         break;
5423     case EXACT:         /* length of string is 1 */
5424         c = (U8)*STRING(p);
5425         while (scan < loceol && UCHARAT(scan) == c)
5426             scan++;
5427         break;
5428     case EXACTF:        /* length of string is 1 */
5429         c = (U8)*STRING(p);
5430         while (scan < loceol &&
5431                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
5432             scan++;
5433         break;
5434     case EXACTFL:       /* length of string is 1 */
5435         PL_reg_flags |= RF_tainted;
5436         c = (U8)*STRING(p);
5437         while (scan < loceol &&
5438                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
5439             scan++;
5440         break;
5441     case ANYOF:
5442         if (do_utf8) {
5443             loceol = PL_regeol;
5444             while (hardcount < max && scan < loceol &&
5445                    reginclass(prog, p, (U8*)scan, 0, do_utf8)) {
5446                 scan += UTF8SKIP(scan);
5447                 hardcount++;
5448             }
5449         } else {
5450             while (scan < loceol && REGINCLASS(prog, p, (U8*)scan))
5451                 scan++;
5452         }
5453         break;
5454     case ALNUM:
5455         if (do_utf8) {
5456             loceol = PL_regeol;
5457             LOAD_UTF8_CHARCLASS_ALNUM();
5458             while (hardcount < max && scan < loceol &&
5459                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5460                 scan += UTF8SKIP(scan);
5461                 hardcount++;
5462             }
5463         } else {
5464             while (scan < loceol && isALNUM(*scan))
5465                 scan++;
5466         }
5467         break;
5468     case ALNUML:
5469         PL_reg_flags |= RF_tainted;
5470         if (do_utf8) {
5471             loceol = PL_regeol;
5472             while (hardcount < max && scan < loceol &&
5473                    isALNUM_LC_utf8((U8*)scan)) {
5474                 scan += UTF8SKIP(scan);
5475                 hardcount++;
5476             }
5477         } else {
5478             while (scan < loceol && isALNUM_LC(*scan))
5479                 scan++;
5480         }
5481         break;
5482     case NALNUM:
5483         if (do_utf8) {
5484             loceol = PL_regeol;
5485             LOAD_UTF8_CHARCLASS_ALNUM();
5486             while (hardcount < max && scan < loceol &&
5487                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5488                 scan += UTF8SKIP(scan);
5489                 hardcount++;
5490             }
5491         } else {
5492             while (scan < loceol && !isALNUM(*scan))
5493                 scan++;
5494         }
5495         break;
5496     case NALNUML:
5497         PL_reg_flags |= RF_tainted;
5498         if (do_utf8) {
5499             loceol = PL_regeol;
5500             while (hardcount < max && scan < loceol &&
5501                    !isALNUM_LC_utf8((U8*)scan)) {
5502                 scan += UTF8SKIP(scan);
5503                 hardcount++;
5504             }
5505         } else {
5506             while (scan < loceol && !isALNUM_LC(*scan))
5507                 scan++;
5508         }
5509         break;
5510     case SPACE:
5511         if (do_utf8) {
5512             loceol = PL_regeol;
5513             LOAD_UTF8_CHARCLASS_SPACE();
5514             while (hardcount < max && scan < loceol &&
5515                    (*scan == ' ' ||
5516                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5517                 scan += UTF8SKIP(scan);
5518                 hardcount++;
5519             }
5520         } else {
5521             while (scan < loceol && isSPACE(*scan))
5522                 scan++;
5523         }
5524         break;
5525     case SPACEL:
5526         PL_reg_flags |= RF_tainted;
5527         if (do_utf8) {
5528             loceol = PL_regeol;
5529             while (hardcount < max && scan < loceol &&
5530                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5531                 scan += UTF8SKIP(scan);
5532                 hardcount++;
5533             }
5534         } else {
5535             while (scan < loceol && isSPACE_LC(*scan))
5536                 scan++;
5537         }
5538         break;
5539     case NSPACE:
5540         if (do_utf8) {
5541             loceol = PL_regeol;
5542             LOAD_UTF8_CHARCLASS_SPACE();
5543             while (hardcount < max && scan < loceol &&
5544                    !(*scan == ' ' ||
5545                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5546                 scan += UTF8SKIP(scan);
5547                 hardcount++;
5548             }
5549         } else {
5550             while (scan < loceol && !isSPACE(*scan))
5551                 scan++;
5552         }
5553         break;
5554     case NSPACEL:
5555         PL_reg_flags |= RF_tainted;
5556         if (do_utf8) {
5557             loceol = PL_regeol;
5558             while (hardcount < max && scan < loceol &&
5559                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5560                 scan += UTF8SKIP(scan);
5561                 hardcount++;
5562             }
5563         } else {
5564             while (scan < loceol && !isSPACE_LC(*scan))
5565                 scan++;
5566         }
5567         break;
5568     case DIGIT:
5569         if (do_utf8) {
5570             loceol = PL_regeol;
5571             LOAD_UTF8_CHARCLASS_DIGIT();
5572             while (hardcount < max && scan < loceol &&
5573                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5574                 scan += UTF8SKIP(scan);
5575                 hardcount++;
5576             }
5577         } else {
5578             while (scan < loceol && isDIGIT(*scan))
5579                 scan++;
5580         }
5581         break;
5582     case NDIGIT:
5583         if (do_utf8) {
5584             loceol = PL_regeol;
5585             LOAD_UTF8_CHARCLASS_DIGIT();
5586             while (hardcount < max && scan < loceol &&
5587                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5588                 scan += UTF8SKIP(scan);
5589                 hardcount++;
5590             }
5591         } else {
5592             while (scan < loceol && !isDIGIT(*scan))
5593                 scan++;
5594         }
5595     case LNBREAK:
5596         if (do_utf8) {
5597             loceol = PL_regeol;
5598             while (hardcount < max && scan < loceol && (c=is_LNBREAK_utf8(scan))) {
5599                 scan += c;
5600                 hardcount++;
5601             }
5602         } else {
5603             /*
5604               LNBREAK can match two latin chars, which is ok,
5605               because we have a null terminated string, but we
5606               have to use hardcount in this situation
5607             */
5608             while (scan < loceol && (c=is_LNBREAK_latin1(scan)))  {
5609                 scan+=c;
5610                 hardcount++;
5611             }
5612         }       
5613         break;
5614     case HORIZWS:
5615         if (do_utf8) {
5616             loceol = PL_regeol;
5617             while (hardcount < max && scan < loceol && (c=is_HORIZWS_utf8(scan))) {
5618                 scan += c;
5619                 hardcount++;
5620             }
5621         } else {
5622             while (scan < loceol && is_HORIZWS_latin1(scan)) 
5623                 scan++;         
5624         }       
5625         break;
5626     case NHORIZWS:
5627         if (do_utf8) {
5628             loceol = PL_regeol;
5629             while (hardcount < max && scan < loceol && !is_HORIZWS_utf8(scan)) {
5630                 scan += UTF8SKIP(scan);
5631                 hardcount++;
5632             }
5633         } else {
5634             while (scan < loceol && !is_HORIZWS_latin1(scan))
5635                 scan++;
5636
5637         }       
5638         break;
5639     case VERTWS:
5640         if (do_utf8) {
5641             loceol = PL_regeol;
5642             while (hardcount < max && scan < loceol && (c=is_VERTWS_utf8(scan))) {
5643                 scan += c;
5644                 hardcount++;
5645             }
5646         } else {
5647             while (scan < loceol && is_VERTWS_latin1(scan)) 
5648                 scan++;
5649
5650         }       
5651         break;
5652     case NVERTWS:
5653         if (do_utf8) {
5654             loceol = PL_regeol;
5655             while (hardcount < max && scan < loceol && !is_VERTWS_utf8(scan)) {
5656                 scan += UTF8SKIP(scan);
5657                 hardcount++;
5658             }
5659         } else {
5660             while (scan < loceol && !is_VERTWS_latin1(scan)) 
5661                 scan++;
5662           
5663         }       
5664         break;
5665
5666     default:            /* Called on something of 0 width. */
5667         break;          /* So match right here or not at all. */
5668     }
5669
5670     if (hardcount)
5671         c = hardcount;
5672     else
5673         c = scan - PL_reginput;
5674     PL_reginput = scan;
5675
5676     DEBUG_r({
5677         GET_RE_DEBUG_FLAGS_DECL;
5678         DEBUG_EXECUTE_r({
5679             SV * const prop = sv_newmortal();
5680             regprop(prog, prop, p);
5681             PerlIO_printf(Perl_debug_log,
5682                         "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
5683                         REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
5684         });
5685     });
5686
5687     return(c);
5688 }
5689
5690
5691 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
5692 /*
5693 - regclass_swash - prepare the utf8 swash
5694 */
5695
5696 SV *
5697 Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
5698 {
5699     dVAR;
5700     SV *sw  = NULL;
5701     SV *si  = NULL;
5702     SV *alt = NULL;
5703     RXi_GET_DECL(prog,progi);
5704     const struct reg_data * const data = prog ? progi->data : NULL;
5705
5706     PERL_ARGS_ASSERT_REGCLASS_SWASH;
5707
5708     if (data && data->count) {
5709         const U32 n = ARG(node);
5710
5711         if (data->what[n] == 's') {
5712             SV * const rv = MUTABLE_SV(data->data[n]);
5713             AV * const av = MUTABLE_AV(SvRV(rv));
5714             SV **const ary = AvARRAY(av);
5715             SV **a, **b;
5716         
5717             /* See the end of regcomp.c:S_regclass() for
5718              * documentation of these array elements. */
5719
5720             si = *ary;
5721             a  = SvROK(ary[1]) ? &ary[1] : NULL;
5722             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : NULL;
5723
5724             if (a)
5725                 sw = *a;
5726             else if (si && doinit) {
5727                 sw = swash_init("utf8", "", si, 1, 0);
5728                 (void)av_store(av, 1, sw);
5729             }
5730             if (b)
5731                 alt = *b;
5732         }
5733     }
5734         
5735     if (listsvp)
5736         *listsvp = si;
5737     if (altsvp)
5738         *altsvp  = alt;
5739
5740     return sw;
5741 }
5742 #endif
5743
5744 /*
5745  - reginclass - determine if a character falls into a character class
5746  
5747   The n is the ANYOF regnode, the p is the target string, lenp
5748   is pointer to the maximum length of how far to go in the p
5749   (if the lenp is zero, UTF8SKIP(p) is used),
5750   do_utf8 tells whether the target string is in UTF-8.
5751
5752  */
5753
5754 STATIC bool
5755 S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
5756 {
5757     dVAR;
5758     const char flags = ANYOF_FLAGS(n);
5759     bool match = FALSE;
5760     UV c = *p;
5761     STRLEN len = 0;
5762     STRLEN plen;
5763
5764     PERL_ARGS_ASSERT_REGINCLASS;
5765
5766     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
5767         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
5768                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
5769                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
5770         if (len == (STRLEN)-1) 
5771             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
5772     }
5773
5774     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
5775     if (do_utf8 || (flags & ANYOF_UNICODE)) {
5776         if (lenp)
5777             *lenp = 0;
5778         if (do_utf8 && !ANYOF_RUNTIME(n)) {
5779             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
5780                 match = TRUE;
5781         }
5782         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
5783             match = TRUE;
5784         if (!match) {
5785             AV *av;
5786             SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
5787         
5788             if (sw) {
5789                 U8 * utf8_p;
5790                 if (do_utf8) {
5791                     utf8_p = (U8 *) p;
5792                 } else {
5793                     STRLEN len = 1;
5794                     utf8_p = bytes_to_utf8(p, &len);
5795                 }
5796                 if (swash_fetch(sw, utf8_p, 1))
5797                     match = TRUE;
5798                 else if (flags & ANYOF_FOLD) {
5799                     if (!match && lenp && av) {
5800                         I32 i;
5801                         for (i = 0; i <= av_len(av); i++) {
5802                             SV* const sv = *av_fetch(av, i, FALSE);
5803                             STRLEN len;
5804                             const char * const s = SvPV_const(sv, len);
5805                             if (len <= plen && memEQ(s, (char*)utf8_p, len)) {
5806                                 *lenp = len;
5807                                 match = TRUE;
5808                                 break;
5809                             }
5810                         }
5811                     }
5812                     if (!match) {
5813                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
5814
5815                         STRLEN tmplen;
5816                         to_utf8_fold(utf8_p, tmpbuf, &tmplen);
5817                         if (swash_fetch(sw, tmpbuf, 1))
5818                             match = TRUE;
5819                     }
5820                 }
5821
5822                 /* If we allocated a string above, free it */
5823                 if (! do_utf8) Safefree(utf8_p);
5824             }
5825         }
5826         if (match && lenp && *lenp == 0)
5827             *lenp = UNISKIP(NATIVE_TO_UNI(c));
5828     }
5829     if (!match && c < 256) {
5830         if (ANYOF_BITMAP_TEST(n, c))
5831             match = TRUE;
5832         else if (flags & ANYOF_FOLD) {
5833             U8 f;
5834
5835             if (flags & ANYOF_LOCALE) {
5836                 PL_reg_flags |= RF_tainted;
5837                 f = PL_fold_locale[c];
5838             }
5839             else
5840                 f = PL_fold[c];
5841             if (f != c && ANYOF_BITMAP_TEST(n, f))
5842                 match = TRUE;
5843         }
5844         
5845         if (!match && (flags & ANYOF_CLASS)) {
5846             PL_reg_flags |= RF_tainted;
5847             if (
5848                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
5849                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
5850                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
5851                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
5852                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
5853                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
5854                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
5855                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
5856                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
5857                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
5858                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
5859                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
5860                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
5861                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
5862                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
5863                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
5864                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
5865                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
5866                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
5867                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
5868                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
5869                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
5870                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
5871                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
5872                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
5873                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
5874                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
5875                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
5876                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
5877                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
5878                 ) /* How's that for a conditional? */
5879             {
5880                 match = TRUE;
5881             }
5882         }
5883     }
5884
5885     return (flags & ANYOF_INVERT) ? !match : match;
5886 }
5887
5888 STATIC U8 *
5889 S_reghop3(U8 *s, I32 off, const U8* lim)
5890 {
5891     dVAR;
5892
5893     PERL_ARGS_ASSERT_REGHOP3;
5894
5895     if (off >= 0) {
5896         while (off-- && s < lim) {
5897             /* XXX could check well-formedness here */
5898             s += UTF8SKIP(s);
5899         }
5900     }
5901     else {
5902         while (off++ && s > lim) {
5903             s--;
5904             if (UTF8_IS_CONTINUED(*s)) {
5905                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5906                     s--;
5907             }
5908             /* XXX could check well-formedness here */
5909         }
5910     }
5911     return s;
5912 }
5913
5914 #ifdef XXX_dmq
5915 /* there are a bunch of places where we use two reghop3's that should
5916    be replaced with this routine. but since thats not done yet 
5917    we ifdef it out - dmq
5918 */
5919 STATIC U8 *
5920 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
5921 {
5922     dVAR;
5923
5924     PERL_ARGS_ASSERT_REGHOP4;
5925
5926     if (off >= 0) {
5927         while (off-- && s < rlim) {
5928             /* XXX could check well-formedness here */
5929             s += UTF8SKIP(s);
5930         }
5931     }
5932     else {
5933         while (off++ && s > llim) {
5934             s--;
5935             if (UTF8_IS_CONTINUED(*s)) {
5936                 while (s > llim && UTF8_IS_CONTINUATION(*s))
5937                     s--;
5938             }
5939             /* XXX could check well-formedness here */
5940         }
5941     }
5942     return s;
5943 }
5944 #endif
5945
5946 STATIC U8 *
5947 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
5948 {
5949     dVAR;
5950
5951     PERL_ARGS_ASSERT_REGHOPMAYBE3;
5952
5953     if (off >= 0) {
5954         while (off-- && s < lim) {
5955             /* XXX could check well-formedness here */
5956             s += UTF8SKIP(s);
5957         }
5958         if (off >= 0)
5959             return NULL;
5960     }
5961     else {
5962         while (off++ && s > lim) {
5963             s--;
5964             if (UTF8_IS_CONTINUED(*s)) {
5965                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5966                     s--;
5967             }
5968             /* XXX could check well-formedness here */
5969         }
5970         if (off <= 0)
5971             return NULL;
5972     }
5973     return s;
5974 }
5975
5976 static void
5977 restore_pos(pTHX_ void *arg)
5978 {
5979     dVAR;
5980     regexp * const rex = (regexp *)arg;
5981     if (PL_reg_eval_set) {
5982         if (PL_reg_oldsaved) {
5983             rex->subbeg = PL_reg_oldsaved;
5984             rex->sublen = PL_reg_oldsavedlen;
5985 #ifdef PERL_OLD_COPY_ON_WRITE
5986             rex->saved_copy = PL_nrs;
5987 #endif
5988             RXp_MATCH_COPIED_on(rex);
5989         }
5990         PL_reg_magic->mg_len = PL_reg_oldpos;
5991         PL_reg_eval_set = 0;
5992         PL_curpm = PL_reg_oldcurpm;
5993     }   
5994 }
5995
5996 STATIC void
5997 S_to_utf8_substr(pTHX_ register regexp *prog)
5998 {
5999     int i = 1;
6000
6001     PERL_ARGS_ASSERT_TO_UTF8_SUBSTR;
6002
6003     do {
6004         if (prog->substrs->data[i].substr
6005             && !prog->substrs->data[i].utf8_substr) {
6006             SV* const sv = newSVsv(prog->substrs->data[i].substr);
6007             prog->substrs->data[i].utf8_substr = sv;
6008             sv_utf8_upgrade(sv);
6009             if (SvVALID(prog->substrs->data[i].substr)) {
6010                 const U8 flags = BmFLAGS(prog->substrs->data[i].substr);
6011                 if (flags & FBMcf_TAIL) {
6012                     /* Trim the trailing \n that fbm_compile added last
6013                        time.  */
6014                     SvCUR_set(sv, SvCUR(sv) - 1);
6015                     /* Whilst this makes the SV technically "invalid" (as its
6016                        buffer is no longer followed by "\0") when fbm_compile()
6017                        adds the "\n" back, a "\0" is restored.  */
6018                 }
6019                 fbm_compile(sv, flags);
6020             }
6021             if (prog->substrs->data[i].substr == prog->check_substr)
6022                 prog->check_utf8 = sv;
6023         }
6024     } while (i--);
6025 }
6026
6027 STATIC void
6028 S_to_byte_substr(pTHX_ register regexp *prog)
6029 {
6030     dVAR;
6031     int i = 1;
6032
6033     PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
6034
6035     do {
6036         if (prog->substrs->data[i].utf8_substr
6037             && !prog->substrs->data[i].substr) {
6038             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
6039             if (sv_utf8_downgrade(sv, TRUE)) {
6040                 if (SvVALID(prog->substrs->data[i].utf8_substr)) {
6041                     const U8 flags
6042                         = BmFLAGS(prog->substrs->data[i].utf8_substr);
6043                     if (flags & FBMcf_TAIL) {
6044                         /* Trim the trailing \n that fbm_compile added last
6045                            time.  */
6046                         SvCUR_set(sv, SvCUR(sv) - 1);
6047                     }
6048                     fbm_compile(sv, flags);
6049                 }           
6050             } else {
6051                 SvREFCNT_dec(sv);
6052                 sv = &PL_sv_undef;
6053             }
6054             prog->substrs->data[i].substr = sv;
6055             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
6056                 prog->check_substr = sv;
6057         }
6058     } while (i--);
6059 }
6060
6061 /*
6062  * Local variables:
6063  * c-indentation-style: bsd
6064  * c-basic-offset: 4
6065  * indent-tabs-mode: t
6066  * End:
6067  *
6068  * ex: set ts=8 sts=4 sw=4 noet:
6069  */