This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.h: Clarify comments
[perl5.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 #include "invlist_inline.h"
84 #include "unicode_constants.h"
85
86 #define B_ON_NON_UTF8_LOCALE_IS_WRONG            \
87  "Use of \\b{} or \\B{} for non-UTF-8 locale is wrong.  Assuming a UTF-8 locale"
88
89 static const char utf8_locale_required[] =
90       "Use of (?[ ]) for non-UTF-8 locale is wrong.  Assuming a UTF-8 locale";
91
92 #ifdef DEBUGGING
93 /* At least one required character in the target string is expressible only in
94  * UTF-8. */
95 static const char* const non_utf8_target_but_utf8_required
96                 = "Can't match, because target string needs to be in UTF-8\n";
97 #endif
98
99 #define NON_UTF8_TARGET_BUT_UTF8_REQUIRED(target) STMT_START {           \
100     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "%s", non_utf8_target_but_utf8_required));\
101     goto target;                                                         \
102 } STMT_END
103
104 #define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
105
106 #ifndef STATIC
107 #define STATIC  static
108 #endif
109
110 /* Valid only if 'c', the character being looke-up, is an invariant under
111  * UTF-8: it avoids the reginclass call if there are no complications: i.e., if
112  * everything matchable is straight forward in the bitmap */
113 #define REGINCLASS(prog,p,c,u)  (ANYOF_FLAGS(p)                             \
114                                 ? reginclass(prog,p,c,c+1,u)                \
115                                 : ANYOF_BITMAP_TEST(p,*(c)))
116
117 /*
118  * Forwards.
119  */
120
121 #define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv))
122
123 #define HOPc(pos,off) \
124         (char *)(reginfo->is_utf8_target \
125             ? reghop3((U8*)pos, off, \
126                     (U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
127             : (U8*)(pos + off))
128
129 /* like HOPMAYBE3 but backwards. lim must be +ve. Returns NULL on overshoot */
130 #define HOPBACK3(pos, off, lim) \
131         (reginfo->is_utf8_target                          \
132             ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(lim)) \
133             : (pos - off >= lim)                                 \
134                 ? (U8*)pos - off                                 \
135                 : NULL)
136
137 #define HOPBACKc(pos, off) ((char*)HOPBACK3(pos, off, reginfo->strbeg))
138
139 #define HOP3(pos,off,lim) (reginfo->is_utf8_target  ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
140 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
141
142 /* lim must be +ve. Returns NULL on overshoot */
143 #define HOPMAYBE3(pos,off,lim) \
144         (reginfo->is_utf8_target                        \
145             ? reghopmaybe3((U8*)pos, off, (U8*)(lim))   \
146             : ((U8*)pos + off <= lim)                   \
147                 ? (U8*)pos + off                        \
148                 : NULL)
149
150 /* like HOP3, but limits the result to <= lim even for the non-utf8 case.
151  * off must be >=0; args should be vars rather than expressions */
152 #define HOP3lim(pos,off,lim) (reginfo->is_utf8_target \
153     ? reghop3((U8*)(pos), off, (U8*)(lim)) \
154     : (U8*)((pos + off) > lim ? lim : (pos + off)))
155 #define HOP3clim(pos,off,lim) ((char*)HOP3lim(pos,off,lim))
156
157 #define HOP4(pos,off,llim, rlim) (reginfo->is_utf8_target \
158     ? reghop4((U8*)(pos), off, (U8*)(llim), (U8*)(rlim)) \
159     : (U8*)(pos + off))
160 #define HOP4c(pos,off,llim, rlim) ((char*)HOP4(pos,off,llim, rlim))
161
162 #define NEXTCHR_EOS -10 /* nextchr has fallen off the end */
163 #define NEXTCHR_IS_EOS (nextchr < 0)
164
165 #define SET_nextchr \
166     nextchr = ((locinput < reginfo->strend) ? UCHARAT(locinput) : NEXTCHR_EOS)
167
168 #define SET_locinput(p) \
169     locinput = (p);  \
170     SET_nextchr
171
172 #define PLACEHOLDER     /* Something for the preprocessor to grab onto */
173 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
174
175 /* for use after a quantifier and before an EXACT-like node -- japhy */
176 /* it would be nice to rework regcomp.sym to generate this stuff. sigh
177  *
178  * NOTE that *nothing* that affects backtracking should be in here, specifically
179  * VERBS must NOT be included. JUMPABLE is used to determine  if we can ignore a
180  * node that is in between two EXACT like nodes when ascertaining what the required
181  * "follow" character is. This should probably be moved to regex compile time
182  * although it may be done at run time beause of the REF possibility - more
183  * investigation required. -- demerphq
184 */
185 #define JUMPABLE(rn) (                                                             \
186     OP(rn) == OPEN ||                                                              \
187     (OP(rn) == CLOSE &&                                                            \
188      !EVAL_CLOSE_PAREN_IS(cur_eval,ARG(rn)) ) ||                                   \
189     OP(rn) == EVAL ||                                                              \
190     OP(rn) == SUSPEND || OP(rn) == IFMATCH ||                                      \
191     OP(rn) == PLUS || OP(rn) == MINMOD ||                                          \
192     OP(rn) == KEEPS ||                                                             \
193     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0)                                  \
194 )
195 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
196
197 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
198
199 #if 0 
200 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
201    we don't need this definition.  XXX These are now out-of-sync*/
202 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
203 #define IS_TEXTF(rn)  ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFAA || OP(rn)==EXACTFAA_NO_TRIE || OP(rn)==EXACTF || OP(rn)==REFF  || OP(rn)==NREFF )
204 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
205
206 #else
207 /* ... so we use this as its faster. */
208 #define IS_TEXT(rn)   ( OP(rn)==EXACT || OP(rn)==EXACTL )
209 #define IS_TEXTFU(rn)  ( OP(rn)==EXACTFU || OP(rn)==EXACTFLU8 || OP(rn)==EXACTFU_SS || OP(rn) == EXACTFAA || OP(rn) == EXACTFAA_NO_TRIE)
210 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
211 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
212
213 #endif
214
215 /*
216   Search for mandatory following text node; for lookahead, the text must
217   follow but for lookbehind (rn->flags != 0) we skip to the next step.
218 */
219 #define FIND_NEXT_IMPT(rn) STMT_START {                                   \
220     while (JUMPABLE(rn)) { \
221         const OPCODE type = OP(rn); \
222         if (type == SUSPEND || PL_regkind[type] == CURLY) \
223             rn = NEXTOPER(NEXTOPER(rn)); \
224         else if (type == PLUS) \
225             rn = NEXTOPER(rn); \
226         else if (type == IFMATCH) \
227             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
228         else rn += NEXT_OFF(rn); \
229     } \
230 } STMT_END 
231
232 #define SLAB_FIRST(s) (&(s)->states[0])
233 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
234
235 static void S_setup_eval_state(pTHX_ regmatch_info *const reginfo);
236 static void S_cleanup_regmatch_info_aux(pTHX_ void *arg);
237 static regmatch_state * S_push_slab(pTHX);
238
239 #define REGCP_PAREN_ELEMS 3
240 #define REGCP_OTHER_ELEMS 3
241 #define REGCP_FRAME_ELEMS 1
242 /* REGCP_FRAME_ELEMS are not part of the REGCP_OTHER_ELEMS and
243  * are needed for the regexp context stack bookkeeping. */
244
245 STATIC CHECKPOINT
246 S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen _pDEPTH)
247 {
248     const int retval = PL_savestack_ix;
249     const int paren_elems_to_push =
250                 (maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
251     const UV total_elems = paren_elems_to_push + REGCP_OTHER_ELEMS;
252     const UV elems_shifted = total_elems << SAVE_TIGHT_SHIFT;
253     I32 p;
254     GET_RE_DEBUG_FLAGS_DECL;
255
256     PERL_ARGS_ASSERT_REGCPPUSH;
257
258     if (paren_elems_to_push < 0)
259         Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %u",
260                    (int)paren_elems_to_push, (int)maxopenparen,
261                    (int)parenfloor, (unsigned)REGCP_PAREN_ELEMS);
262
263     if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
264         Perl_croak(aTHX_ "panic: paren_elems_to_push offset %" UVuf
265                    " out of range (%lu-%ld)",
266                    total_elems,
267                    (unsigned long)maxopenparen,
268                    (long)parenfloor);
269
270     SSGROW(total_elems + REGCP_FRAME_ELEMS);
271     
272     DEBUG_BUFFERS_r(
273         if ((int)maxopenparen > (int)parenfloor)
274             Perl_re_exec_indentf( aTHX_
275                 "rex=0x%" UVxf " offs=0x%" UVxf ": saving capture indices:\n",
276                 depth,
277                 PTR2UV(rex),
278                 PTR2UV(rex->offs)
279             );
280     );
281     for (p = parenfloor+1; p <= (I32)maxopenparen;  p++) {
282 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
283         SSPUSHIV(rex->offs[p].end);
284         SSPUSHIV(rex->offs[p].start);
285         SSPUSHINT(rex->offs[p].start_tmp);
286         DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
287             "    \\%" UVuf ": %" IVdf "(%" IVdf ")..%" IVdf "\n",
288             depth,
289             (UV)p,
290             (IV)rex->offs[p].start,
291             (IV)rex->offs[p].start_tmp,
292             (IV)rex->offs[p].end
293         ));
294     }
295 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
296     SSPUSHINT(maxopenparen);
297     SSPUSHINT(rex->lastparen);
298     SSPUSHINT(rex->lastcloseparen);
299     SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
300
301     return retval;
302 }
303
304 /* These are needed since we do not localize EVAL nodes: */
305 #define REGCP_SET(cp)                                           \
306     DEBUG_STATE_r(                                              \
307         Perl_re_exec_indentf( aTHX_                             \
308             "Setting an EVAL scope, savestack=%" IVdf ",\n",    \
309             depth, (IV)PL_savestack_ix                          \
310         )                                                       \
311     );                                                          \
312     cp = PL_savestack_ix
313
314 #define REGCP_UNWIND(cp)                                        \
315     DEBUG_STATE_r(                                              \
316         if (cp != PL_savestack_ix)                              \
317             Perl_re_exec_indentf( aTHX_                         \
318                 "Clearing an EVAL scope, savestack=%"           \
319                 IVdf "..%" IVdf "\n",                           \
320                 depth, (IV)(cp), (IV)PL_savestack_ix            \
321             )                                                   \
322     );                                                          \
323     regcpblow(cp)
324
325 /* set the start and end positions of capture ix */
326 #define CLOSE_CAPTURE(ix, s, e)                                            \
327     rex->offs[ix].start = s;                                               \
328     rex->offs[ix].end = e;                                                 \
329     if (ix > rex->lastparen)                                               \
330         rex->lastparen = ix;                                               \
331     rex->lastcloseparen = ix;                                              \
332     DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_                            \
333         "CLOSE: rex=0x%" UVxf " offs=0x%" UVxf ": \\%" UVuf ": set %" IVdf "..%" IVdf " max: %" UVuf "\n", \
334         depth,                                                             \
335         PTR2UV(rex),                                                       \
336         PTR2UV(rex->offs),                                                 \
337         (UV)ix,                                                            \
338         (IV)rex->offs[ix].start,                                           \
339         (IV)rex->offs[ix].end,                                             \
340         (UV)rex->lastparen                                                 \
341     ))
342
343 #define UNWIND_PAREN(lp, lcp)               \
344     DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_  \
345         "UNWIND_PAREN: rex=0x%" UVxf " offs=0x%" UVxf ": invalidate (%" UVuf "..%" UVuf "] set lcp: %" UVuf "\n", \
346         depth,                              \
347         PTR2UV(rex),                        \
348         PTR2UV(rex->offs),                  \
349         (UV)(lp),                           \
350         (UV)(rex->lastparen),               \
351         (UV)(lcp)                           \
352     ));                                     \
353     for (n = rex->lastparen; n > lp; n--)   \
354         rex->offs[n].end = -1;              \
355     rex->lastparen = n;                     \
356     rex->lastcloseparen = lcp;
357
358
359 STATIC void
360 S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p _pDEPTH)
361 {
362     UV i;
363     U32 paren;
364     GET_RE_DEBUG_FLAGS_DECL;
365
366     PERL_ARGS_ASSERT_REGCPPOP;
367
368     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
369     i = SSPOPUV;
370     assert((i & SAVE_MASK) == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
371     i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
372     rex->lastcloseparen = SSPOPINT;
373     rex->lastparen = SSPOPINT;
374     *maxopenparen_p = SSPOPINT;
375
376     i -= REGCP_OTHER_ELEMS;
377     /* Now restore the parentheses context. */
378     DEBUG_BUFFERS_r(
379         if (i || rex->lastparen + 1 <= rex->nparens)
380             Perl_re_exec_indentf( aTHX_
381                 "rex=0x%" UVxf " offs=0x%" UVxf ": restoring capture indices to:\n",
382                 depth,
383                 PTR2UV(rex),
384                 PTR2UV(rex->offs)
385             );
386     );
387     paren = *maxopenparen_p;
388     for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
389         SSize_t tmps;
390         rex->offs[paren].start_tmp = SSPOPINT;
391         rex->offs[paren].start = SSPOPIV;
392         tmps = SSPOPIV;
393         if (paren <= rex->lastparen)
394             rex->offs[paren].end = tmps;
395         DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_
396             "    \\%" UVuf ": %" IVdf "(%" IVdf ")..%" IVdf "%s\n",
397             depth,
398             (UV)paren,
399             (IV)rex->offs[paren].start,
400             (IV)rex->offs[paren].start_tmp,
401             (IV)rex->offs[paren].end,
402             (paren > rex->lastparen ? "(skipped)" : ""));
403         );
404         paren--;
405     }
406 #if 1
407     /* It would seem that the similar code in regtry()
408      * already takes care of this, and in fact it is in
409      * a better location to since this code can #if 0-ed out
410      * but the code in regtry() is needed or otherwise tests
411      * requiring null fields (pat.t#187 and split.t#{13,14}
412      * (as of patchlevel 7877)  will fail.  Then again,
413      * this code seems to be necessary or otherwise
414      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
415      * --jhi updated by dapm */
416     for (i = rex->lastparen + 1; i <= rex->nparens; i++) {
417         if (i > *maxopenparen_p)
418             rex->offs[i].start = -1;
419         rex->offs[i].end = -1;
420         DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_
421             "    \\%" UVuf ": %s   ..-1 undeffing\n",
422             depth,
423             (UV)i,
424             (i > *maxopenparen_p) ? "-1" : "  "
425         ));
426     }
427 #endif
428 }
429
430 /* restore the parens and associated vars at savestack position ix,
431  * but without popping the stack */
432
433 STATIC void
434 S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p _pDEPTH)
435 {
436     I32 tmpix = PL_savestack_ix;
437     PERL_ARGS_ASSERT_REGCP_RESTORE;
438
439     PL_savestack_ix = ix;
440     regcppop(rex, maxopenparen_p);
441     PL_savestack_ix = tmpix;
442 }
443
444 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
445
446 #ifndef PERL_IN_XSUB_RE
447
448 bool
449 Perl_isFOO_lc(pTHX_ const U8 classnum, const U8 character)
450 {
451     /* Returns a boolean as to whether or not 'character' is a member of the
452      * Posix character class given by 'classnum' that should be equivalent to a
453      * value in the typedef '_char_class_number'.
454      *
455      * Ideally this could be replaced by a just an array of function pointers
456      * to the C library functions that implement the macros this calls.
457      * However, to compile, the precise function signatures are required, and
458      * these may vary from platform to to platform.  To avoid having to figure
459      * out what those all are on each platform, I (khw) am using this method,
460      * which adds an extra layer of function call overhead (unless the C
461      * optimizer strips it away).  But we don't particularly care about
462      * performance with locales anyway. */
463
464     switch ((_char_class_number) classnum) {
465         case _CC_ENUM_ALPHANUMERIC: return isALPHANUMERIC_LC(character);
466         case _CC_ENUM_ALPHA:     return isALPHA_LC(character);
467         case _CC_ENUM_ASCII:     return isASCII_LC(character);
468         case _CC_ENUM_BLANK:     return isBLANK_LC(character);
469         case _CC_ENUM_CASED:     return    isLOWER_LC(character)
470                                         || isUPPER_LC(character);
471         case _CC_ENUM_CNTRL:     return isCNTRL_LC(character);
472         case _CC_ENUM_DIGIT:     return isDIGIT_LC(character);
473         case _CC_ENUM_GRAPH:     return isGRAPH_LC(character);
474         case _CC_ENUM_LOWER:     return isLOWER_LC(character);
475         case _CC_ENUM_PRINT:     return isPRINT_LC(character);
476         case _CC_ENUM_PUNCT:     return isPUNCT_LC(character);
477         case _CC_ENUM_SPACE:     return isSPACE_LC(character);
478         case _CC_ENUM_UPPER:     return isUPPER_LC(character);
479         case _CC_ENUM_WORDCHAR:  return isWORDCHAR_LC(character);
480         case _CC_ENUM_XDIGIT:    return isXDIGIT_LC(character);
481         default:    /* VERTSPACE should never occur in locales */
482             Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum);
483     }
484
485     NOT_REACHED; /* NOTREACHED */
486     return FALSE;
487 }
488
489 #endif
490
491 STATIC bool
492 S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character, const U8* e)
493 {
494     /* Returns a boolean as to whether or not the (well-formed) UTF-8-encoded
495      * 'character' is a member of the Posix character class given by 'classnum'
496      * that should be equivalent to a value in the typedef
497      * '_char_class_number'.
498      *
499      * This just calls isFOO_lc on the code point for the character if it is in
500      * the range 0-255.  Outside that range, all characters use Unicode
501      * rules, ignoring any locale.  So use the Unicode function if this class
502      * requires a swash, and use the Unicode macro otherwise. */
503
504     PERL_ARGS_ASSERT_ISFOO_UTF8_LC;
505
506     if (UTF8_IS_INVARIANT(*character)) {
507         return isFOO_lc(classnum, *character);
508     }
509     else if (UTF8_IS_DOWNGRADEABLE_START(*character)) {
510         return isFOO_lc(classnum,
511                         EIGHT_BIT_UTF8_TO_NATIVE(*character, *(character + 1)));
512     }
513
514     _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(character, e);
515
516     switch ((_char_class_number) classnum) {
517         case _CC_ENUM_SPACE:     return is_XPERLSPACE_high(character);
518         case _CC_ENUM_BLANK:     return is_HORIZWS_high(character);
519         case _CC_ENUM_XDIGIT:    return is_XDIGIT_high(character);
520         case _CC_ENUM_VERTSPACE: return is_VERTWS_high(character);
521         default:
522             return _invlist_contains_cp(PL_XPosix_ptrs[classnum],
523                                         utf8_to_uvchr_buf(character, e, NULL));
524     }
525
526     return FALSE; /* Things like CNTRL are always below 256 */
527 }
528
529 STATIC char *
530 S_find_next_ascii(char * s, const char * send, const bool utf8_target)
531 {
532     /* Returns the position of the first ASCII byte in the sequence between 's'
533      * and 'send-1' inclusive; returns 'send' if none found */
534
535     PERL_ARGS_ASSERT_FIND_NEXT_ASCII;
536
537 #ifndef EBCDIC
538
539     if ((STRLEN) (send - s) >= PERL_WORDSIZE
540
541                             /* This term is wordsize if subword; 0 if not */
542                           + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
543
544                             /* 'offset' */
545                           - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
546     {
547
548         /* Process per-byte until reach word boundary.  XXX This loop could be
549          * eliminated if we knew that this platform had fast unaligned reads */
550         while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
551             if (isASCII(*s)) {
552                 return s;
553             }
554             s++;    /* khw didn't bother creating a separate loop for
555                        utf8_target */
556         }
557
558         /* Here, we know we have at least one full word to process.  Process
559          * per-word as long as we have at least a full word left */
560         do {
561             PERL_UINTMAX_T complemented = ~ * (PERL_UINTMAX_T *) s;
562             if (complemented & PERL_VARIANTS_WORD_MASK)  {
563
564 #  if   BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    \
565      || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
566
567                 s += _variant_byte_number(complemented);
568                 return s;
569
570 #  else   /* If weird byte order, drop into next loop to do byte-at-a-time
571            checks. */
572
573                 break;
574 #  endif
575             }
576
577             s += PERL_WORDSIZE;
578
579         } while (s + PERL_WORDSIZE <= send);
580     }
581
582 #endif
583
584     /* Process per-character */
585     if (utf8_target) {
586         while (s < send) {
587             if (isASCII(*s)) {
588                 return s;
589             }
590             s += UTF8SKIP(s);
591         }
592     }
593     else {
594         while (s < send) {
595             if (isASCII(*s)) {
596                 return s;
597             }
598             s++;
599         }
600     }
601
602     return s;
603 }
604
605 STATIC char *
606 S_find_next_non_ascii(char * s, const char * send, const bool utf8_target)
607 {
608     /* Returns the position of the first non-ASCII byte in the sequence between
609      * 's' and 'send-1' inclusive; returns 'send' if none found */
610
611 #ifdef EBCDIC
612
613     PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII;
614
615     if (utf8_target) {
616         while (s < send) {
617             if ( ! isASCII(*s)) {
618                 return s;
619             }
620             s += UTF8SKIP(s);
621         }
622     }
623     else {
624         while (s < send) {
625             if ( ! isASCII(*s)) {
626                 return s;
627             }
628             s++;
629         }
630     }
631
632     return s;
633
634 #else
635
636     const U8 * next_non_ascii = NULL;
637
638     PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII;
639     PERL_UNUSED_ARG(utf8_target);
640
641     /* On ASCII platforms invariants and ASCII are identical, so if the string
642      * is entirely invariants, there is no non-ASCII character */
643     return (is_utf8_invariant_string_loc((U8 *) s,
644                                          (STRLEN) (send - s),
645                                          &next_non_ascii))
646             ? (char *) send
647             : (char *) next_non_ascii;
648
649 #endif
650
651 }
652
653 STATIC U8 *
654 S_find_span_end(U8 * s, const U8 * send, const U8 span_byte)
655 {
656     /* Returns the position of the first byte in the sequence between 's' and
657      * 'send-1' inclusive that isn't 'span_byte'; returns 'send' if none found.
658      * */
659
660     PERL_ARGS_ASSERT_FIND_SPAN_END;
661
662     assert(send >= s);
663
664     if ((STRLEN) (send - s) >= PERL_WORDSIZE
665                           + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
666                           - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
667     {
668         PERL_UINTMAX_T span_word;
669
670         /* Process per-byte until reach word boundary.  XXX This loop could be
671          * eliminated if we knew that this platform had fast unaligned reads */
672         while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
673             if (*s != span_byte) {
674                 return s;
675             }
676             s++;
677         }
678
679         /* Create a word filled with the bytes we are spanning */
680         span_word = PERL_COUNT_MULTIPLIER * span_byte;
681
682         /* Process per-word as long as we have at least a full word left */
683         do {
684
685             /* Keep going if the whole word is composed of 'span_byte's */
686             if ((* (PERL_UINTMAX_T *) s) == span_word)  {
687                 s += PERL_WORDSIZE;
688                 continue;
689             }
690
691             /* Here, at least one byte in the word isn't 'span_byte'. */
692
693 #ifdef EBCDIC
694
695             break;
696
697 #else
698
699             /* This xor leaves 1 bits only in those non-matching bytes */
700             span_word ^= * (PERL_UINTMAX_T *) s;
701
702             /* Make sure the upper bit of each non-matching byte is set.  This
703              * makes each such byte look like an ASCII platform variant byte */
704             span_word |= span_word << 1;
705             span_word |= span_word << 2;
706             span_word |= span_word << 4;
707
708             /* That reduces the problem to what this function solves */
709             return s + _variant_byte_number(span_word);
710
711 #endif
712
713         } while (s + PERL_WORDSIZE <= send);
714     }
715
716     /* Process the straggler bytes beyond the final word boundary */
717     while (s < send) {
718         if (*s != span_byte) {
719             return s;
720         }
721         s++;
722     }
723
724     return s;
725 }
726
727 STATIC U8 *
728 S_find_next_masked(U8 * s, const U8 * send, const U8 byte, const U8 mask)
729 {
730     /* Returns the position of the first byte in the sequence between 's'
731      * and 'send-1' inclusive that when ANDed with 'mask' yields 'byte';
732      * returns 'send' if none found.  It uses word-level operations instead of
733      * byte to speed up the process */
734
735     PERL_ARGS_ASSERT_FIND_NEXT_MASKED;
736
737     assert(send >= s);
738     assert((byte & mask) == byte);
739
740 #ifndef EBCDIC
741
742     if ((STRLEN) (send - s) >= PERL_WORDSIZE
743                           + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
744                           - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
745     {
746         PERL_UINTMAX_T word, mask_word;
747
748         while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
749             if (((*s) & mask) == byte) {
750                 return s;
751             }
752             s++;
753         }
754
755         word      = PERL_COUNT_MULTIPLIER * byte;
756         mask_word = PERL_COUNT_MULTIPLIER * mask;
757
758         do {
759             PERL_UINTMAX_T masked = (* (PERL_UINTMAX_T *) s) & mask_word;
760
761             /* If 'masked' contains bytes with the bit pattern of 'byte' within
762              * it, xoring with 'word' will leave each of the 8 bits in such
763              * bytes be 0, and no byte containing any other bit pattern will be
764              * 0. */
765             masked ^= word;
766
767             /* This causes the most significant bit to be set to 1 for any
768              * bytes in the word that aren't completely 0 */
769             masked |= masked << 1;
770             masked |= masked << 2;
771             masked |= masked << 4;
772
773             /* The msbits are the same as what marks a byte as variant, so we
774              * can use this mask.  If all msbits are 1, the word doesn't
775              * contain 'byte' */
776             if ((masked & PERL_VARIANTS_WORD_MASK) == PERL_VARIANTS_WORD_MASK) {
777                 s += PERL_WORDSIZE;
778                 continue;
779             }
780
781             /* Here, the msbit of bytes in the word that aren't 'byte' are 1,
782              * and any that are, are 0.  Complement and re-AND to swap that */
783             masked = ~ masked;
784             masked &= PERL_VARIANTS_WORD_MASK;
785
786             /* This reduces the problem to that solved by this function */
787             s += _variant_byte_number(masked);
788             return s;
789
790         } while (s + PERL_WORDSIZE <= send);
791     }
792
793 #endif
794
795     while (s < send) {
796         if (((*s) & mask) == byte) {
797             return s;
798         }
799         s++;
800     }
801
802     return s;
803 }
804
805 STATIC U8 *
806 S_find_span_end_mask(U8 * s, const U8 * send, const U8 span_byte, const U8 mask)
807 {
808     /* Returns the position of the first byte in the sequence between 's' and
809      * 'send-1' inclusive that when ANDed with 'mask' isn't 'span_byte'.
810      * 'span_byte' should have been ANDed with 'mask' in the call of this
811      * function.  Returns 'send' if none found.  Works like find_span_end(),
812      * except for the AND */
813
814     PERL_ARGS_ASSERT_FIND_SPAN_END_MASK;
815
816     assert(send >= s);
817     assert((span_byte & mask) == span_byte);
818
819     if ((STRLEN) (send - s) >= PERL_WORDSIZE
820                           + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
821                           - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
822     {
823         PERL_UINTMAX_T span_word, mask_word;
824
825         while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
826             if (((*s) & mask) != span_byte) {
827                 return s;
828             }
829             s++;
830         }
831
832         span_word = PERL_COUNT_MULTIPLIER * span_byte;
833         mask_word = PERL_COUNT_MULTIPLIER * mask;
834
835         do {
836             PERL_UINTMAX_T masked = (* (PERL_UINTMAX_T *) s) & mask_word;
837
838             if (masked == span_word) {
839                 s += PERL_WORDSIZE;
840                 continue;
841             }
842
843 #ifdef EBCDIC
844
845             break;
846
847 #else
848
849             masked ^= span_word;
850             masked |= masked << 1;
851             masked |= masked << 2;
852             masked |= masked << 4;
853             return s + _variant_byte_number(masked);
854
855 #endif
856
857         } while (s + PERL_WORDSIZE <= send);
858     }
859
860     while (s < send) {
861         if (((*s) & mask) != span_byte) {
862             return s;
863         }
864         s++;
865     }
866
867     return s;
868 }
869
870 /*
871  * pregexec and friends
872  */
873
874 #ifndef PERL_IN_XSUB_RE
875 /*
876  - pregexec - match a regexp against a string
877  */
878 I32
879 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
880          char *strbeg, SSize_t minend, SV *screamer, U32 nosave)
881 /* stringarg: the point in the string at which to begin matching */
882 /* strend:    pointer to null at end of string */
883 /* strbeg:    real beginning of string */
884 /* minend:    end of match must be >= minend bytes after stringarg. */
885 /* screamer:  SV being matched: only used for utf8 flag, pos() etc; string
886  *            itself is accessed via the pointers above */
887 /* nosave:    For optimizations. */
888 {
889     PERL_ARGS_ASSERT_PREGEXEC;
890
891     return
892         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
893                       nosave ? 0 : REXEC_COPY_STR);
894 }
895 #endif
896
897
898
899 /* re_intuit_start():
900  *
901  * Based on some optimiser hints, try to find the earliest position in the
902  * string where the regex could match.
903  *
904  *   rx:     the regex to match against
905  *   sv:     the SV being matched: only used for utf8 flag; the string
906  *           itself is accessed via the pointers below. Note that on
907  *           something like an overloaded SV, SvPOK(sv) may be false
908  *           and the string pointers may point to something unrelated to
909  *           the SV itself.
910  *   strbeg: real beginning of string
911  *   strpos: the point in the string at which to begin matching
912  *   strend: pointer to the byte following the last char of the string
913  *   flags   currently unused; set to 0
914  *   data:   currently unused; set to NULL
915  *
916  * The basic idea of re_intuit_start() is to use some known information
917  * about the pattern, namely:
918  *
919  *   a) the longest known anchored substring (i.e. one that's at a
920  *      constant offset from the beginning of the pattern; but not
921  *      necessarily at a fixed offset from the beginning of the
922  *      string);
923  *   b) the longest floating substring (i.e. one that's not at a constant
924  *      offset from the beginning of the pattern);
925  *   c) Whether the pattern is anchored to the string; either
926  *      an absolute anchor: /^../, or anchored to \n: /^.../m,
927  *      or anchored to pos(): /\G/;
928  *   d) A start class: a real or synthetic character class which
929  *      represents which characters are legal at the start of the pattern;
930  *
931  * to either quickly reject the match, or to find the earliest position
932  * within the string at which the pattern might match, thus avoiding
933  * running the full NFA engine at those earlier locations, only to
934  * eventually fail and retry further along.
935  *
936  * Returns NULL if the pattern can't match, or returns the address within
937  * the string which is the earliest place the match could occur.
938  *
939  * The longest of the anchored and floating substrings is called 'check'
940  * and is checked first. The other is called 'other' and is checked
941  * second. The 'other' substring may not be present.  For example,
942  *
943  *    /(abc|xyz)ABC\d{0,3}DEFG/
944  *
945  * will have
946  *
947  *   check substr (float)    = "DEFG", offset 6..9 chars
948  *   other substr (anchored) = "ABC",  offset 3..3 chars
949  *   stclass = [ax]
950  *
951  * Be aware that during the course of this function, sometimes 'anchored'
952  * refers to a substring being anchored relative to the start of the
953  * pattern, and sometimes to the pattern itself being anchored relative to
954  * the string. For example:
955  *
956  *   /\dabc/:   "abc" is anchored to the pattern;
957  *   /^\dabc/:  "abc" is anchored to the pattern and the string;
958  *   /\d+abc/:  "abc" is anchored to neither the pattern nor the string;
959  *   /^\d+abc/: "abc" is anchored to neither the pattern nor the string,
960  *                    but the pattern is anchored to the string.
961  */
962
963 char *
964 Perl_re_intuit_start(pTHX_
965                     REGEXP * const rx,
966                     SV *sv,
967                     const char * const strbeg,
968                     char *strpos,
969                     char *strend,
970                     const U32 flags,
971                     re_scream_pos_data *data)
972 {
973     struct regexp *const prog = ReANY(rx);
974     SSize_t start_shift = prog->check_offset_min;
975     /* Should be nonnegative! */
976     SSize_t end_shift   = 0;
977     /* current lowest pos in string where the regex can start matching */
978     char *rx_origin = strpos;
979     SV *check;
980     const bool utf8_target = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
981     U8   other_ix = 1 - prog->substrs->check_ix;
982     bool ml_anch = 0;
983     char *other_last = strpos;/* latest pos 'other' substr already checked to */
984     char *check_at = NULL;              /* check substr found at this pos */
985     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
986     RXi_GET_DECL(prog,progi);
987     regmatch_info reginfo_buf;  /* create some info to pass to find_byclass */
988     regmatch_info *const reginfo = &reginfo_buf;
989     GET_RE_DEBUG_FLAGS_DECL;
990
991     PERL_ARGS_ASSERT_RE_INTUIT_START;
992     PERL_UNUSED_ARG(flags);
993     PERL_UNUSED_ARG(data);
994
995     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
996                 "Intuit: trying to determine minimum start position...\n"));
997
998     /* for now, assume that all substr offsets are positive. If at some point
999      * in the future someone wants to do clever things with lookbehind and
1000      * -ve offsets, they'll need to fix up any code in this function
1001      * which uses these offsets. See the thread beginning
1002      * <20140113145929.GF27210@iabyn.com>
1003      */
1004     assert(prog->substrs->data[0].min_offset >= 0);
1005     assert(prog->substrs->data[0].max_offset >= 0);
1006     assert(prog->substrs->data[1].min_offset >= 0);
1007     assert(prog->substrs->data[1].max_offset >= 0);
1008     assert(prog->substrs->data[2].min_offset >= 0);
1009     assert(prog->substrs->data[2].max_offset >= 0);
1010
1011     /* for now, assume that if both present, that the floating substring
1012      * doesn't start before the anchored substring.
1013      * If you break this assumption (e.g. doing better optimisations
1014      * with lookahead/behind), then you'll need to audit the code in this
1015      * function carefully first
1016      */
1017     assert(
1018             ! (  (prog->anchored_utf8 || prog->anchored_substr)
1019               && (prog->float_utf8    || prog->float_substr))
1020            || (prog->float_min_offset >= prog->anchored_offset));
1021
1022     /* byte rather than char calculation for efficiency. It fails
1023      * to quickly reject some cases that can't match, but will reject
1024      * them later after doing full char arithmetic */
1025     if (prog->minlen > strend - strpos) {
1026         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1027                               "  String too short...\n"));
1028         goto fail;
1029     }
1030
1031     RXp_MATCH_UTF8_set(prog, utf8_target);
1032     reginfo->is_utf8_target = cBOOL(utf8_target);
1033     reginfo->info_aux = NULL;
1034     reginfo->strbeg = strbeg;
1035     reginfo->strend = strend;
1036     reginfo->is_utf8_pat = cBOOL(RX_UTF8(rx));
1037     reginfo->intuit = 1;
1038     /* not actually used within intuit, but zero for safety anyway */
1039     reginfo->poscache_maxiter = 0;
1040
1041     if (utf8_target) {
1042         if ((!prog->anchored_utf8 && prog->anchored_substr)
1043                 || (!prog->float_utf8 && prog->float_substr))
1044             to_utf8_substr(prog);
1045         check = prog->check_utf8;
1046     } else {
1047         if (!prog->check_substr && prog->check_utf8) {
1048             if (! to_byte_substr(prog)) {
1049                 NON_UTF8_TARGET_BUT_UTF8_REQUIRED(fail);
1050             }
1051         }
1052         check = prog->check_substr;
1053     }
1054
1055     /* dump the various substring data */
1056     DEBUG_OPTIMISE_MORE_r({
1057         int i;
1058         for (i=0; i<=2; i++) {
1059             SV *sv = (utf8_target ? prog->substrs->data[i].utf8_substr
1060                                   : prog->substrs->data[i].substr);
1061             if (!sv)
1062                 continue;
1063
1064             Perl_re_printf( aTHX_
1065                 "  substrs[%d]: min=%" IVdf " max=%" IVdf " end shift=%" IVdf
1066                 " useful=%" IVdf " utf8=%d [%s]\n",
1067                 i,
1068                 (IV)prog->substrs->data[i].min_offset,
1069                 (IV)prog->substrs->data[i].max_offset,
1070                 (IV)prog->substrs->data[i].end_shift,
1071                 BmUSEFUL(sv),
1072                 utf8_target ? 1 : 0,
1073                 SvPEEK(sv));
1074         }
1075     });
1076
1077     if (prog->intflags & PREGf_ANCH) { /* Match at \G, beg-of-str or after \n */
1078
1079         /* ml_anch: check after \n?
1080          *
1081          * A note about PREGf_IMPLICIT: on an un-anchored pattern beginning
1082          * with /.*.../, these flags will have been added by the
1083          * compiler:
1084          *   /.*abc/, /.*abc/m:  PREGf_IMPLICIT | PREGf_ANCH_MBOL
1085          *   /.*abc/s:           PREGf_IMPLICIT | PREGf_ANCH_SBOL
1086          */
1087         ml_anch =      (prog->intflags & PREGf_ANCH_MBOL)
1088                    && !(prog->intflags & PREGf_IMPLICIT);
1089
1090         if (!ml_anch && !(prog->intflags & PREGf_IMPLICIT)) {
1091             /* we are only allowed to match at BOS or \G */
1092
1093             /* trivially reject if there's a BOS anchor and we're not at BOS.
1094              *
1095              * Note that we don't try to do a similar quick reject for
1096              * \G, since generally the caller will have calculated strpos
1097              * based on pos() and gofs, so the string is already correctly
1098              * anchored by definition; and handling the exceptions would
1099              * be too fiddly (e.g. REXEC_IGNOREPOS).
1100              */
1101             if (   strpos != strbeg
1102                 && (prog->intflags & PREGf_ANCH_SBOL))
1103             {
1104                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1105                                 "  Not at start...\n"));
1106                 goto fail;
1107             }
1108
1109             /* in the presence of an anchor, the anchored (relative to the
1110              * start of the regex) substr must also be anchored relative
1111              * to strpos. So quickly reject if substr isn't found there.
1112              * This works for \G too, because the caller will already have
1113              * subtracted gofs from pos, and gofs is the offset from the
1114              * \G to the start of the regex. For example, in /.abc\Gdef/,
1115              * where substr="abcdef", pos()=3, gofs=4, offset_min=1:
1116              * caller will have set strpos=pos()-4; we look for the substr
1117              * at position pos()-4+1, which lines up with the "a" */
1118
1119             if (prog->check_offset_min == prog->check_offset_max) {
1120                 /* Substring at constant offset from beg-of-str... */
1121                 SSize_t slen = SvCUR(check);
1122                 char *s = HOP3c(strpos, prog->check_offset_min, strend);
1123             
1124                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1125                     "  Looking for check substr at fixed offset %" IVdf "...\n",
1126                     (IV)prog->check_offset_min));
1127
1128                 if (SvTAIL(check)) {
1129                     /* In this case, the regex is anchored at the end too.
1130                      * Unless it's a multiline match, the lengths must match
1131                      * exactly, give or take a \n.  NB: slen >= 1 since
1132                      * the last char of check is \n */
1133                     if (!multiline
1134                         && (   strend - s > slen
1135                             || strend - s < slen - 1
1136                             || (strend - s == slen && strend[-1] != '\n')))
1137                     {
1138                         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1139                                             "  String too long...\n"));
1140                         goto fail_finish;
1141                     }
1142                     /* Now should match s[0..slen-2] */
1143                     slen--;
1144                 }
1145                 if (slen && (strend - s < slen
1146                     || *SvPVX_const(check) != *s
1147                     || (slen > 1 && (memNE(SvPVX_const(check), s, slen)))))
1148                 {
1149                     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1150                                     "  String not equal...\n"));
1151                     goto fail_finish;
1152                 }
1153
1154                 check_at = s;
1155                 goto success_at_start;
1156             }
1157         }
1158     }
1159
1160     end_shift = prog->check_end_shift;
1161
1162 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
1163     if (end_shift < 0)
1164         Perl_croak(aTHX_ "panic: end_shift: %" IVdf " pattern:\n%s\n ",
1165                    (IV)end_shift, RX_PRECOMP(rx));
1166 #endif
1167
1168   restart:
1169     
1170     /* This is the (re)entry point of the main loop in this function.
1171      * The goal of this loop is to:
1172      * 1) find the "check" substring in the region rx_origin..strend
1173      *    (adjusted by start_shift / end_shift). If not found, reject
1174      *    immediately.
1175      * 2) If it exists, look for the "other" substr too if defined; for
1176      *    example, if the check substr maps to the anchored substr, then
1177      *    check the floating substr, and vice-versa. If not found, go
1178      *    back to (1) with rx_origin suitably incremented.
1179      * 3) If we find an rx_origin position that doesn't contradict
1180      *    either of the substrings, then check the possible additional
1181      *    constraints on rx_origin of /^.../m or a known start class.
1182      *    If these fail, then depending on which constraints fail, jump
1183      *    back to here, or to various other re-entry points further along
1184      *    that skip some of the first steps.
1185      * 4) If we pass all those tests, update the BmUSEFUL() count on the
1186      *    substring. If the start position was determined to be at the
1187      *    beginning of the string  - so, not rejected, but not optimised,
1188      *    since we have to run regmatch from position 0 - decrement the
1189      *    BmUSEFUL() count. Otherwise increment it.
1190      */
1191
1192
1193     /* first, look for the 'check' substring */
1194
1195     {
1196         U8* start_point;
1197         U8* end_point;
1198
1199         DEBUG_OPTIMISE_MORE_r({
1200             Perl_re_printf( aTHX_
1201                 "  At restart: rx_origin=%" IVdf " Check offset min: %" IVdf
1202                 " Start shift: %" IVdf " End shift %" IVdf
1203                 " Real end Shift: %" IVdf "\n",
1204                 (IV)(rx_origin - strbeg),
1205                 (IV)prog->check_offset_min,
1206                 (IV)start_shift,
1207                 (IV)end_shift,
1208                 (IV)prog->check_end_shift);
1209         });
1210         
1211         end_point = HOPBACK3(strend, end_shift, rx_origin);
1212         if (!end_point)
1213             goto fail_finish;
1214         start_point = HOPMAYBE3(rx_origin, start_shift, end_point);
1215         if (!start_point)
1216             goto fail_finish;
1217
1218
1219         /* If the regex is absolutely anchored to either the start of the
1220          * string (SBOL) or to pos() (ANCH_GPOS), then
1221          * check_offset_max represents an upper bound on the string where
1222          * the substr could start. For the ANCH_GPOS case, we assume that
1223          * the caller of intuit will have already set strpos to
1224          * pos()-gofs, so in this case strpos + offset_max will still be
1225          * an upper bound on the substr.
1226          */
1227         if (!ml_anch
1228             && prog->intflags & PREGf_ANCH
1229             && prog->check_offset_max != SSize_t_MAX)
1230         {
1231             SSize_t check_len = SvCUR(check) - !!SvTAIL(check);
1232             const char * const anchor =
1233                         (prog->intflags & PREGf_ANCH_GPOS ? strpos : strbeg);
1234             SSize_t targ_len = (char*)end_point - anchor;
1235
1236             if (check_len > targ_len) {
1237                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1238                               "Target string too short to match required substring...\n"));
1239                 goto fail_finish;
1240             }
1241
1242             /* do a bytes rather than chars comparison. It's conservative;
1243              * so it skips doing the HOP if the result can't possibly end
1244              * up earlier than the old value of end_point.
1245              */
1246             assert(anchor + check_len <= (char *)end_point);
1247             if (prog->check_offset_max + check_len < targ_len) {
1248                 end_point = HOP3lim((U8*)anchor,
1249                                 prog->check_offset_max,
1250                                 end_point - check_len
1251                             )
1252                             + check_len;
1253                 if (end_point < start_point)
1254                     goto fail_finish;
1255             }
1256         }
1257
1258         check_at = fbm_instr( start_point, end_point,
1259                       check, multiline ? FBMrf_MULTILINE : 0);
1260
1261         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1262             "  doing 'check' fbm scan, [%" IVdf "..%" IVdf "] gave %" IVdf "\n",
1263             (IV)((char*)start_point - strbeg),
1264             (IV)((char*)end_point   - strbeg),
1265             (IV)(check_at ? check_at - strbeg : -1)
1266         ));
1267
1268         /* Update the count-of-usability, remove useless subpatterns,
1269             unshift s.  */
1270
1271         DEBUG_EXECUTE_r({
1272             RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
1273                 SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
1274             Perl_re_printf( aTHX_  "  %s %s substr %s%s%s",
1275                               (check_at ? "Found" : "Did not find"),
1276                 (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
1277                     ? "anchored" : "floating"),
1278                 quoted,
1279                 RE_SV_TAIL(check),
1280                 (check_at ? " at offset " : "...\n") );
1281         });
1282
1283         if (!check_at)
1284             goto fail_finish;
1285         /* set rx_origin to the minimum position where the regex could start
1286          * matching, given the constraint of the just-matched check substring.
1287          * But don't set it lower than previously.
1288          */
1289
1290         if (check_at - rx_origin > prog->check_offset_max)
1291             rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
1292         /* Finish the diagnostic message */
1293         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1294             "%ld (rx_origin now %" IVdf ")...\n",
1295             (long)(check_at - strbeg),
1296             (IV)(rx_origin - strbeg)
1297         ));
1298     }
1299
1300
1301     /* now look for the 'other' substring if defined */
1302
1303     if (utf8_target ? prog->substrs->data[other_ix].utf8_substr
1304                     : prog->substrs->data[other_ix].substr)
1305     {
1306         /* Take into account the "other" substring. */
1307         char *last, *last1;
1308         char *s;
1309         SV* must;
1310         struct reg_substr_datum *other;
1311
1312       do_other_substr:
1313         other = &prog->substrs->data[other_ix];
1314
1315         /* if "other" is anchored:
1316          * we've previously found a floating substr starting at check_at.
1317          * This means that the regex origin must lie somewhere
1318          * between min (rx_origin): HOP3(check_at, -check_offset_max)
1319          * and max:                 HOP3(check_at, -check_offset_min)
1320          * (except that min will be >= strpos)
1321          * So the fixed  substr must lie somewhere between
1322          *  HOP3(min, anchored_offset)
1323          *  HOP3(max, anchored_offset) + SvCUR(substr)
1324          */
1325
1326         /* if "other" is floating
1327          * Calculate last1, the absolute latest point where the
1328          * floating substr could start in the string, ignoring any
1329          * constraints from the earlier fixed match. It is calculated
1330          * as follows:
1331          *
1332          * strend - prog->minlen (in chars) is the absolute latest
1333          * position within the string where the origin of the regex
1334          * could appear. The latest start point for the floating
1335          * substr is float_min_offset(*) on from the start of the
1336          * regex.  last1 simply combines thee two offsets.
1337          *
1338          * (*) You might think the latest start point should be
1339          * float_max_offset from the regex origin, and technically
1340          * you'd be correct. However, consider
1341          *    /a\d{2,4}bcd\w/
1342          * Here, float min, max are 3,5 and minlen is 7.
1343          * This can match either
1344          *    /a\d\dbcd\w/
1345          *    /a\d\d\dbcd\w/
1346          *    /a\d\d\d\dbcd\w/
1347          * In the first case, the regex matches minlen chars; in the
1348          * second, minlen+1, in the third, minlen+2.
1349          * In the first case, the floating offset is 3 (which equals
1350          * float_min), in the second, 4, and in the third, 5 (which
1351          * equals float_max). In all cases, the floating string bcd
1352          * can never start more than 4 chars from the end of the
1353          * string, which equals minlen - float_min. As the substring
1354          * starts to match more than float_min from the start of the
1355          * regex, it makes the regex match more than minlen chars,
1356          * and the two cancel each other out. So we can always use
1357          * float_min - minlen, rather than float_max - minlen for the
1358          * latest position in the string.
1359          *
1360          * Note that -minlen + float_min_offset is equivalent (AFAIKT)
1361          * to CHR_SVLEN(must) - !!SvTAIL(must) + prog->float_end_shift
1362          */
1363
1364         assert(prog->minlen >= other->min_offset);
1365         last1 = HOP3c(strend,
1366                         other->min_offset - prog->minlen, strbeg);
1367
1368         if (other_ix) {/* i.e. if (other-is-float) */
1369             /* last is the latest point where the floating substr could
1370              * start, *given* any constraints from the earlier fixed
1371              * match. This constraint is that the floating string starts
1372              * <= float_max_offset chars from the regex origin (rx_origin).
1373              * If this value is less than last1, use it instead.
1374              */
1375             assert(rx_origin <= last1);
1376             last =
1377                 /* this condition handles the offset==infinity case, and
1378                  * is a short-cut otherwise. Although it's comparing a
1379                  * byte offset to a char length, it does so in a safe way,
1380                  * since 1 char always occupies 1 or more bytes,
1381                  * so if a string range is  (last1 - rx_origin) bytes,
1382                  * it will be less than or equal to  (last1 - rx_origin)
1383                  * chars; meaning it errs towards doing the accurate HOP3
1384                  * rather than just using last1 as a short-cut */
1385                 (last1 - rx_origin) < other->max_offset
1386                     ? last1
1387                     : (char*)HOP3lim(rx_origin, other->max_offset, last1);
1388         }
1389         else {
1390             assert(strpos + start_shift <= check_at);
1391             last = HOP4c(check_at, other->min_offset - start_shift,
1392                         strbeg, strend);
1393         }
1394
1395         s = HOP3c(rx_origin, other->min_offset, strend);
1396         if (s < other_last)     /* These positions already checked */
1397             s = other_last;
1398
1399         must = utf8_target ? other->utf8_substr : other->substr;
1400         assert(SvPOK(must));
1401         {
1402             char *from = s;
1403             char *to   = last + SvCUR(must) - (SvTAIL(must)!=0);
1404
1405             if (to > strend)
1406                 to = strend;
1407             if (from > to) {
1408                 s = NULL;
1409                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1410                     "  skipping 'other' fbm scan: %" IVdf " > %" IVdf "\n",
1411                     (IV)(from - strbeg),
1412                     (IV)(to   - strbeg)
1413                 ));
1414             }
1415             else {
1416                 s = fbm_instr(
1417                     (unsigned char*)from,
1418                     (unsigned char*)to,
1419                     must,
1420                     multiline ? FBMrf_MULTILINE : 0
1421                 );
1422                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1423                     "  doing 'other' fbm scan, [%" IVdf "..%" IVdf "] gave %" IVdf "\n",
1424                     (IV)(from - strbeg),
1425                     (IV)(to   - strbeg),
1426                     (IV)(s ? s - strbeg : -1)
1427                 ));
1428             }
1429         }
1430
1431         DEBUG_EXECUTE_r({
1432             RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
1433                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
1434             Perl_re_printf( aTHX_  "  %s %s substr %s%s",
1435                 s ? "Found" : "Contradicts",
1436                 other_ix ? "floating" : "anchored",
1437                 quoted, RE_SV_TAIL(must));
1438         });
1439
1440
1441         if (!s) {
1442             /* last1 is latest possible substr location. If we didn't
1443              * find it before there, we never will */
1444             if (last >= last1) {
1445                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1446                                         "; giving up...\n"));
1447                 goto fail_finish;
1448             }
1449
1450             /* try to find the check substr again at a later
1451              * position. Maybe next time we'll find the "other" substr
1452              * in range too */
1453             other_last = HOP3c(last, 1, strend) /* highest failure */;
1454             rx_origin =
1455                 other_ix /* i.e. if other-is-float */
1456                     ? HOP3c(rx_origin, 1, strend)
1457                     : HOP4c(last, 1 - other->min_offset, strbeg, strend);
1458             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1459                 "; about to retry %s at offset %ld (rx_origin now %" IVdf ")...\n",
1460                 (other_ix ? "floating" : "anchored"),
1461                 (long)(HOP3c(check_at, 1, strend) - strbeg),
1462                 (IV)(rx_origin - strbeg)
1463             ));
1464             goto restart;
1465         }
1466         else {
1467             if (other_ix) { /* if (other-is-float) */
1468                 /* other_last is set to s, not s+1, since its possible for
1469                  * a floating substr to fail first time, then succeed
1470                  * second time at the same floating position; e.g.:
1471                  *     "-AB--AABZ" =~ /\wAB\d*Z/
1472                  * The first time round, anchored and float match at
1473                  * "-(AB)--AAB(Z)" then fail on the initial \w character
1474                  * class. Second time round, they match at "-AB--A(AB)(Z)".
1475                  */
1476                 other_last = s;
1477             }
1478             else {
1479                 rx_origin = HOP3c(s, -other->min_offset, strbeg);
1480                 other_last = HOP3c(s, 1, strend);
1481             }
1482             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1483                 " at offset %ld (rx_origin now %" IVdf ")...\n",
1484                   (long)(s - strbeg),
1485                 (IV)(rx_origin - strbeg)
1486               ));
1487
1488         }
1489     }
1490     else {
1491         DEBUG_OPTIMISE_MORE_r(
1492             Perl_re_printf( aTHX_
1493                 "  Check-only match: offset min:%" IVdf " max:%" IVdf
1494                 " check_at:%" IVdf " rx_origin:%" IVdf " rx_origin-check_at:%" IVdf
1495                 " strend:%" IVdf "\n",
1496                 (IV)prog->check_offset_min,
1497                 (IV)prog->check_offset_max,
1498                 (IV)(check_at-strbeg),
1499                 (IV)(rx_origin-strbeg),
1500                 (IV)(rx_origin-check_at),
1501                 (IV)(strend-strbeg)
1502             )
1503         );
1504     }
1505
1506   postprocess_substr_matches:
1507
1508     /* handle the extra constraint of /^.../m if present */
1509
1510     if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n') {
1511         char *s;
1512
1513         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1514                         "  looking for /^/m anchor"));
1515
1516         /* we have failed the constraint of a \n before rx_origin.
1517          * Find the next \n, if any, even if it's beyond the current
1518          * anchored and/or floating substrings. Whether we should be
1519          * scanning ahead for the next \n or the next substr is debatable.
1520          * On the one hand you'd expect rare substrings to appear less
1521          * often than \n's. On the other hand, searching for \n means
1522          * we're effectively flipping between check_substr and "\n" on each
1523          * iteration as the current "rarest" string candidate, which
1524          * means for example that we'll quickly reject the whole string if
1525          * hasn't got a \n, rather than trying every substr position
1526          * first
1527          */
1528
1529         s = HOP3c(strend, - prog->minlen, strpos);
1530         if (s <= rx_origin ||
1531             ! ( rx_origin = (char *)memchr(rx_origin, '\n', s - rx_origin)))
1532         {
1533             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1534                             "  Did not find /%s^%s/m...\n",
1535                             PL_colors[0], PL_colors[1]));
1536             goto fail_finish;
1537         }
1538
1539         /* earliest possible origin is 1 char after the \n.
1540          * (since *rx_origin == '\n', it's safe to ++ here rather than
1541          * HOP(rx_origin, 1)) */
1542         rx_origin++;
1543
1544         if (prog->substrs->check_ix == 0  /* check is anchored */
1545             || rx_origin >= HOP3c(check_at,  - prog->check_offset_min, strpos))
1546         {
1547             /* Position contradicts check-string; either because
1548              * check was anchored (and thus has no wiggle room),
1549              * or check was float and rx_origin is above the float range */
1550             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1551                 "  Found /%s^%s/m, about to restart lookup for check-string with rx_origin %ld...\n",
1552                 PL_colors[0], PL_colors[1], (long)(rx_origin - strbeg)));
1553             goto restart;
1554         }
1555
1556         /* if we get here, the check substr must have been float,
1557          * is in range, and we may or may not have had an anchored
1558          * "other" substr which still contradicts */
1559         assert(prog->substrs->check_ix); /* check is float */
1560
1561         if (utf8_target ? prog->anchored_utf8 : prog->anchored_substr) {
1562             /* whoops, the anchored "other" substr exists, so we still
1563              * contradict. On the other hand, the float "check" substr
1564              * didn't contradict, so just retry the anchored "other"
1565              * substr */
1566             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1567                 "  Found /%s^%s/m, rescanning for anchored from offset %" IVdf " (rx_origin now %" IVdf ")...\n",
1568                 PL_colors[0], PL_colors[1],
1569                 (IV)(rx_origin - strbeg + prog->anchored_offset),
1570                 (IV)(rx_origin - strbeg)
1571             ));
1572             goto do_other_substr;
1573         }
1574
1575         /* success: we don't contradict the found floating substring
1576          * (and there's no anchored substr). */
1577         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1578             "  Found /%s^%s/m with rx_origin %ld...\n",
1579             PL_colors[0], PL_colors[1], (long)(rx_origin - strbeg)));
1580     }
1581     else {
1582         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1583             "  (multiline anchor test skipped)\n"));
1584     }
1585
1586   success_at_start:
1587
1588
1589     /* if we have a starting character class, then test that extra constraint.
1590      * (trie stclasses are too expensive to use here, we are better off to
1591      * leave it to regmatch itself) */
1592
1593     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
1594         const U8* const str = (U8*)STRING(progi->regstclass);
1595
1596         /* XXX this value could be pre-computed */
1597         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
1598                     ?  (reginfo->is_utf8_pat
1599                         ? utf8_distance(str + STR_LEN(progi->regstclass), str)
1600                         : STR_LEN(progi->regstclass))
1601                     : 1);
1602         char * endpos;
1603         char *s;
1604         /* latest pos that a matching float substr constrains rx start to */
1605         char *rx_max_float = NULL;
1606
1607         /* if the current rx_origin is anchored, either by satisfying an
1608          * anchored substring constraint, or a /^.../m constraint, then we
1609          * can reject the current origin if the start class isn't found
1610          * at the current position. If we have a float-only match, then
1611          * rx_origin is constrained to a range; so look for the start class
1612          * in that range. if neither, then look for the start class in the
1613          * whole rest of the string */
1614
1615         /* XXX DAPM it's not clear what the minlen test is for, and why
1616          * it's not used in the floating case. Nothing in the test suite
1617          * causes minlen == 0 here. See <20140313134639.GS12844@iabyn.com>.
1618          * Here are some old comments, which may or may not be correct:
1619          *
1620          *   minlen == 0 is possible if regstclass is \b or \B,
1621          *   and the fixed substr is ''$.
1622          *   Since minlen is already taken into account, rx_origin+1 is
1623          *   before strend; accidentally, minlen >= 1 guaranties no false
1624          *   positives at rx_origin + 1 even for \b or \B.  But (minlen? 1 :
1625          *   0) below assumes that regstclass does not come from lookahead...
1626          *   If regstclass takes bytelength more than 1: If charlength==1, OK.
1627          *   This leaves EXACTF-ish only, which are dealt with in
1628          *   find_byclass().
1629          */
1630
1631         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
1632             endpos = HOP3clim(rx_origin, (prog->minlen ? cl_l : 0), strend);
1633         else if (prog->float_substr || prog->float_utf8) {
1634             rx_max_float = HOP3c(check_at, -start_shift, strbeg);
1635             endpos = HOP3clim(rx_max_float, cl_l, strend);
1636         }
1637         else 
1638             endpos= strend;
1639                     
1640         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1641             "  looking for class: start_shift: %" IVdf " check_at: %" IVdf
1642             " rx_origin: %" IVdf " endpos: %" IVdf "\n",
1643               (IV)start_shift, (IV)(check_at - strbeg),
1644               (IV)(rx_origin - strbeg), (IV)(endpos - strbeg)));
1645
1646         s = find_byclass(prog, progi->regstclass, rx_origin, endpos,
1647                             reginfo);
1648         if (!s) {
1649             if (endpos == strend) {
1650                 DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1651                                 "  Could not match STCLASS...\n") );
1652                 goto fail;
1653             }
1654             DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1655                                "  This position contradicts STCLASS...\n") );
1656             if ((prog->intflags & PREGf_ANCH) && !ml_anch
1657                         && !(prog->intflags & PREGf_IMPLICIT))
1658                 goto fail;
1659
1660             /* Contradict one of substrings */
1661             if (prog->anchored_substr || prog->anchored_utf8) {
1662                 if (prog->substrs->check_ix == 1) { /* check is float */
1663                     /* Have both, check_string is floating */
1664                     assert(rx_origin + start_shift <= check_at);
1665                     if (rx_origin + start_shift != check_at) {
1666                         /* not at latest position float substr could match:
1667                          * Recheck anchored substring, but not floating.
1668                          * The condition above is in bytes rather than
1669                          * chars for efficiency. It's conservative, in
1670                          * that it errs on the side of doing 'goto
1671                          * do_other_substr'. In this case, at worst,
1672                          * an extra anchored search may get done, but in
1673                          * practice the extra fbm_instr() is likely to
1674                          * get skipped anyway. */
1675                         DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1676                             "  about to retry anchored at offset %ld (rx_origin now %" IVdf ")...\n",
1677                             (long)(other_last - strbeg),
1678                             (IV)(rx_origin - strbeg)
1679                         ));
1680                         goto do_other_substr;
1681                     }
1682                 }
1683             }
1684             else {
1685                 /* float-only */
1686
1687                 if (ml_anch) {
1688                     /* In the presence of ml_anch, we might be able to
1689                      * find another \n without breaking the current float
1690                      * constraint. */
1691
1692                     /* strictly speaking this should be HOP3c(..., 1, ...),
1693                      * but since we goto a block of code that's going to
1694                      * search for the next \n if any, its safe here */
1695                     rx_origin++;
1696                     DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1697                               "  about to look for /%s^%s/m starting at rx_origin %ld...\n",
1698                               PL_colors[0], PL_colors[1],
1699                               (long)(rx_origin - strbeg)) );
1700                     goto postprocess_substr_matches;
1701                 }
1702
1703                 /* strictly speaking this can never be true; but might
1704                  * be if we ever allow intuit without substrings */
1705                 if (!(utf8_target ? prog->float_utf8 : prog->float_substr))
1706                     goto fail;
1707
1708                 rx_origin = rx_max_float;
1709             }
1710
1711             /* at this point, any matching substrings have been
1712              * contradicted. Start again... */
1713
1714             rx_origin = HOP3c(rx_origin, 1, strend);
1715
1716             /* uses bytes rather than char calculations for efficiency.
1717              * It's conservative: it errs on the side of doing 'goto restart',
1718              * where there is code that does a proper char-based test */
1719             if (rx_origin + start_shift + end_shift > strend) {
1720                 DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1721                                        "  Could not match STCLASS...\n") );
1722                 goto fail;
1723             }
1724             DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
1725                 "  about to look for %s substr starting at offset %ld (rx_origin now %" IVdf ")...\n",
1726                 (prog->substrs->check_ix ? "floating" : "anchored"),
1727                 (long)(rx_origin + start_shift - strbeg),
1728                 (IV)(rx_origin - strbeg)
1729             ));
1730             goto restart;
1731         }
1732
1733         /* Success !!! */
1734
1735         if (rx_origin != s) {
1736             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1737                         "  By STCLASS: moving %ld --> %ld\n",
1738                                   (long)(rx_origin - strbeg), (long)(s - strbeg))
1739                    );
1740         }
1741         else {
1742             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1743                                   "  Does not contradict STCLASS...\n");
1744                    );
1745         }
1746     }
1747
1748     /* Decide whether using the substrings helped */
1749
1750     if (rx_origin != strpos) {
1751         /* Fixed substring is found far enough so that the match
1752            cannot start at strpos. */
1753
1754         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "  try at offset...\n"));
1755         ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr);        /* hooray/5 */
1756     }
1757     else {
1758         /* The found rx_origin position does not prohibit matching at
1759          * strpos, so calling intuit didn't gain us anything. Decrement
1760          * the BmUSEFUL() count on the check substring, and if we reach
1761          * zero, free it.  */
1762         if (!(prog->intflags & PREGf_NAUGHTY)
1763             && (utf8_target ? (
1764                 prog->check_utf8                /* Could be deleted already */
1765                 && --BmUSEFUL(prog->check_utf8) < 0
1766                 && (prog->check_utf8 == prog->float_utf8)
1767             ) : (
1768                 prog->check_substr              /* Could be deleted already */
1769                 && --BmUSEFUL(prog->check_substr) < 0
1770                 && (prog->check_substr == prog->float_substr)
1771             )))
1772         {
1773             /* If flags & SOMETHING - do not do it many times on the same match */
1774             DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "  ... Disabling check substring...\n"));
1775             /* XXX Does the destruction order has to change with utf8_target? */
1776             SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
1777             SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
1778             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
1779             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
1780             check = NULL;                       /* abort */
1781             /* XXXX This is a remnant of the old implementation.  It
1782                     looks wasteful, since now INTUIT can use many
1783                     other heuristics. */
1784             prog->extflags &= ~RXf_USE_INTUIT;
1785         }
1786     }
1787
1788     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
1789             "Intuit: %sSuccessfully guessed:%s match at offset %ld\n",
1790              PL_colors[4], PL_colors[5], (long)(rx_origin - strbeg)) );
1791
1792     return rx_origin;
1793
1794   fail_finish:                          /* Substring not found */
1795     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
1796         BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
1797   fail:
1798     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "%sMatch rejected by optimizer%s\n",
1799                           PL_colors[4], PL_colors[5]));
1800     return NULL;
1801 }
1802
1803
1804 #define DECL_TRIE_TYPE(scan) \
1805     const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold,       \
1806                  trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold,              \
1807                  trie_utf8l, trie_flu8, trie_flu8_latin }                           \
1808                     trie_type = ((scan->flags == EXACT)                             \
1809                                  ? (utf8_target ? trie_utf8 : trie_plain)           \
1810                                  : (scan->flags == EXACTL)                          \
1811                                     ? (utf8_target ? trie_utf8l : trie_plain)       \
1812                                     : (scan->flags == EXACTFAA)                     \
1813                                       ? (utf8_target                                \
1814                                          ? trie_utf8_exactfa_fold                   \
1815                                          : trie_latin_utf8_exactfa_fold)            \
1816                                       : (scan->flags == EXACTFLU8                   \
1817                                          ? (utf8_target                             \
1818                                            ? trie_flu8                              \
1819                                            : trie_flu8_latin)                       \
1820                                          : (utf8_target                             \
1821                                            ? trie_utf8_fold                         \
1822                                            : trie_latin_utf8_fold)))
1823
1824 /* 'uscan' is set to foldbuf, and incremented, so below the end of uscan is
1825  * 'foldbuf+sizeof(foldbuf)' */
1826 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uc_end, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \
1827 STMT_START {                                                                        \
1828     STRLEN skiplen;                                                                 \
1829     U8 flags = FOLD_FLAGS_FULL;                                                     \
1830     switch (trie_type) {                                                            \
1831     case trie_flu8:                                                                 \
1832         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;                                         \
1833         if (UTF8_IS_ABOVE_LATIN1(*uc)) {                                            \
1834             _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc_end);                     \
1835         }                                                                           \
1836         goto do_trie_utf8_fold;                                                     \
1837     case trie_utf8_exactfa_fold:                                                    \
1838         flags |= FOLD_FLAGS_NOMIX_ASCII;                                            \
1839         /* FALLTHROUGH */                                                           \
1840     case trie_utf8_fold:                                                            \
1841       do_trie_utf8_fold:                                                            \
1842         if ( foldlen>0 ) {                                                          \
1843             uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags );     \
1844             foldlen -= len;                                                         \
1845             uscan += len;                                                           \
1846             len=0;                                                                  \
1847         } else {                                                                    \
1848             uvc = _toFOLD_utf8_flags( (const U8*) uc, uc_end, foldbuf, &foldlen,    \
1849                                                                             flags); \
1850             len = UTF8SKIP(uc);                                                     \
1851             skiplen = UVCHR_SKIP( uvc );                                            \
1852             foldlen -= skiplen;                                                     \
1853             uscan = foldbuf + skiplen;                                              \
1854         }                                                                           \
1855         break;                                                                      \
1856     case trie_flu8_latin:                                                           \
1857         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;                                         \
1858         goto do_trie_latin_utf8_fold;                                               \
1859     case trie_latin_utf8_exactfa_fold:                                              \
1860         flags |= FOLD_FLAGS_NOMIX_ASCII;                                            \
1861         /* FALLTHROUGH */                                                           \
1862     case trie_latin_utf8_fold:                                                      \
1863       do_trie_latin_utf8_fold:                                                      \
1864         if ( foldlen>0 ) {                                                          \
1865             uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags );     \
1866             foldlen -= len;                                                         \
1867             uscan += len;                                                           \
1868             len=0;                                                                  \
1869         } else {                                                                    \
1870             len = 1;                                                                \
1871             uvc = _to_fold_latin1( (U8) *uc, foldbuf, &foldlen, flags);             \
1872             skiplen = UVCHR_SKIP( uvc );                                            \
1873             foldlen -= skiplen;                                                     \
1874             uscan = foldbuf + skiplen;                                              \
1875         }                                                                           \
1876         break;                                                                      \
1877     case trie_utf8l:                                                                \
1878         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;                                         \
1879         if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) {                             \
1880             _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc));          \
1881         }                                                                           \
1882         /* FALLTHROUGH */                                                           \
1883     case trie_utf8:                                                                 \
1884         uvc = utf8n_to_uvchr( (const U8*) uc, uc_end - uc, &len, uniflags );        \
1885         break;                                                                      \
1886     case trie_plain:                                                                \
1887         uvc = (UV)*uc;                                                              \
1888         len = 1;                                                                    \
1889     }                                                                               \
1890     if (uvc < 256) {                                                                \
1891         charid = trie->charmap[ uvc ];                                              \
1892     }                                                                               \
1893     else {                                                                          \
1894         charid = 0;                                                                 \
1895         if (widecharmap) {                                                          \
1896             SV** const svpp = hv_fetch(widecharmap,                                 \
1897                         (char*)&uvc, sizeof(UV), 0);                                \
1898             if (svpp)                                                               \
1899                 charid = (U16)SvIV(*svpp);                                          \
1900         }                                                                           \
1901     }                                                                               \
1902 } STMT_END
1903
1904 #define DUMP_EXEC_POS(li,s,doutf8,depth)                    \
1905     dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \
1906                 startpos, doutf8, depth)
1907
1908 #define REXEC_FBC_SCAN(UTF8, CODE)                          \
1909     STMT_START {                                            \
1910         while (s < strend) {                                \
1911             CODE                                            \
1912             s += ((UTF8) ? UTF8SKIP(s) : 1);                \
1913         }                                                   \
1914     } STMT_END
1915
1916 #define REXEC_FBC_CLASS_SCAN(UTF8, COND)                    \
1917     STMT_START {                                            \
1918         while (s < strend) {                                \
1919             REXEC_FBC_CLASS_SCAN_GUTS(UTF8, COND)           \
1920         }                                                   \
1921     } STMT_END
1922
1923 #define REXEC_FBC_CLASS_SCAN_GUTS(UTF8, COND)                  \
1924     if (COND) {                                                \
1925         FBC_CHECK_AND_TRY                                      \
1926         s += ((UTF8) ? UTF8SKIP(s) : 1);                       \
1927         previous_occurrence_end = s;                           \
1928     }                                                          \
1929     else {                                                     \
1930         s += ((UTF8) ? UTF8SKIP(s) : 1);                       \
1931     }
1932
1933 #define REXEC_FBC_CSCAN(CONDUTF8,COND)                         \
1934     if (utf8_target) {                                         \
1935         REXEC_FBC_CLASS_SCAN(1, CONDUTF8);                     \
1936     }                                                          \
1937     else {                                                     \
1938         REXEC_FBC_CLASS_SCAN(0, COND);                         \
1939     }
1940
1941 /* We keep track of where the next character should start after an occurrence
1942  * of the one we're looking for.  Knowing that, we can see right away if the
1943  * next occurrence is adjacent to the previous.  When 'doevery' is FALSE, we
1944  * don't accept the 2nd and succeeding adjacent occurrences */
1945 #define FBC_CHECK_AND_TRY                                      \
1946         if (   (   doevery                                     \
1947                 || s != previous_occurrence_end)               \
1948             && (reginfo->intuit || regtry(reginfo, &s)))       \
1949         {                                                      \
1950             goto got_it;                                       \
1951         }
1952
1953
1954 /* This differs from the above macros in that it calls a function which returns
1955  * the next occurrence of the thing being looked for in 's'; and 'strend' if
1956  * there is no such occurrence. */
1957 #define REXEC_FBC_FIND_NEXT_SCAN(UTF8, f)                   \
1958     while (s < strend) {                                    \
1959         s = (f);                                            \
1960         if (s >= strend) {                                  \
1961             break;                                          \
1962         }                                                   \
1963                                                             \
1964         FBC_CHECK_AND_TRY                                   \
1965         s += (UTF8) ? UTF8SKIP(s) : 1;                      \
1966         previous_occurrence_end = s;                        \
1967     }
1968
1969 /* The three macros below are slightly different versions of the same logic.
1970  *
1971  * The first is for /a and /aa when the target string is UTF-8.  This can only
1972  * match ascii, but it must advance based on UTF-8.   The other two handle the
1973  * non-UTF-8 and the more generic UTF-8 cases.   In all three, we are looking
1974  * for the boundary (or non-boundary) between a word and non-word character.
1975  * The utf8 and non-utf8 cases have the same logic, but the details must be
1976  * different.  Find the "wordness" of the character just prior to this one, and
1977  * compare it with the wordness of this one.  If they differ, we have a
1978  * boundary.  At the beginning of the string, pretend that the previous
1979  * character was a new-line.
1980  *
1981  * All these macros uncleanly have side-effects with each other and outside
1982  * variables.  So far it's been too much trouble to clean-up
1983  *
1984  * TEST_NON_UTF8 is the macro or function to call to test if its byte input is
1985  *               a word character or not.
1986  * IF_SUCCESS    is code to do if it finds that we are at a boundary between
1987  *               word/non-word
1988  * IF_FAIL       is code to do if we aren't at a boundary between word/non-word
1989  *
1990  * Exactly one of the two IF_FOO parameters is a no-op, depending on whether we
1991  * are looking for a boundary or for a non-boundary.  If we are looking for a
1992  * boundary, we want IF_FAIL to be the no-op, and for IF_SUCCESS to go out and
1993  * see if this tentative match actually works, and if so, to quit the loop
1994  * here.  And vice-versa if we are looking for a non-boundary.
1995  *
1996  * 'tmp' below in the next three macros in the REXEC_FBC_SCAN and
1997  * REXEC_FBC_SCAN loops is a loop invariant, a bool giving the return of
1998  * TEST_NON_UTF8(s-1).  To see this, note that that's what it is defined to be
1999  * at entry to the loop, and to get to the IF_FAIL branch, tmp must equal
2000  * TEST_NON_UTF8(s), and in the opposite branch, IF_SUCCESS, tmp is that
2001  * complement.  But in that branch we complement tmp, meaning that at the
2002  * bottom of the loop tmp is always going to be equal to TEST_NON_UTF8(s),
2003  * which means at the top of the loop in the next iteration, it is
2004  * TEST_NON_UTF8(s-1) */
2005 #define FBC_UTF8_A(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL)                         \
2006     tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n';                      \
2007     tmp = TEST_NON_UTF8(tmp);                                                  \
2008     REXEC_FBC_SCAN(1,  /* 1=>is-utf8; advances s while s < strend */           \
2009         if (tmp == ! TEST_NON_UTF8((U8) *s)) {                                 \
2010             tmp = !tmp;                                                        \
2011             IF_SUCCESS; /* Is a boundary if values for s-1 and s differ */     \
2012         }                                                                      \
2013         else {                                                                 \
2014             IF_FAIL;                                                           \
2015         }                                                                      \
2016     );                                                                         \
2017
2018 /* Like FBC_UTF8_A, but TEST_UV is a macro which takes a UV as its input, and
2019  * TEST_UTF8 is a macro that for the same input code points returns identically
2020  * to TEST_UV, but takes a pointer to a UTF-8 encoded string instead */
2021 #define FBC_UTF8(TEST_UV, TEST_UTF8, IF_SUCCESS, IF_FAIL)                      \
2022     if (s == reginfo->strbeg) {                                                \
2023         tmp = '\n';                                                            \
2024     }                                                                          \
2025     else { /* Back-up to the start of the previous character */                \
2026         U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg);              \
2027         tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r,                     \
2028                                                        0, UTF8_ALLOW_DEFAULT); \
2029     }                                                                          \
2030     tmp = TEST_UV(tmp);                                                        \
2031     REXEC_FBC_SCAN(1,  /* 1=>is-utf8; advances s while s < strend */           \
2032         if (tmp == ! (TEST_UTF8((U8 *) s, (U8 *) reginfo->strend))) {          \
2033             tmp = !tmp;                                                        \
2034             IF_SUCCESS;                                                        \
2035         }                                                                      \
2036         else {                                                                 \
2037             IF_FAIL;                                                           \
2038         }                                                                      \
2039     );
2040
2041 /* Like the above two macros.  UTF8_CODE is the complete code for handling
2042  * UTF-8.  Common to the BOUND and NBOUND cases, set-up by the FBC_BOUND, etc
2043  * macros below */
2044 #define FBC_BOUND_COMMON(UTF8_CODE, TEST_NON_UTF8, IF_SUCCESS, IF_FAIL)        \
2045     if (utf8_target) {                                                         \
2046         UTF8_CODE                                                              \
2047     }                                                                          \
2048     else {  /* Not utf8 */                                                     \
2049         tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n';                  \
2050         tmp = TEST_NON_UTF8(tmp);                                              \
2051         REXEC_FBC_SCAN(0, /* 0=>not-utf8; advances s while s < strend */       \
2052             if (tmp == ! TEST_NON_UTF8((U8) *s)) {                             \
2053                 IF_SUCCESS;                                                    \
2054                 tmp = !tmp;                                                    \
2055             }                                                                  \
2056             else {                                                             \
2057                 IF_FAIL;                                                       \
2058             }                                                                  \
2059         );                                                                     \
2060     }                                                                          \
2061     /* Here, things have been set up by the previous code so that tmp is the   \
2062      * return of TEST_NON_UTF(s-1) or TEST_UTF8(s-1) (depending on the         \
2063      * utf8ness of the target).  We also have to check if this matches against \
2064      * the EOS, which we treat as a \n (which is the same value in both UTF-8  \
2065      * or non-UTF8, so can use the non-utf8 test condition even for a UTF-8    \
2066      * string */                                                               \
2067     if (tmp == ! TEST_NON_UTF8('\n')) {                                        \
2068         IF_SUCCESS;                                                            \
2069     }                                                                          \
2070     else {                                                                     \
2071         IF_FAIL;                                                               \
2072     }
2073
2074 /* This is the macro to use when we want to see if something that looks like it
2075  * could match, actually does, and if so exits the loop */
2076 #define REXEC_FBC_TRYIT                            \
2077     if ((reginfo->intuit || regtry(reginfo, &s)))  \
2078         goto got_it
2079
2080 /* The only difference between the BOUND and NBOUND cases is that
2081  * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in
2082  * NBOUND.  This is accomplished by passing it as either the if or else clause,
2083  * with the other one being empty (PLACEHOLDER is defined as empty).
2084  *
2085  * The TEST_FOO parameters are for operating on different forms of input, but
2086  * all should be ones that return identically for the same underlying code
2087  * points */
2088 #define FBC_BOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8)                           \
2089     FBC_BOUND_COMMON(                                                          \
2090           FBC_UTF8(TEST_UV, TEST_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER),          \
2091           TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
2092
2093 #define FBC_BOUND_A(TEST_NON_UTF8)                                             \
2094     FBC_BOUND_COMMON(                                                          \
2095             FBC_UTF8_A(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER),           \
2096             TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
2097
2098 #define FBC_NBOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8)                          \
2099     FBC_BOUND_COMMON(                                                          \
2100           FBC_UTF8(TEST_UV, TEST_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT),          \
2101           TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
2102
2103 #define FBC_NBOUND_A(TEST_NON_UTF8)                                            \
2104     FBC_BOUND_COMMON(                                                          \
2105             FBC_UTF8_A(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT),           \
2106             TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
2107
2108 #ifdef DEBUGGING
2109 static IV
2110 S_get_break_val_cp_checked(SV* const invlist, const UV cp_in) {
2111   IV cp_out = _invlist_search(invlist, cp_in);
2112   assert(cp_out >= 0);
2113   return cp_out;
2114 }
2115 #  define _generic_GET_BREAK_VAL_CP_CHECKED(invlist, invmap, cp) \
2116         invmap[S_get_break_val_cp_checked(invlist, cp)]
2117 #else
2118 #  define _generic_GET_BREAK_VAL_CP_CHECKED(invlist, invmap, cp) \
2119         invmap[_invlist_search(invlist, cp)]
2120 #endif
2121
2122 /* Takes a pointer to an inversion list, a pointer to its corresponding
2123  * inversion map, and a code point, and returns the code point's value
2124  * according to the two arrays.  It assumes that all code points have a value.
2125  * This is used as the base macro for macros for particular properties */
2126 #define _generic_GET_BREAK_VAL_CP(invlist, invmap, cp)              \
2127         _generic_GET_BREAK_VAL_CP_CHECKED(invlist, invmap, cp)
2128
2129 /* Same as above, but takes begin, end ptrs to a UTF-8 encoded string instead
2130  * of a code point, returning the value for the first code point in the string.
2131  * And it takes the particular macro name that finds the desired value given a
2132  * code point.  Merely convert the UTF-8 to code point and call the cp macro */
2133 #define _generic_GET_BREAK_VAL_UTF8(cp_macro, pos, strend)                     \
2134              (__ASSERT_(pos < strend)                                          \
2135                  /* Note assumes is valid UTF-8 */                             \
2136              (cp_macro(utf8_to_uvchr_buf((pos), (strend), NULL))))
2137
2138 /* Returns the GCB value for the input code point */
2139 #define getGCB_VAL_CP(cp)                                                      \
2140           _generic_GET_BREAK_VAL_CP(                                           \
2141                                     PL_GCB_invlist,                            \
2142                                     _Perl_GCB_invmap,                          \
2143                                     (cp))
2144
2145 /* Returns the GCB value for the first code point in the UTF-8 encoded string
2146  * bounded by pos and strend */
2147 #define getGCB_VAL_UTF8(pos, strend)                                           \
2148     _generic_GET_BREAK_VAL_UTF8(getGCB_VAL_CP, pos, strend)
2149
2150 /* Returns the LB value for the input code point */
2151 #define getLB_VAL_CP(cp)                                                       \
2152           _generic_GET_BREAK_VAL_CP(                                           \
2153                                     PL_LB_invlist,                             \
2154                                     _Perl_LB_invmap,                           \
2155                                     (cp))
2156
2157 /* Returns the LB value for the first code point in the UTF-8 encoded string
2158  * bounded by pos and strend */
2159 #define getLB_VAL_UTF8(pos, strend)                                            \
2160     _generic_GET_BREAK_VAL_UTF8(getLB_VAL_CP, pos, strend)
2161
2162
2163 /* Returns the SB value for the input code point */
2164 #define getSB_VAL_CP(cp)                                                       \
2165           _generic_GET_BREAK_VAL_CP(                                           \
2166                                     PL_SB_invlist,                             \
2167                                     _Perl_SB_invmap,                     \
2168                                     (cp))
2169
2170 /* Returns the SB value for the first code point in the UTF-8 encoded string
2171  * bounded by pos and strend */
2172 #define getSB_VAL_UTF8(pos, strend)                                            \
2173     _generic_GET_BREAK_VAL_UTF8(getSB_VAL_CP, pos, strend)
2174
2175 /* Returns the WB value for the input code point */
2176 #define getWB_VAL_CP(cp)                                                       \
2177           _generic_GET_BREAK_VAL_CP(                                           \
2178                                     PL_WB_invlist,                             \
2179                                     _Perl_WB_invmap,                         \
2180                                     (cp))
2181
2182 /* Returns the WB value for the first code point in the UTF-8 encoded string
2183  * bounded by pos and strend */
2184 #define getWB_VAL_UTF8(pos, strend)                                            \
2185     _generic_GET_BREAK_VAL_UTF8(getWB_VAL_CP, pos, strend)
2186
2187 /* We know what class REx starts with.  Try to find this position... */
2188 /* if reginfo->intuit, its a dryrun */
2189 /* annoyingly all the vars in this routine have different names from their counterparts
2190    in regmatch. /grrr */
2191 STATIC char *
2192 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, 
2193     const char *strend, regmatch_info *reginfo)
2194 {
2195     dVAR;
2196
2197     /* TRUE if x+ need not match at just the 1st pos of run of x's */
2198     const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
2199
2200     char *pat_string;   /* The pattern's exactish string */
2201     char *pat_end;          /* ptr to end char of pat_string */
2202     re_fold_t folder;   /* Function for computing non-utf8 folds */
2203     const U8 *fold_array;   /* array for folding ords < 256 */
2204     STRLEN ln;
2205     STRLEN lnc;
2206     U8 c1;
2207     U8 c2;
2208     char *e;
2209
2210     /* In some cases we accept only the first occurence of 'x' in a sequence of
2211      * them.  This variable points to just beyond the end of the previous
2212      * occurrence of 'x', hence we can tell if we are in a sequence.  (Having
2213      * it point to beyond the 'x' allows us to work for UTF-8 without having to
2214      * hop back.) */
2215     char * previous_occurrence_end = 0;
2216
2217     I32 tmp;            /* Scratch variable */
2218     const bool utf8_target = reginfo->is_utf8_target;
2219     UV utf8_fold_flags = 0;
2220     const bool is_utf8_pat = reginfo->is_utf8_pat;
2221     bool to_complement = FALSE; /* Invert the result?  Taking the xor of this
2222                                    with a result inverts that result, as 0^1 =
2223                                    1 and 1^1 = 0 */
2224     _char_class_number classnum;
2225
2226     RXi_GET_DECL(prog,progi);
2227
2228     PERL_ARGS_ASSERT_FIND_BYCLASS;
2229
2230     /* We know what class it must start with. */
2231     switch (OP(c)) {
2232     case ANYOFPOSIXL:
2233     case ANYOFL:
2234         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
2235
2236         if (ANYOFL_UTF8_LOCALE_REQD(FLAGS(c)) && ! IN_UTF8_CTYPE_LOCALE) {
2237             Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), utf8_locale_required);
2238         }
2239
2240         /* FALLTHROUGH */
2241     case ANYOFD:
2242     case ANYOF:
2243         if (utf8_target) {
2244             REXEC_FBC_CLASS_SCAN(1, /* 1=>is-utf8 */
2245                       reginclass(prog, c, (U8*)s, (U8*) strend, utf8_target));
2246         }
2247         else if (ANYOF_FLAGS(c)) {
2248             REXEC_FBC_CLASS_SCAN(0, reginclass(prog,c, (U8*)s, (U8*)s+1, 0));
2249         }
2250         else {
2251             REXEC_FBC_CLASS_SCAN(0, ANYOF_BITMAP_TEST(c, *((U8*)s)));
2252         }
2253         break;
2254
2255     case ANYOFM:    /* ARG() is the base byte; FLAGS() the mask byte */
2256         /* UTF-8ness doesn't matter, so use 0 */
2257         REXEC_FBC_FIND_NEXT_SCAN(0,
2258          (char *) find_next_masked((U8 *) s, (U8 *) strend,
2259                                    (U8) ARG(c), FLAGS(c)));
2260         break;
2261
2262     case NANYOFM:
2263         REXEC_FBC_FIND_NEXT_SCAN(0,
2264          (char *) find_span_end_mask((U8 *) s, (U8 *) strend,
2265                                    (U8) ARG(c), FLAGS(c)));
2266         break;
2267
2268     case EXACTFAA_NO_TRIE: /* This node only generated for non-utf8 patterns */
2269         assert(! is_utf8_pat);
2270         /* FALLTHROUGH */
2271     case EXACTFAA:
2272         if (is_utf8_pat || utf8_target) {
2273             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
2274             goto do_exactf_utf8;
2275         }
2276         fold_array = PL_fold_latin1;    /* Latin1 folds are not affected by */
2277         folder = foldEQ_latin1;         /* /a, except the sharp s one which */
2278         goto do_exactf_non_utf8;        /* isn't dealt with by these */
2279
2280     case EXACTF:   /* This node only generated for non-utf8 patterns */
2281         assert(! is_utf8_pat);
2282         if (utf8_target) {
2283             utf8_fold_flags = 0;
2284             goto do_exactf_utf8;
2285         }
2286         fold_array = PL_fold;
2287         folder = foldEQ;
2288         goto do_exactf_non_utf8;
2289
2290     case EXACTFL:
2291         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
2292         if (is_utf8_pat || utf8_target || IN_UTF8_CTYPE_LOCALE) {
2293             utf8_fold_flags = FOLDEQ_LOCALE;
2294             goto do_exactf_utf8;
2295         }
2296         fold_array = PL_fold_locale;
2297         folder = foldEQ_locale;
2298         goto do_exactf_non_utf8;
2299
2300     case EXACTFU_SS:
2301         if (is_utf8_pat) {
2302             utf8_fold_flags = FOLDEQ_S2_ALREADY_FOLDED;
2303         }
2304         goto do_exactf_utf8;
2305
2306     case EXACTFLU8:
2307             if (! utf8_target) {    /* All code points in this node require
2308                                        UTF-8 to express.  */
2309                 break;
2310             }
2311             utf8_fold_flags =  FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED
2312                                              | FOLDEQ_S2_FOLDS_SANE;
2313             goto do_exactf_utf8;
2314
2315     case EXACTFU:
2316         if (is_utf8_pat || utf8_target) {
2317             utf8_fold_flags = is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
2318             goto do_exactf_utf8;
2319         }
2320
2321         /* Any 'ss' in the pattern should have been replaced by regcomp,
2322          * so we don't have to worry here about this single special case
2323          * in the Latin1 range */
2324         fold_array = PL_fold_latin1;
2325         folder = foldEQ_latin1;
2326
2327         /* FALLTHROUGH */
2328
2329       do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
2330                            are no glitches with fold-length differences
2331                            between the target string and pattern */
2332
2333         /* The idea in the non-utf8 EXACTF* cases is to first find the
2334          * first character of the EXACTF* node and then, if necessary,
2335          * case-insensitively compare the full text of the node.  c1 is the
2336          * first character.  c2 is its fold.  This logic will not work for
2337          * Unicode semantics and the german sharp ss, which hence should
2338          * not be compiled into a node that gets here. */
2339         pat_string = STRING(c);
2340         ln  = STR_LEN(c);       /* length to match in octets/bytes */
2341
2342         /* We know that we have to match at least 'ln' bytes (which is the
2343          * same as characters, since not utf8).  If we have to match 3
2344          * characters, and there are only 2 availabe, we know without
2345          * trying that it will fail; so don't start a match past the
2346          * required minimum number from the far end */
2347         e = HOP3c(strend, -((SSize_t)ln), s);
2348         if (e < s)
2349             break;
2350
2351         c1 = *pat_string;
2352         c2 = fold_array[c1];
2353         if (c1 == c2) { /* If char and fold are the same */
2354             while (s <= e) {
2355                 s = (char *) memchr(s, c1, e + 1 - s);
2356                 if (s == NULL) {
2357                     break;
2358                 }
2359
2360                 /* Check that the rest of the node matches */
2361                 if (   (ln == 1 || folder(s + 1, pat_string + 1, ln - 1))
2362                     && (reginfo->intuit || regtry(reginfo, &s)) )
2363                 {
2364                     goto got_it;
2365                 }
2366                 s++;
2367             }
2368         }
2369         else {
2370             U8 bits_differing = c1 ^ c2;
2371
2372             /* If the folds differ in one bit position only, we can mask to
2373              * match either of them, and can use this faster find method.  Both
2374              * ASCII and EBCDIC tend to have their case folds differ in only
2375              * one position, so this is very likely */
2376             if (LIKELY(PL_bitcount[bits_differing] == 1)) {
2377                 bits_differing = ~ bits_differing;
2378                 while (s <= e) {
2379                     s = (char *) find_next_masked((U8 *) s, (U8 *) e + 1,
2380                                         (c1 & bits_differing), bits_differing);
2381                     if (s > e) {
2382                         break;
2383                     }
2384
2385                     if (   (ln == 1 || folder(s + 1, pat_string + 1, ln - 1))
2386                         && (reginfo->intuit || regtry(reginfo, &s)) )
2387                     {
2388                         goto got_it;
2389                     }
2390                     s++;
2391                 }
2392             }
2393             else {  /* Otherwise, stuck with looking byte-at-a-time.  This
2394                        should actually happen only in EXACTFL nodes */
2395                 while (s <= e) {
2396                     if (    (*(U8*)s == c1 || *(U8*)s == c2)
2397                         && (ln == 1 || folder(s + 1, pat_string + 1, ln - 1))
2398                         && (reginfo->intuit || regtry(reginfo, &s)) )
2399                     {
2400                         goto got_it;
2401                     }
2402                     s++;
2403                 }
2404             }
2405         }
2406         break;
2407
2408       do_exactf_utf8:
2409       {
2410         unsigned expansion;
2411
2412         /* If one of the operands is in utf8, we can't use the simpler folding
2413          * above, due to the fact that many different characters can have the
2414          * same fold, or portion of a fold, or different- length fold */
2415         pat_string = STRING(c);
2416         ln  = STR_LEN(c);       /* length to match in octets/bytes */
2417         pat_end = pat_string + ln;
2418         lnc = is_utf8_pat       /* length to match in characters */
2419                 ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
2420                 : ln;
2421
2422         /* We have 'lnc' characters to match in the pattern, but because of
2423          * multi-character folding, each character in the target can match
2424          * up to 3 characters (Unicode guarantees it will never exceed
2425          * this) if it is utf8-encoded; and up to 2 if not (based on the
2426          * fact that the Latin 1 folds are already determined, and the
2427          * only multi-char fold in that range is the sharp-s folding to
2428          * 'ss'.  Thus, a pattern character can match as little as 1/3 of a
2429          * string character.  Adjust lnc accordingly, rounding up, so that
2430          * if we need to match at least 4+1/3 chars, that really is 5. */
2431         expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
2432         lnc = (lnc + expansion - 1) / expansion;
2433
2434         /* As in the non-UTF8 case, if we have to match 3 characters, and
2435          * only 2 are left, it's guaranteed to fail, so don't start a
2436          * match that would require us to go beyond the end of the string
2437          */
2438         e = HOP3c(strend, -((SSize_t)lnc), s);
2439
2440         /* XXX Note that we could recalculate e to stop the loop earlier,
2441          * as the worst case expansion above will rarely be met, and as we
2442          * go along we would usually find that e moves further to the left.
2443          * This would happen only after we reached the point in the loop
2444          * where if there were no expansion we should fail.  Unclear if
2445          * worth the expense */
2446
2447         while (s <= e) {
2448             char *my_strend= (char *)strend;
2449             if (foldEQ_utf8_flags(s, &my_strend, 0,  utf8_target,
2450                   pat_string, NULL, ln, is_utf8_pat, utf8_fold_flags)
2451                 && (reginfo->intuit || regtry(reginfo, &s)) )
2452             {
2453                 goto got_it;
2454             }
2455             s += (utf8_target) ? UTF8SKIP(s) : 1;
2456         }
2457         break;
2458     }
2459
2460     case BOUNDL:
2461         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
2462         if (FLAGS(c) != TRADITIONAL_BOUND) {
2463             if (! IN_UTF8_CTYPE_LOCALE) {
2464                 Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
2465                                                 B_ON_NON_UTF8_LOCALE_IS_WRONG);
2466             }
2467             goto do_boundu;
2468         }
2469
2470         FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8_safe);
2471         break;
2472
2473     case NBOUNDL:
2474         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
2475         if (FLAGS(c) != TRADITIONAL_BOUND) {
2476             if (! IN_UTF8_CTYPE_LOCALE) {
2477                 Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
2478                                                 B_ON_NON_UTF8_LOCALE_IS_WRONG);
2479             }
2480             goto do_nboundu;
2481         }
2482
2483         FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8_safe);
2484         break;
2485
2486     case BOUND: /* regcomp.c makes sure that this only has the traditional \b
2487                    meaning */
2488         assert(FLAGS(c) == TRADITIONAL_BOUND);
2489
2490         FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8_safe);
2491         break;
2492
2493     case BOUNDA: /* regcomp.c makes sure that this only has the traditional \b
2494                    meaning */
2495         assert(FLAGS(c) == TRADITIONAL_BOUND);
2496
2497         FBC_BOUND_A(isWORDCHAR_A);
2498         break;
2499
2500     case NBOUND: /* regcomp.c makes sure that this only has the traditional \b
2501                    meaning */
2502         assert(FLAGS(c) == TRADITIONAL_BOUND);
2503
2504         FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8_safe);
2505         break;
2506
2507     case NBOUNDA: /* regcomp.c makes sure that this only has the traditional \b
2508                    meaning */
2509         assert(FLAGS(c) == TRADITIONAL_BOUND);
2510
2511         FBC_NBOUND_A(isWORDCHAR_A);
2512         break;
2513
2514     case NBOUNDU:
2515         if ((bound_type) FLAGS(c) == TRADITIONAL_BOUND) {
2516             FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8_safe);
2517             break;
2518         }
2519
2520       do_nboundu:
2521
2522         to_complement = 1;
2523         /* FALLTHROUGH */
2524
2525     case BOUNDU:
2526       do_boundu:
2527         switch((bound_type) FLAGS(c)) {
2528             case TRADITIONAL_BOUND:
2529                 FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8_safe);
2530                 break;
2531             case GCB_BOUND:
2532                 if (s == reginfo->strbeg) {
2533                     if (reginfo->intuit || regtry(reginfo, &s))
2534                     {
2535                         goto got_it;
2536                     }
2537
2538                     /* Didn't match.  Try at the next position (if there is one) */
2539                     s += (utf8_target) ? UTF8SKIP(s) : 1;
2540                     if (UNLIKELY(s >= reginfo->strend)) {
2541                         break;
2542                     }
2543                 }
2544
2545                 if (utf8_target) {
2546                     GCB_enum before = getGCB_VAL_UTF8(
2547                                                reghop3((U8*)s, -1,
2548                                                        (U8*)(reginfo->strbeg)),
2549                                                (U8*) reginfo->strend);
2550                     while (s < strend) {
2551                         GCB_enum after = getGCB_VAL_UTF8((U8*) s,
2552                                                         (U8*) reginfo->strend);
2553                         if (   (to_complement ^ isGCB(before,
2554                                                       after,
2555                                                       (U8*) reginfo->strbeg,
2556                                                       (U8*) s,
2557                                                       utf8_target))
2558                             && (reginfo->intuit || regtry(reginfo, &s)))
2559                         {
2560                             goto got_it;
2561                         }
2562                         before = after;
2563                         s += UTF8SKIP(s);
2564                     }
2565                 }
2566                 else {  /* Not utf8.  Everything is a GCB except between CR and
2567                            LF */
2568                     while (s < strend) {
2569                         if ((to_complement ^ (   UCHARAT(s - 1) != '\r'
2570                                               || UCHARAT(s) != '\n'))
2571                             && (reginfo->intuit || regtry(reginfo, &s)))
2572                         {
2573                             goto got_it;
2574                         }
2575                         s++;
2576                     }
2577                 }
2578
2579                 /* And, since this is a bound, it can match after the final
2580                  * character in the string */
2581                 if ((reginfo->intuit || regtry(reginfo, &s))) {
2582                     goto got_it;
2583                 }
2584                 break;
2585
2586             case LB_BOUND:
2587                 if (s == reginfo->strbeg) {
2588                     if (reginfo->intuit || regtry(reginfo, &s)) {
2589                         goto got_it;
2590                     }
2591                     s += (utf8_target) ? UTF8SKIP(s) : 1;
2592                     if (UNLIKELY(s >= reginfo->strend)) {
2593                         break;
2594                     }
2595                 }
2596
2597                 if (utf8_target) {
2598                     LB_enum before = getLB_VAL_UTF8(reghop3((U8*)s,
2599                                                                -1,
2600                                                                (U8*)(reginfo->strbeg)),
2601                                                        (U8*) reginfo->strend);
2602                     while (s < strend) {
2603                         LB_enum after = getLB_VAL_UTF8((U8*) s, (U8*) reginfo->strend);
2604                         if (to_complement ^ isLB(before,
2605                                                  after,
2606                                                  (U8*) reginfo->strbeg,
2607                                                  (U8*) s,
2608                                                  (U8*) reginfo->strend,
2609                                                  utf8_target)
2610                             && (reginfo->intuit || regtry(reginfo, &s)))
2611                         {
2612                             goto got_it;
2613                         }
2614                         before = after;
2615                         s += UTF8SKIP(s);
2616                     }
2617                 }
2618                 else {  /* Not utf8. */
2619                     LB_enum before = getLB_VAL_CP((U8) *(s -1));
2620                     while (s < strend) {
2621                         LB_enum after = getLB_VAL_CP((U8) *s);
2622                         if (to_complement ^ isLB(before,
2623                                                  after,
2624                                                  (U8*) reginfo->strbeg,
2625                                                  (U8*) s,
2626                                                  (U8*) reginfo->strend,
2627                                                  utf8_target)
2628                             && (reginfo->intuit || regtry(reginfo, &s)))
2629                         {
2630                             goto got_it;
2631                         }
2632                         before = after;
2633                         s++;
2634                     }
2635                 }
2636
2637                 if (reginfo->intuit || regtry(reginfo, &s)) {
2638                     goto got_it;
2639                 }
2640
2641                 break;
2642
2643             case SB_BOUND:
2644                 if (s == reginfo->strbeg) {
2645                     if (reginfo->intuit || regtry(reginfo, &s)) {
2646                         goto got_it;
2647                     }
2648                     s += (utf8_target) ? UTF8SKIP(s) : 1;
2649                     if (UNLIKELY(s >= reginfo->strend)) {
2650                         break;
2651                     }
2652                 }
2653
2654                 if (utf8_target) {
2655                     SB_enum before = getSB_VAL_UTF8(reghop3((U8*)s,
2656                                                         -1,
2657                                                         (U8*)(reginfo->strbeg)),
2658                                                       (U8*) reginfo->strend);
2659                     while (s < strend) {
2660                         SB_enum after = getSB_VAL_UTF8((U8*) s,
2661                                                          (U8*) reginfo->strend);
2662                         if ((to_complement ^ isSB(before,
2663                                                   after,
2664                                                   (U8*) reginfo->strbeg,
2665                                                   (U8*) s,
2666                                                   (U8*) reginfo->strend,
2667                                                   utf8_target))
2668                             && (reginfo->intuit || regtry(reginfo, &s)))
2669                         {
2670                             goto got_it;
2671                         }
2672                         before = after;
2673                         s += UTF8SKIP(s);
2674                     }
2675                 }
2676                 else {  /* Not utf8. */
2677                     SB_enum before = getSB_VAL_CP((U8) *(s -1));
2678                     while (s < strend) {
2679                         SB_enum after = getSB_VAL_CP((U8) *s);
2680                         if ((to_complement ^ isSB(before,
2681                                                   after,
2682                                                   (U8*) reginfo->strbeg,
2683                                                   (U8*) s,
2684                                                   (U8*) reginfo->strend,
2685                                                   utf8_target))
2686                             && (reginfo->intuit || regtry(reginfo, &s)))
2687                         {
2688                             goto got_it;
2689                         }
2690                         before = after;
2691                         s++;
2692                     }
2693                 }
2694
2695                 /* Here are at the final position in the target string.  The SB
2696                  * value is always true here, so matches, depending on other
2697                  * constraints */
2698                 if (reginfo->intuit || regtry(reginfo, &s)) {
2699                     goto got_it;
2700                 }
2701
2702                 break;
2703
2704             case WB_BOUND:
2705                 if (s == reginfo->strbeg) {
2706                     if (reginfo->intuit || regtry(reginfo, &s)) {
2707                         goto got_it;
2708                     }
2709                     s += (utf8_target) ? UTF8SKIP(s) : 1;
2710                     if (UNLIKELY(s >= reginfo->strend)) {
2711                         break;
2712                     }
2713                 }
2714
2715                 if (utf8_target) {
2716                     /* We are at a boundary between char_sub_0 and char_sub_1.
2717                      * We also keep track of the value for char_sub_-1 as we
2718                      * loop through the line.   Context may be needed to make a
2719                      * determination, and if so, this can save having to
2720                      * recalculate it */
2721                     WB_enum previous = WB_UNKNOWN;
2722                     WB_enum before = getWB_VAL_UTF8(
2723                                               reghop3((U8*)s,
2724                                                       -1,
2725                                                       (U8*)(reginfo->strbeg)),
2726                                               (U8*) reginfo->strend);
2727                     while (s < strend) {
2728                         WB_enum after = getWB_VAL_UTF8((U8*) s,
2729                                                         (U8*) reginfo->strend);
2730                         if ((to_complement ^ isWB(previous,
2731                                                   before,
2732                                                   after,
2733                                                   (U8*) reginfo->strbeg,
2734                                                   (U8*) s,
2735                                                   (U8*) reginfo->strend,
2736                                                   utf8_target))
2737                             && (reginfo->intuit || regtry(reginfo, &s)))
2738                         {
2739                             goto got_it;
2740                         }
2741                         previous = before;
2742                         before = after;
2743                         s += UTF8SKIP(s);
2744                     }
2745                 }
2746                 else {  /* Not utf8. */
2747                     WB_enum previous = WB_UNKNOWN;
2748                     WB_enum before = getWB_VAL_CP((U8) *(s -1));
2749                     while (s < strend) {
2750                         WB_enum after = getWB_VAL_CP((U8) *s);
2751                         if ((to_complement ^ isWB(previous,
2752                                                   before,
2753                                                   after,
2754                                                   (U8*) reginfo->strbeg,
2755                                                   (U8*) s,
2756                                                   (U8*) reginfo->strend,
2757                                                   utf8_target))
2758                             && (reginfo->intuit || regtry(reginfo, &s)))
2759                         {
2760                             goto got_it;
2761                         }
2762                         previous = before;
2763                         before = after;
2764                         s++;
2765                     }
2766                 }
2767
2768                 if (reginfo->intuit || regtry(reginfo, &s)) {
2769                     goto got_it;
2770                 }
2771         }
2772         break;
2773
2774     case LNBREAK:
2775         REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend),
2776                         is_LNBREAK_latin1_safe(s, strend)
2777         );
2778         break;
2779
2780     case ASCII:
2781         REXEC_FBC_FIND_NEXT_SCAN(0, find_next_ascii(s, strend, utf8_target));
2782         break;
2783
2784     case NASCII:
2785         if (utf8_target) {
2786             REXEC_FBC_FIND_NEXT_SCAN(1, find_next_non_ascii(s, strend,
2787                                                             utf8_target));
2788         }
2789         else {
2790             REXEC_FBC_FIND_NEXT_SCAN(0, find_next_non_ascii(s, strend,
2791                                                             utf8_target));
2792         }
2793
2794         break;
2795
2796     /* The argument to all the POSIX node types is the class number to pass to
2797      * _generic_isCC() to build a mask for searching in PL_charclass[] */
2798
2799     case NPOSIXL:
2800         to_complement = 1;
2801         /* FALLTHROUGH */
2802
2803     case POSIXL:
2804         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
2805         REXEC_FBC_CSCAN(to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(c), (U8 *) s, (U8 *) strend)),
2806                         to_complement ^ cBOOL(isFOO_lc(FLAGS(c), *s)));
2807         break;
2808
2809     case NPOSIXD:
2810         to_complement = 1;
2811         /* FALLTHROUGH */
2812
2813     case POSIXD:
2814         if (utf8_target) {
2815             goto posix_utf8;
2816         }
2817         goto posixa;
2818
2819     case NPOSIXA:
2820         if (utf8_target) {
2821             /* The complement of something that matches only ASCII matches all
2822              * non-ASCII, plus everything in ASCII that isn't in the class. */
2823             REXEC_FBC_CLASS_SCAN(1,   ! isASCII_utf8_safe(s, strend)
2824                                    || ! _generic_isCC_A(*s, FLAGS(c)));
2825             break;
2826         }
2827
2828         to_complement = 1;
2829         goto posixa;
2830
2831     case POSIXA:
2832         /* Don't need to worry about utf8, as it can match only a single
2833          * byte invariant character.  But we do anyway for performance reasons,
2834          * as otherwise we would have to examine all the continuation
2835          * characters */
2836         if (utf8_target) {
2837             REXEC_FBC_CLASS_SCAN(1, _generic_isCC_A(*s, FLAGS(c)));
2838             break;
2839         }
2840
2841       posixa:
2842         REXEC_FBC_CLASS_SCAN(0, /* 0=>not-utf8 */
2843                         to_complement ^ cBOOL(_generic_isCC_A(*s, FLAGS(c))));
2844         break;
2845
2846     case NPOSIXU:
2847         to_complement = 1;
2848         /* FALLTHROUGH */
2849
2850     case POSIXU:
2851         if (! utf8_target) {
2852             REXEC_FBC_CLASS_SCAN(0, /* 0=>not-utf8 */
2853                                  to_complement ^ cBOOL(_generic_isCC(*s,
2854                                                                     FLAGS(c))));
2855         }
2856         else {
2857
2858           posix_utf8:
2859             classnum = (_char_class_number) FLAGS(c);
2860             switch (classnum) {
2861                 default:
2862                     REXEC_FBC_CLASS_SCAN(1, /* 1=>is-utf8 */
2863                         to_complement ^ cBOOL(_invlist_contains_cp(
2864                                               PL_XPosix_ptrs[classnum],
2865                                               utf8_to_uvchr_buf((U8 *) s,
2866                                                                 (U8 *) strend,
2867                                                                 NULL))));
2868                     break;
2869                 case _CC_ENUM_SPACE:
2870                     REXEC_FBC_CLASS_SCAN(1, /* 1=>is-utf8 */
2871                         to_complement ^ cBOOL(isSPACE_utf8_safe(s, strend)));
2872                     break;
2873
2874                 case _CC_ENUM_BLANK:
2875                     REXEC_FBC_CLASS_SCAN(1,
2876                         to_complement ^ cBOOL(isBLANK_utf8_safe(s, strend)));
2877                     break;
2878
2879                 case _CC_ENUM_XDIGIT:
2880                     REXEC_FBC_CLASS_SCAN(1,
2881                        to_complement ^ cBOOL(isXDIGIT_utf8_safe(s, strend)));
2882                     break;
2883
2884                 case _CC_ENUM_VERTSPACE:
2885                     REXEC_FBC_CLASS_SCAN(1,
2886                        to_complement ^ cBOOL(isVERTWS_utf8_safe(s, strend)));
2887                     break;
2888
2889                 case _CC_ENUM_CNTRL:
2890                     REXEC_FBC_CLASS_SCAN(1,
2891                         to_complement ^ cBOOL(isCNTRL_utf8_safe(s, strend)));
2892                     break;
2893             }
2894         }
2895         break;
2896
2897     case AHOCORASICKC:
2898     case AHOCORASICK:
2899         {
2900             DECL_TRIE_TYPE(c);
2901             /* what trie are we using right now */
2902             reg_ac_data *aho = (reg_ac_data*)progi->data->data[ ARG( c ) ];
2903             reg_trie_data *trie = (reg_trie_data*)progi->data->data[ aho->trie ];
2904             HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
2905
2906             const char *last_start = strend - trie->minlen;
2907 #ifdef DEBUGGING
2908             const char *real_start = s;
2909 #endif
2910             STRLEN maxlen = trie->maxlen;
2911             SV *sv_points;
2912             U8 **points; /* map of where we were in the input string
2913                             when reading a given char. For ASCII this
2914                             is unnecessary overhead as the relationship
2915                             is always 1:1, but for Unicode, especially
2916                             case folded Unicode this is not true. */
2917             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2918             U8 *bitmap=NULL;
2919
2920
2921             GET_RE_DEBUG_FLAGS_DECL;
2922
2923             /* We can't just allocate points here. We need to wrap it in
2924              * an SV so it gets freed properly if there is a croak while
2925              * running the match */
2926             ENTER;
2927             SAVETMPS;
2928             sv_points=newSV(maxlen * sizeof(U8 *));
2929             SvCUR_set(sv_points,
2930                 maxlen * sizeof(U8 *));
2931             SvPOK_on(sv_points);
2932             sv_2mortal(sv_points);
2933             points=(U8**)SvPV_nolen(sv_points );
2934             if ( trie_type != trie_utf8_fold
2935                  && (trie->bitmap || OP(c)==AHOCORASICKC) )
2936             {
2937                 if (trie->bitmap)
2938                     bitmap=(U8*)trie->bitmap;
2939                 else
2940                     bitmap=(U8*)ANYOF_BITMAP(c);
2941             }
2942             /* this is the Aho-Corasick algorithm modified a touch
2943                to include special handling for long "unknown char" sequences.
2944                The basic idea being that we use AC as long as we are dealing
2945                with a possible matching char, when we encounter an unknown char
2946                (and we have not encountered an accepting state) we scan forward
2947                until we find a legal starting char.
2948                AC matching is basically that of trie matching, except that when
2949                we encounter a failing transition, we fall back to the current
2950                states "fail state", and try the current char again, a process
2951                we repeat until we reach the root state, state 1, or a legal
2952                transition. If we fail on the root state then we can either
2953                terminate if we have reached an accepting state previously, or
2954                restart the entire process from the beginning if we have not.
2955
2956              */
2957             while (s <= last_start) {
2958                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
2959                 U8 *uc = (U8*)s;
2960                 U16 charid = 0;
2961                 U32 base = 1;
2962                 U32 state = 1;
2963                 UV uvc = 0;
2964                 STRLEN len = 0;
2965                 STRLEN foldlen = 0;
2966                 U8 *uscan = (U8*)NULL;
2967                 U8 *leftmost = NULL;
2968 #ifdef DEBUGGING
2969                 U32 accepted_word= 0;
2970 #endif
2971                 U32 pointpos = 0;
2972
2973                 while ( state && uc <= (U8*)strend ) {
2974                     int failed=0;
2975                     U32 word = aho->states[ state ].wordnum;
2976
2977                     if( state==1 ) {
2978                         if ( bitmap ) {
2979                             DEBUG_TRIE_EXECUTE_r(
2980                                 if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
2981                                     dump_exec_pos( (char *)uc, c, strend, real_start,
2982                                         (char *)uc, utf8_target, 0 );
2983                                     Perl_re_printf( aTHX_
2984                                         " Scanning for legal start char...\n");
2985                                 }
2986                             );
2987                             if (utf8_target) {
2988                                 while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
2989                                     uc += UTF8SKIP(uc);
2990                                 }
2991                             } else {
2992                                 while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
2993                                     uc++;
2994                                 }
2995                             }
2996                             s= (char *)uc;
2997                         }
2998                         if (uc >(U8*)last_start) break;
2999                     }
3000
3001                     if ( word ) {
3002                         U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
3003                         if (!leftmost || lpos < leftmost) {
3004                             DEBUG_r(accepted_word=word);
3005                             leftmost= lpos;
3006                         }
3007                         if (base==0) break;
3008
3009                     }
3010                     points[pointpos++ % maxlen]= uc;
3011                     if (foldlen || uc < (U8*)strend) {
3012                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
3013                                              (U8 *) strend, uscan, len, uvc,
3014                                              charid, foldlen, foldbuf,
3015                                              uniflags);
3016                         DEBUG_TRIE_EXECUTE_r({
3017                             dump_exec_pos( (char *)uc, c, strend,
3018                                         real_start, s, utf8_target, 0);
3019                             Perl_re_printf( aTHX_
3020                                 " Charid:%3u CP:%4" UVxf " ",
3021                                  charid, uvc);
3022                         });
3023                     }
3024                     else {
3025                         len = 0;
3026                         charid = 0;
3027                     }
3028
3029
3030                     do {
3031 #ifdef DEBUGGING
3032                         word = aho->states[ state ].wordnum;
3033 #endif
3034                         base = aho->states[ state ].trans.base;
3035
3036                         DEBUG_TRIE_EXECUTE_r({
3037                             if (failed)
3038                                 dump_exec_pos( (char *)uc, c, strend, real_start,
3039                                     s,   utf8_target, 0 );
3040                             Perl_re_printf( aTHX_
3041                                 "%sState: %4" UVxf ", word=%" UVxf,
3042                                 failed ? " Fail transition to " : "",
3043                                 (UV)state, (UV)word);
3044                         });
3045                         if ( base ) {
3046                             U32 tmp;
3047                             I32 offset;
3048                             if (charid &&
3049                                  ( ((offset = base + charid
3050                                     - 1 - trie->uniquecharcount)) >= 0)
3051                                  && ((U32)offset < trie->lasttrans)
3052                                  && trie->trans[offset].check == state
3053                                  && (tmp=trie->trans[offset].next))
3054                             {
3055                                 DEBUG_TRIE_EXECUTE_r(
3056                                     Perl_re_printf( aTHX_ " - legal\n"));
3057                                 state = tmp;
3058                                 break;
3059                             }
3060                             else {
3061                                 DEBUG_TRIE_EXECUTE_r(
3062                                     Perl_re_printf( aTHX_ " - fail\n"));
3063                                 failed = 1;
3064                                 state = aho->fail[state];
3065                             }
3066                         }
3067                         else {
3068                             /* we must be accepting here */
3069                             DEBUG_TRIE_EXECUTE_r(
3070                                     Perl_re_printf( aTHX_ " - accepting\n"));
3071                             failed = 1;
3072                             break;
3073                         }
3074                     } while(state);
3075                     uc += len;
3076                     if (failed) {
3077                         if (leftmost)
3078                             break;
3079                         if (!state) state = 1;
3080                     }
3081                 }
3082                 if ( aho->states[ state ].wordnum ) {
3083                     U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
3084                     if (!leftmost || lpos < leftmost) {
3085                         DEBUG_r(accepted_word=aho->states[ state ].wordnum);
3086                         leftmost = lpos;
3087                     }
3088                 }
3089                 if (leftmost) {
3090                     s = (char*)leftmost;
3091                     DEBUG_TRIE_EXECUTE_r({
3092                         Perl_re_printf( aTHX_  "Matches word #%" UVxf " at position %" IVdf ". Trying full pattern...\n",
3093                             (UV)accepted_word, (IV)(s - real_start)
3094                         );
3095                     });
3096                     if (reginfo->intuit || regtry(reginfo, &s)) {
3097                         FREETMPS;
3098                         LEAVE;
3099                         goto got_it;
3100                     }
3101                     s = HOPc(s,1);
3102                     DEBUG_TRIE_EXECUTE_r({
3103                         Perl_re_printf( aTHX_ "Pattern failed. Looking for new start point...\n");
3104                     });
3105                 } else {
3106                     DEBUG_TRIE_EXECUTE_r(
3107                         Perl_re_printf( aTHX_ "No match.\n"));
3108                     break;
3109                 }
3110             }
3111             FREETMPS;
3112             LEAVE;
3113         }
3114         break;
3115     default:
3116         Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
3117     }
3118     return 0;
3119   got_it:
3120     return s;
3121 }
3122
3123 /* set RX_SAVED_COPY, RX_SUBBEG etc.
3124  * flags have same meanings as with regexec_flags() */
3125
3126 static void
3127 S_reg_set_capture_string(pTHX_ REGEXP * const rx,
3128                             char *strbeg,
3129                             char *strend,
3130                             SV *sv,
3131                             U32 flags,
3132                             bool utf8_target)
3133 {
3134     struct regexp *const prog = ReANY(rx);
3135
3136     if (flags & REXEC_COPY_STR) {
3137 #ifdef PERL_ANY_COW
3138         if (SvCANCOW(sv)) {
3139             DEBUG_C(Perl_re_printf( aTHX_
3140                               "Copy on write: regexp capture, type %d\n",
3141                                     (int) SvTYPE(sv)));
3142             /* Create a new COW SV to share the match string and store
3143              * in saved_copy, unless the current COW SV in saved_copy
3144              * is valid and suitable for our purpose */
3145             if ((   prog->saved_copy
3146                  && SvIsCOW(prog->saved_copy)
3147                  && SvPOKp(prog->saved_copy)
3148                  && SvIsCOW(sv)
3149                  && SvPOKp(sv)
3150                  && SvPVX(sv) == SvPVX(prog->saved_copy)))
3151             {
3152                 /* just reuse saved_copy SV */
3153                 if (RXp_MATCH_COPIED(prog)) {
3154                     Safefree(prog->subbeg);
3155                     RXp_MATCH_COPIED_off(prog);
3156                 }
3157             }
3158             else {
3159                 /* create new COW SV to share string */
3160                 RXp_MATCH_COPY_FREE(prog);
3161                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
3162             }
3163             prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
3164             assert (SvPOKp(prog->saved_copy));
3165             prog->sublen  = strend - strbeg;
3166             prog->suboffset = 0;
3167             prog->subcoffset = 0;
3168         } else
3169 #endif
3170         {
3171             SSize_t min = 0;
3172             SSize_t max = strend - strbeg;
3173             SSize_t sublen;
3174
3175             if (    (flags & REXEC_COPY_SKIP_POST)
3176                 && !(prog->extflags & RXf_PMf_KEEPCOPY) /* //p */
3177                 && !(PL_sawampersand & SAWAMPERSAND_RIGHT)
3178             ) { /* don't copy $' part of string */
3179                 U32 n = 0;
3180                 max = -1;
3181                 /* calculate the right-most part of the string covered
3182                  * by a capture. Due to lookahead, this may be to
3183                  * the right of $&, so we have to scan all captures */
3184                 while (n <= prog->lastparen) {
3185                     if (prog->offs[n].end > max)
3186                         max = prog->offs[n].end;
3187                     n++;
3188                 }
3189                 if (max == -1)
3190                     max = (PL_sawampersand & SAWAMPERSAND_LEFT)
3191                             ? prog->offs[0].start
3192                             : 0;
3193                 assert(max >= 0 && max <= strend - strbeg);
3194             }
3195
3196             if (    (flags & REXEC_COPY_SKIP_PRE)
3197                 && !(prog->extflags & RXf_PMf_KEEPCOPY) /* //p */
3198                 && !(PL_sawampersand & SAWAMPERSAND_LEFT)
3199             ) { /* don't copy $` part of string */
3200                 U32 n = 0;
3201                 min = max;
3202                 /* calculate the left-most part of the string covered
3203                  * by a capture. Due to lookbehind, this may be to
3204                  * the left of $&, so we have to scan all captures */
3205                 while (min && n <= prog->lastparen) {
3206                     if (   prog->offs[n].start != -1
3207                         && prog->offs[n].start < min)
3208                     {
3209                         min = prog->offs[n].start;
3210                     }
3211                     n++;
3212                 }
3213                 if ((PL_sawampersand & SAWAMPERSAND_RIGHT)
3214                     && min >  prog->offs[0].end
3215                 )
3216                     min = prog->offs[0].end;
3217
3218             }
3219
3220             assert(min >= 0 && min <= max && min <= strend - strbeg);
3221             sublen = max - min;
3222
3223             if (RXp_MATCH_COPIED(prog)) {
3224                 if (sublen > prog->sublen)
3225                     prog->subbeg =
3226                             (char*)saferealloc(prog->subbeg, sublen+1);
3227             }
3228             else
3229                 prog->subbeg = (char*)safemalloc(sublen+1);
3230             Copy(strbeg + min, prog->subbeg, sublen, char);
3231             prog->subbeg[sublen] = '\0';
3232             prog->suboffset = min;
3233             prog->sublen = sublen;
3234             RXp_MATCH_COPIED_on(prog);
3235         }
3236         prog->subcoffset = prog->suboffset;
3237         if (prog->suboffset && utf8_target) {
3238             /* Convert byte offset to chars.
3239              * XXX ideally should only compute this if @-/@+
3240              * has been seen, a la PL_sawampersand ??? */
3241
3242             /* If there's a direct correspondence between the
3243              * string which we're matching and the original SV,
3244              * then we can use the utf8 len cache associated with
3245              * the SV. In particular, it means that under //g,
3246              * sv_pos_b2u() will use the previously cached
3247              * position to speed up working out the new length of
3248              * subcoffset, rather than counting from the start of
3249              * the string each time. This stops
3250              *   $x = "\x{100}" x 1E6; 1 while $x =~ /(.)/g;
3251              * from going quadratic */
3252             if (SvPOKp(sv) && SvPVX(sv) == strbeg)
3253                 prog->subcoffset = sv_pos_b2u_flags(sv, prog->subcoffset,
3254                                                 SV_GMAGIC|SV_CONST_RETURN);
3255             else
3256                 prog->subcoffset = utf8_length((U8*)strbeg,
3257                                     (U8*)(strbeg+prog->suboffset));
3258         }
3259     }
3260     else {
3261         RXp_MATCH_COPY_FREE(prog);
3262         prog->subbeg = strbeg;
3263         prog->suboffset = 0;
3264         prog->subcoffset = 0;
3265         prog->sublen = strend - strbeg;
3266     }
3267 }
3268
3269
3270
3271
3272 /*
3273  - regexec_flags - match a regexp against a string
3274  */
3275 I32
3276 Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
3277               char *strbeg, SSize_t minend, SV *sv, void *data, U32 flags)
3278 /* stringarg: the point in the string at which to begin matching */
3279 /* strend:    pointer to null at end of string */
3280 /* strbeg:    real beginning of string */
3281 /* minend:    end of match must be >= minend bytes after stringarg. */
3282 /* sv:        SV being matched: only used for utf8 flag, pos() etc; string
3283  *            itself is accessed via the pointers above */
3284 /* data:      May be used for some additional optimizations.
3285               Currently unused. */
3286 /* flags:     For optimizations. See REXEC_* in regexp.h */
3287
3288 {
3289     struct regexp *const prog = ReANY(rx);
3290     char *s;
3291     regnode *c;
3292     char *startpos;
3293     SSize_t minlen;             /* must match at least this many chars */
3294     SSize_t dontbother = 0;     /* how many characters not to try at end */
3295     const bool utf8_target = cBOOL(DO_UTF8(sv));
3296     I32 multiline;
3297     RXi_GET_DECL(prog,progi);
3298     regmatch_info reginfo_buf;  /* create some info to pass to regtry etc */
3299     regmatch_info *const reginfo = &reginfo_buf;
3300     regexp_paren_pair *swap = NULL;
3301     I32 oldsave;
3302     GET_RE_DEBUG_FLAGS_DECL;
3303
3304     PERL_ARGS_ASSERT_REGEXEC_FLAGS;
3305     PERL_UNUSED_ARG(data);
3306
3307     /* Be paranoid... */
3308     if (prog == NULL) {
3309         Perl_croak(aTHX_ "NULL regexp parameter");
3310     }
3311
3312     DEBUG_EXECUTE_r(
3313         debug_start_match(rx, utf8_target, stringarg, strend,
3314         "Matching");
3315     );
3316
3317     startpos = stringarg;
3318
3319     /* set these early as they may be used by the HOP macros below */
3320     reginfo->strbeg = strbeg;
3321     reginfo->strend = strend;
3322     reginfo->is_utf8_target = cBOOL(utf8_target);
3323
3324     if (prog->intflags & PREGf_GPOS_SEEN) {
3325         MAGIC *mg;
3326
3327         /* set reginfo->ganch, the position where \G can match */
3328
3329         reginfo->ganch =
3330             (flags & REXEC_IGNOREPOS)
3331             ? stringarg /* use start pos rather than pos() */
3332             : ((mg = mg_find_mglob(sv)) && mg->mg_len >= 0)
3333               /* Defined pos(): */
3334             ? strbeg + MgBYTEPOS(mg, sv, strbeg, strend-strbeg)
3335             : strbeg; /* pos() not defined; use start of string */
3336
3337         DEBUG_GPOS_r(Perl_re_printf( aTHX_
3338             "GPOS ganch set to strbeg[%" IVdf "]\n", (IV)(reginfo->ganch - strbeg)));
3339
3340         /* in the presence of \G, we may need to start looking earlier in
3341          * the string than the suggested start point of stringarg:
3342          * if prog->gofs is set, then that's a known, fixed minimum
3343          * offset, such as
3344          * /..\G/:   gofs = 2
3345          * /ab|c\G/: gofs = 1
3346          * or if the minimum offset isn't known, then we have to go back
3347          * to the start of the string, e.g. /w+\G/
3348          */
3349
3350         if (prog->intflags & PREGf_ANCH_GPOS) {
3351             if (prog->gofs) {
3352                 startpos = HOPBACKc(reginfo->ganch, prog->gofs);
3353                 if (!startpos ||
3354                     ((flags & REXEC_FAIL_ON_UNDERFLOW) && startpos < stringarg))
3355                 {
3356                     DEBUG_r(Perl_re_printf( aTHX_
3357                             "fail: ganch-gofs before earliest possible start\n"));
3358                     return 0;
3359                 }
3360             }
3361             else
3362                 startpos = reginfo->ganch;
3363         }
3364         else if (prog->gofs) {
3365             startpos = HOPBACKc(startpos, prog->gofs);
3366             if (!startpos)
3367                 startpos = strbeg;
3368         }
3369         else if (prog->intflags & PREGf_GPOS_FLOAT)
3370             startpos = strbeg;
3371     }
3372
3373     minlen = prog->minlen;
3374     if ((startpos + minlen) > strend || startpos < strbeg) {
3375         DEBUG_r(Perl_re_printf( aTHX_
3376                     "Regex match can't succeed, so not even tried\n"));
3377         return 0;
3378     }
3379
3380     /* at the end of this function, we'll do a LEAVE_SCOPE(oldsave),
3381      * which will call destuctors to reset PL_regmatch_state, free higher
3382      * PL_regmatch_slabs, and clean up regmatch_info_aux and
3383      * regmatch_info_aux_eval */
3384
3385     oldsave = PL_savestack_ix;
3386
3387     s = startpos;
3388
3389     if ((prog->extflags & RXf_USE_INTUIT)
3390         && !(flags & REXEC_CHECKED))
3391     {
3392         s = re_intuit_start(rx, sv, strbeg, startpos, strend,
3393                                     flags, NULL);
3394         if (!s)
3395             return 0;
3396
3397         if (prog->extflags & RXf_CHECK_ALL) {
3398             /* we can match based purely on the result of INTUIT.
3399              * Set up captures etc just for $& and $-[0]
3400              * (an intuit-only match wont have $1,$2,..) */
3401             assert(!prog->nparens);
3402
3403             /* s/// doesn't like it if $& is earlier than where we asked it to
3404              * start searching (which can happen on something like /.\G/) */
3405             if (       (flags & REXEC_FAIL_ON_UNDERFLOW)
3406                     && (s < stringarg))
3407             {
3408                 /* this should only be possible under \G */
3409                 assert(prog->intflags & PREGf_GPOS_SEEN);
3410                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
3411                     "matched, but failing for REXEC_FAIL_ON_UNDERFLOW\n"));
3412                 goto phooey;
3413             }
3414
3415             /* match via INTUIT shouldn't have any captures.
3416              * Let @-, @+, $^N know */
3417             prog->lastparen = prog->lastcloseparen = 0;
3418             RXp_MATCH_UTF8_set(prog, utf8_target);
3419             prog->offs[0].start = s - strbeg;
3420             prog->offs[0].end = utf8_target
3421                 ? (char*)utf8_hop((U8*)s, prog->minlenret) - strbeg
3422                 : s - strbeg + prog->minlenret;
3423             if ( !(flags & REXEC_NOT_FIRST) )
3424                 S_reg_set_capture_string(aTHX_ rx,
3425                                         strbeg, strend,
3426                                         sv, flags, utf8_target);
3427
3428             return 1;
3429         }
3430     }
3431
3432     multiline = prog->extflags & RXf_PMf_MULTILINE;
3433     
3434     if (strend - s < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
3435         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
3436                               "String too short [regexec_flags]...\n"));
3437         goto phooey;
3438     }
3439     
3440     /* Check validity of program. */
3441     if (UCHARAT(progi->program) != REG_MAGIC) {
3442         Perl_croak(aTHX_ "corrupted regexp program");
3443     }
3444
3445     RXp_MATCH_TAINTED_off(prog);
3446     RXp_MATCH_UTF8_set(prog, utf8_target);
3447
3448     reginfo->prog = rx;  /* Yes, sorry that this is confusing.  */
3449     reginfo->intuit = 0;
3450     reginfo->is_utf8_pat = cBOOL(RX_UTF8(rx));
3451     reginfo->warned = FALSE;
3452     reginfo->sv = sv;
3453     reginfo->poscache_maxiter = 0; /* not yet started a countdown */
3454     /* see how far we have to get to not match where we matched before */
3455     reginfo->till = stringarg + minend;
3456
3457     if (prog->extflags & RXf_EVAL_SEEN && SvPADTMP(sv)) {
3458         /* SAVEFREESV, not sv_mortalcopy, as this SV must last until after
3459            S_cleanup_regmatch_info_aux has executed (registered by
3460            SAVEDESTRUCTOR_X below).  S_cleanup_regmatch_info_aux modifies
3461            magic belonging to this SV.
3462            Not newSVsv, either, as it does not COW.
3463         */
3464         reginfo->sv = newSV(0);
3465         SvSetSV_nosteal(reginfo->sv, sv);
3466         SAVEFREESV(reginfo->sv);
3467     }
3468
3469     /* reserve next 2 or 3 slots in PL_regmatch_state:
3470      * slot N+0: may currently be in use: skip it
3471      * slot N+1: use for regmatch_info_aux struct
3472      * slot N+2: use for regmatch_info_aux_eval struct if we have (?{})'s
3473      * slot N+3: ready for use by regmatch()
3474      */
3475
3476     {
3477         regmatch_state *old_regmatch_state;
3478         regmatch_slab  *old_regmatch_slab;
3479         int i, max = (prog->extflags & RXf_EVAL_SEEN) ? 2 : 1;
3480
3481         /* on first ever match, allocate first slab */
3482         if (!PL_regmatch_slab) {
3483             Newx(PL_regmatch_slab, 1, regmatch_slab);
3484             PL_regmatch_slab->prev = NULL;
3485             PL_regmatch_slab->next = NULL;
3486             PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
3487         }
3488
3489         old_regmatch_state = PL_regmatch_state;
3490         old_regmatch_slab  = PL_regmatch_slab;
3491
3492         for (i=0; i <= max; i++) {
3493             if (i == 1)
3494                 reginfo->info_aux = &(PL_regmatch_state->u.info_aux);
3495             else if (i ==2)
3496                 reginfo->info_aux_eval =
3497                 reginfo->info_aux->info_aux_eval =
3498                             &(PL_regmatch_state->u.info_aux_eval);
3499
3500             if (++PL_regmatch_state >  SLAB_LAST(PL_regmatch_slab))
3501                 PL_regmatch_state = S_push_slab(aTHX);
3502         }
3503
3504         /* note initial PL_regmatch_state position; at end of match we'll
3505          * pop back to there and free any higher slabs */
3506
3507         reginfo->info_aux->old_regmatch_state = old_regmatch_state;
3508         reginfo->info_aux->old_regmatch_slab  = old_regmatch_slab;
3509         reginfo->info_aux->poscache = NULL;
3510
3511         SAVEDESTRUCTOR_X(S_cleanup_regmatch_info_aux, reginfo->info_aux);
3512
3513         if ((prog->extflags & RXf_EVAL_SEEN))
3514             S_setup_eval_state(aTHX_ reginfo);
3515         else
3516             reginfo->info_aux_eval = reginfo->info_aux->info_aux_eval = NULL;
3517     }
3518
3519     /* If there is a "must appear" string, look for it. */
3520
3521     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
3522         /* We have to be careful. If the previous successful match
3523            was from this regex we don't want a subsequent partially
3524            successful match to clobber the old results.
3525            So when we detect this possibility we add a swap buffer
3526            to the re, and switch the buffer each match. If we fail,
3527            we switch it back; otherwise we leave it swapped.
3528         */
3529         swap = prog->offs;
3530         /* do we need a save destructor here for eval dies? */
3531         Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
3532         DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
3533             "rex=0x%" UVxf " saving  offs: orig=0x%" UVxf " new=0x%" UVxf "\n",
3534             0,
3535             PTR2UV(prog),
3536             PTR2UV(swap),
3537             PTR2UV(prog->offs)
3538         ));
3539     }
3540
3541     if (prog->recurse_locinput)
3542         Zero(prog->recurse_locinput,prog->nparens + 1, char *);
3543
3544     /* Simplest case: anchored match need be tried only once, or with
3545      * MBOL, only at the beginning of each line.
3546      *
3547      * Note that /.*.../ sets PREGf_IMPLICIT|MBOL, while /.*.../s sets
3548      * PREGf_IMPLICIT|SBOL. The idea is that with /.*.../s, if it doesn't
3549      * match at the start of the string then it won't match anywhere else
3550      * either; while with /.*.../, if it doesn't match at the beginning,
3551      * the earliest it could match is at the start of the next line */
3552
3553     if (prog->intflags & (PREGf_ANCH & ~PREGf_ANCH_GPOS)) {
3554         char *end;
3555
3556         if (regtry(reginfo, &s))
3557             goto got_it;
3558
3559         if (!(prog->intflags & PREGf_ANCH_MBOL))
3560             goto phooey;
3561
3562         /* didn't match at start, try at other newline positions */
3563
3564         if (minlen)
3565             dontbother = minlen - 1;
3566         end = HOP3c(strend, -dontbother, strbeg) - 1;
3567
3568         /* skip to next newline */
3569
3570         while (s <= end) { /* note it could be possible to match at the end of the string */
3571             /* NB: newlines are the same in unicode as they are in latin */
3572             if (*s++ != '\n')
3573                 continue;
3574             if (prog->check_substr || prog->check_utf8) {
3575             /* note that with PREGf_IMPLICIT, intuit can only fail
3576              * or return the start position, so it's of limited utility.
3577              * Nevertheless, I made the decision that the potential for
3578              * quick fail was still worth it - DAPM */
3579                 s = re_intuit_start(rx, sv, strbeg, s, strend, flags, NULL);
3580                 if (!s)
3581                     goto phooey;
3582             }
3583             if (regtry(reginfo, &s))
3584                 goto got_it;
3585         }
3586         goto phooey;
3587     } /* end anchored search */
3588
3589     if (prog->intflags & PREGf_ANCH_GPOS)
3590     {
3591         /* PREGf_ANCH_GPOS should never be true if PREGf_GPOS_SEEN is not true */
3592         assert(prog->intflags & PREGf_GPOS_SEEN);
3593         /* For anchored \G, the only position it can match from is
3594          * (ganch-gofs); we already set startpos to this above; if intuit
3595          * moved us on from there, we can't possibly succeed */
3596         assert(startpos == HOPBACKc(reginfo->ganch, prog->gofs));
3597         if (s == startpos && regtry(reginfo, &s))
3598             goto got_it;
3599         goto phooey;
3600     }
3601
3602     /* Messy cases:  unanchored match. */
3603     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
3604         /* we have /x+whatever/ */
3605         /* it must be a one character string (XXXX Except is_utf8_pat?) */
3606         char ch;
3607 #ifdef DEBUGGING
3608         int did_match = 0;
3609 #endif
3610         if (utf8_target) {
3611             if (! prog->anchored_utf8) {
3612                 to_utf8_substr(prog);
3613             }
3614             ch = SvPVX_const(prog->anchored_utf8)[0];
3615             REXEC_FBC_SCAN(0,   /* 0=>not-utf8 */
3616                 if (*s == ch) {
3617                     DEBUG_EXECUTE_r( did_match = 1 );
3618                     if (regtry(reginfo, &s)) goto got_it;
3619                     s += UTF8SKIP(s);
3620                     while (s < strend && *s == ch)
3621                         s += UTF8SKIP(s);
3622                 }
3623             );
3624
3625         }
3626         else {
3627             if (! prog->anchored_substr) {
3628                 if (! to_byte_substr(prog)) {
3629                     NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
3630                 }
3631             }
3632             ch = SvPVX_const(prog->anchored_substr)[0];
3633             REXEC_FBC_SCAN(0,   /* 0=>not-utf8 */
3634                 if (*s == ch) {
3635                     DEBUG_EXECUTE_r( did_match = 1 );
3636                     if (regtry(reginfo, &s)) goto got_it;
3637                     s++;
3638                     while (s < strend && *s == ch)
3639                         s++;
3640                 }
3641             );
3642         }
3643         DEBUG_EXECUTE_r(if (!did_match)
3644                 Perl_re_printf( aTHX_
3645                                   "Did not find anchored character...\n")
3646                );
3647     }
3648     else if (prog->anchored_substr != NULL
3649               || prog->anchored_utf8 != NULL
3650               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
3651                   && prog->float_max_offset < strend - s)) {
3652         SV *must;
3653         SSize_t back_max;
3654         SSize_t back_min;
3655         char *last;
3656         char *last1;            /* Last position checked before */
3657 #ifdef DEBUGGING
3658         int did_match = 0;
3659 #endif
3660         if (prog->anchored_substr || prog->anchored_utf8) {
3661             if (utf8_target) {
3662                 if (! prog->anchored_utf8) {
3663                     to_utf8_substr(prog);
3664                 }
3665                 must = prog->anchored_utf8;
3666             }
3667             else {
3668                 if (! prog->anchored_substr) {
3669                     if (! to_byte_substr(prog)) {
3670                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
3671                     }
3672                 }
3673                 must = prog->anchored_substr;
3674             }
3675             back_max = back_min = prog->anchored_offset;
3676         } else {
3677             if (utf8_target) {
3678                 if (! prog->float_utf8) {
3679                     to_utf8_substr(prog);
3680                 }
3681                 must = prog->float_utf8;
3682             }
3683             else {
3684                 if (! prog->float_substr) {
3685                     if (! to_byte_substr(prog)) {
3686                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
3687                     }
3688                 }
3689                 must = prog->float_substr;
3690             }
3691             back_max = prog->float_max_offset;
3692             back_min = prog->float_min_offset;
3693         }
3694             
3695         if (back_min<0) {
3696             last = strend;
3697         } else {
3698             last = HOP3c(strend,        /* Cannot start after this */
3699                   -(SSize_t)(CHR_SVLEN(must)
3700                          - (SvTAIL(must) != 0) + back_min), strbeg);
3701         }
3702         if (s > reginfo->strbeg)
3703             last1 = HOPc(s, -1);
3704         else
3705             last1 = s - 1;      /* bogus */
3706
3707         /* XXXX check_substr already used to find "s", can optimize if
3708            check_substr==must. */
3709         dontbother = 0;
3710         strend = HOPc(strend, -dontbother);
3711         while ( (s <= last) &&
3712                 (s = fbm_instr((unsigned char*)HOP4c(s, back_min, strbeg,  strend),
3713                                   (unsigned char*)strend, must,
3714                                   multiline ? FBMrf_MULTILINE : 0)) ) {
3715             DEBUG_EXECUTE_r( did_match = 1 );
3716             if (HOPc(s, -back_max) > last1) {
3717                 last1 = HOPc(s, -back_min);
3718                 s = HOPc(s, -back_max);
3719             }
3720             else {
3721                 char * const t = (last1 >= reginfo->strbeg)
3722                                     ? HOPc(last1, 1) : last1 + 1;
3723
3724                 last1 = HOPc(s, -back_min);
3725                 s = t;
3726             }
3727             if (utf8_target) {
3728                 while (s <= last1) {
3729                     if (regtry(reginfo, &s))
3730                         goto got_it;
3731                     if (s >= last1) {
3732                         s++; /* to break out of outer loop */
3733                         break;
3734                     }
3735                     s += UTF8SKIP(s);
3736                 }
3737             }
3738             else {
3739                 while (s <= last1) {
3740                     if (regtry(reginfo, &s))
3741                         goto got_it;
3742                     s++;
3743                 }
3744             }
3745         }
3746         DEBUG_EXECUTE_r(if (!did_match) {
3747             RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
3748                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
3749             Perl_re_printf( aTHX_  "Did not find %s substr %s%s...\n",
3750                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
3751                                ? "anchored" : "floating"),
3752                 quoted, RE_SV_TAIL(must));
3753         });                 
3754         goto phooey;
3755     }
3756     else if ( (c = progi->regstclass) ) {
3757         if (minlen) {
3758             const OPCODE op = OP(progi->regstclass);
3759             /* don't bother with what can't match */
3760             if (PL_regkind[op] != EXACT && PL_regkind[op] != TRIE)
3761                 strend = HOPc(strend, -(minlen - 1));
3762         }
3763         DEBUG_EXECUTE_r({
3764             SV * const prop = sv_newmortal();
3765             regprop(prog, prop, c, reginfo, NULL);
3766             {
3767                 RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
3768                     s,strend-s,PL_dump_re_max_len);
3769                 Perl_re_printf( aTHX_
3770                     "Matching stclass %.*s against %s (%d bytes)\n",
3771                     (int)SvCUR(prop), SvPVX_const(prop),
3772                      quoted, (int)(strend - s));
3773             }
3774         });
3775         if (find_byclass(prog, c, s, strend, reginfo))
3776             goto got_it;
3777         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "Contradicts stclass... [regexec_flags]\n"));
3778     }
3779     else {
3780         dontbother = 0;
3781         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
3782             /* Trim the end. */
3783             char *last= NULL;
3784             SV* float_real;
3785             STRLEN len;
3786             const char *little;
3787
3788             if (utf8_target) {
3789                 if (! prog->float_utf8) {
3790                     to_utf8_substr(prog);
3791                 }
3792                 float_real = prog->float_utf8;
3793             }
3794             else {
3795                 if (! prog->float_substr) {
3796                     if (! to_byte_substr(prog)) {
3797                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
3798                     }
3799                 }
3800                 float_real = prog->float_substr;
3801             }
3802
3803             little = SvPV_const(float_real, len);
3804             if (SvTAIL(float_real)) {
3805                     /* This means that float_real contains an artificial \n on
3806                      * the end due to the presence of something like this:
3807                      * /foo$/ where we can match both "foo" and "foo\n" at the
3808                      * end of the string.  So we have to compare the end of the
3809                      * string first against the float_real without the \n and
3810                      * then against the full float_real with the string.  We
3811                      * have to watch out for cases where the string might be
3812                      * smaller than the float_real or the float_real without
3813                      * the \n. */
3814                     char *checkpos= strend - len;
3815                     DEBUG_OPTIMISE_r(
3816                         Perl_re_printf( aTHX_
3817                             "%sChecking for float_real.%s\n",
3818                             PL_colors[4], PL_colors[5]));
3819                     if (checkpos + 1 < strbeg) {
3820                         /* can't match, even if we remove the trailing \n
3821                          * string is too short to match */
3822                         DEBUG_EXECUTE_r(
3823                             Perl_re_printf( aTHX_
3824                                 "%sString shorter than required trailing substring, cannot match.%s\n",
3825                                 PL_colors[4], PL_colors[5]));
3826                         goto phooey;
3827                     } else if (memEQ(checkpos + 1, little, len - 1)) {
3828                         /* can match, the end of the string matches without the
3829                          * "\n" */
3830                         last = checkpos + 1;
3831                     } else if (checkpos < strbeg) {
3832                         /* cant match, string is too short when the "\n" is
3833                          * included */
3834                         DEBUG_EXECUTE_r(
3835                             Perl_re_printf( aTHX_
3836                                 "%sString does not contain required trailing substring, cannot match.%s\n",
3837                                 PL_colors[4], PL_colors[5]));
3838                         goto phooey;
3839                     } else if (!multiline) {
3840                         /* non multiline match, so compare with the "\n" at the
3841                          * end of the string */
3842                         if (memEQ(checkpos, little, len)) {
3843                             last= checkpos;
3844                         } else {
3845                             DEBUG_EXECUTE_r(
3846                                 Perl_re_printf( aTHX_
3847                                     "%sString does not contain required trailing substring, cannot match.%s\n",
3848                                     PL_colors[4], PL_colors[5]));
3849                             goto phooey;
3850                         }
3851                     } else {
3852                         /* multiline match, so we have to search for a place
3853                          * where the full string is located */
3854                         goto find_last;
3855                     }
3856             } else {
3857                   find_last:
3858                     if (len)
3859                         last = rninstr(s, strend, little, little + len);
3860                     else
3861                         last = strend;  /* matching "$" */
3862             }
3863             if (!last) {
3864                 /* at one point this block contained a comment which was
3865                  * probably incorrect, which said that this was a "should not
3866                  * happen" case.  Even if it was true when it was written I am
3867                  * pretty sure it is not anymore, so I have removed the comment
3868                  * and replaced it with this one. Yves */
3869                 DEBUG_EXECUTE_r(
3870                     Perl_re_printf( aTHX_
3871                         "%sString does not contain required substring, cannot match.%s\n",
3872                         PL_colors[4], PL_colors[5]
3873                     ));
3874                 goto phooey;
3875             }
3876             dontbother = strend - last + prog->float_min_offset;
3877         }
3878         if (minlen && (dontbother < minlen))
3879             dontbother = minlen - 1;
3880         strend -= dontbother;              /* this one's always in bytes! */
3881         /* We don't know much -- general case. */
3882         if (utf8_target) {
3883             for (;;) {
3884                 if (regtry(reginfo, &s))
3885                     goto got_it;
3886                 if (s >= strend)
3887                     break;
3888                 s += UTF8SKIP(s);
3889             };
3890         }
3891         else {
3892             do {
3893                 if (regtry(reginfo, &s))
3894                     goto got_it;
3895             } while (s++ < strend);
3896         }
3897     }
3898
3899     /* Failure. */
3900     goto phooey;
3901
3902   got_it:
3903     /* s/// doesn't like it if $& is earlier than where we asked it to
3904      * start searching (which can happen on something like /.\G/) */
3905     if (       (flags & REXEC_FAIL_ON_UNDERFLOW)
3906             && (prog->offs[0].start < stringarg - strbeg))
3907     {
3908         /* this should only be possible under \G */
3909         assert(prog->intflags & PREGf_GPOS_SEEN);
3910         DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
3911             "matched, but failing for REXEC_FAIL_ON_UNDERFLOW\n"));
3912         goto phooey;
3913     }
3914
3915     DEBUG_BUFFERS_r(
3916         if (swap)
3917             Perl_re_exec_indentf( aTHX_
3918                 "rex=0x%" UVxf " freeing offs: 0x%" UVxf "\n",
3919                 0,
3920                 PTR2UV(prog),
3921                 PTR2UV(swap)
3922             );
3923     );
3924     Safefree(swap);
3925
3926     /* clean up; this will trigger destructors that will free all slabs
3927      * above the current one, and cleanup the regmatch_info_aux
3928      * and regmatch_info_aux_eval sructs */
3929
3930     LEAVE_SCOPE(oldsave);
3931
3932     if (RXp_PAREN_NAMES(prog)) 
3933         (void)hv_iterinit(RXp_PAREN_NAMES(prog));
3934
3935     /* make sure $`, $&, $', and $digit will work later */
3936     if ( !(flags & REXEC_NOT_FIRST) )
3937         S_reg_set_capture_string(aTHX_ rx,
3938                                     strbeg, reginfo->strend,
3939                                     sv, flags, utf8_target);
3940
3941     return 1;
3942
3943   phooey:
3944     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "%sMatch failed%s\n",
3945                           PL_colors[4], PL_colors[5]));
3946
3947     /* clean up; this will trigger destructors that will free all slabs
3948      * above the current one, and cleanup the regmatch_info_aux
3949      * and regmatch_info_aux_eval sructs */
3950
3951     LEAVE_SCOPE(oldsave);
3952
3953     if (swap) {
3954         /* we failed :-( roll it back */
3955         DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
3956             "rex=0x%" UVxf " rolling back offs: freeing=0x%" UVxf " restoring=0x%" UVxf "\n",
3957             0,
3958             PTR2UV(prog),
3959             PTR2UV(prog->offs),
3960             PTR2UV(swap)
3961         ));
3962         Safefree(prog->offs);
3963         prog->offs = swap;
3964     }
3965     return 0;
3966 }
3967
3968
3969 /* Set which rex is pointed to by PL_reg_curpm, handling ref counting.
3970  * Do inc before dec, in case old and new rex are the same */
3971 #define SET_reg_curpm(Re2)                          \
3972     if (reginfo->info_aux_eval) {                   \
3973         (void)ReREFCNT_inc(Re2);                    \
3974         ReREFCNT_dec(PM_GETRE(PL_reg_curpm));       \
3975         PM_SETRE((PL_reg_curpm), (Re2));            \
3976     }
3977
3978
3979 /*
3980  - regtry - try match at specific point
3981  */
3982 STATIC bool                     /* 0 failure, 1 success */
3983 S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
3984 {
3985     CHECKPOINT lastcp;
3986     REGEXP *const rx = reginfo->prog;
3987     regexp *const prog = ReANY(rx);
3988     SSize_t result;
3989 #ifdef DEBUGGING
3990     U32 depth = 0; /* used by REGCP_SET */
3991 #endif
3992     RXi_GET_DECL(prog,progi);
3993     GET_RE_DEBUG_FLAGS_DECL;
3994
3995     PERL_ARGS_ASSERT_REGTRY;
3996
3997     reginfo->cutpoint=NULL;
3998
3999     prog->offs[0].start = *startposp - reginfo->strbeg;
4000     prog->lastparen = 0;
4001     prog->lastcloseparen = 0;
4002
4003     /* XXXX What this code is doing here?!!!  There should be no need
4004        to do this again and again, prog->lastparen should take care of
4005        this!  --ilya*/
4006
4007     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
4008      * Actually, the code in regcppop() (which Ilya may be meaning by
4009      * prog->lastparen), is not needed at all by the test suite
4010      * (op/regexp, op/pat, op/split), but that code is needed otherwise
4011      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
4012      * Meanwhile, this code *is* needed for the
4013      * above-mentioned test suite tests to succeed.  The common theme
4014      * on those tests seems to be returning null fields from matches.
4015      * --jhi updated by dapm */
4016
4017     /* After encountering a variant of the issue mentioned above I think
4018      * the point Ilya was making is that if we properly unwind whenever
4019      * we set lastparen to a smaller value then we should not need to do
4020      * this every time, only when needed. So if we have tests that fail if
4021      * we remove this, then it suggests somewhere else we are improperly
4022      * unwinding the lastparen/paren buffers. See UNWIND_PARENS() and
4023      * places it is called, and related regcp() routines. - Yves */
4024 #if 1
4025     if (prog->nparens) {
4026         regexp_paren_pair *pp = prog->offs;
4027         I32 i;
4028         for (i = prog->nparens; i > (I32)prog->lastparen; i--) {
4029             ++pp;
4030             pp->start = -1;
4031             pp->end = -1;
4032         }
4033     }
4034 #endif
4035     REGCP_SET(lastcp);
4036     result = regmatch(reginfo, *startposp, progi->program + 1);
4037     if (result != -1) {
4038         prog->offs[0].end = result;
4039         return 1;
4040     }
4041     if (reginfo->cutpoint)
4042         *startposp= reginfo->cutpoint;
4043     REGCP_UNWIND(lastcp);
4044     return 0;
4045 }
4046
4047
4048 #define sayYES goto yes
4049 #define sayNO goto no
4050 #define sayNO_SILENT goto no_silent
4051
4052 /* we dont use STMT_START/END here because it leads to 
4053    "unreachable code" warnings, which are bogus, but distracting. */
4054 #define CACHEsayNO \
4055     if (ST.cache_mask) \
4056        reginfo->info_aux->poscache[ST.cache_offset] |= ST.cache_mask; \
4057     sayNO
4058
4059 /* this is used to determine how far from the left messages like
4060    'failed...' are printed in regexec.c. It should be set such that
4061    messages are inline with the regop output that created them.
4062 */
4063 #define REPORT_CODE_OFF 29
4064 #define INDENT_CHARS(depth) ((int)(depth) % 20)
4065 #ifdef DEBUGGING
4066 int
4067 Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...)
4068 {
4069     va_list ap;
4070     int result;
4071     PerlIO *f= Perl_debug_log;
4072     PERL_ARGS_ASSERT_RE_EXEC_INDENTF;
4073     va_start(ap, depth);
4074     PerlIO_printf(f, "%*s|%4" UVuf "| %*s", REPORT_CODE_OFF, "", (UV)depth, INDENT_CHARS(depth), "" );
4075     result = PerlIO_vprintf(f, fmt, ap);
4076     va_end(ap);
4077     return result;
4078 }
4079 #endif /* DEBUGGING */
4080
4081
4082 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
4083 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
4084 #define CHRTEST_NOT_A_CP_1 -999
4085 #define CHRTEST_NOT_A_CP_2 -998
4086
4087 /* grab a new slab and return the first slot in it */
4088
4089 STATIC regmatch_state *
4090 S_push_slab(pTHX)
4091 {
4092     regmatch_slab *s = PL_regmatch_slab->next;
4093     if (!s) {
4094         Newx(s, 1, regmatch_slab);
4095         s->prev = PL_regmatch_slab;
4096         s->next = NULL;
4097         PL_regmatch_slab->next = s;
4098     }
4099     PL_regmatch_slab = s;
4100     return SLAB_FIRST(s);
4101 }
4102
4103
4104 /* push a new state then goto it */
4105
4106 #define PUSH_STATE_GOTO(state, node, input) \
4107     pushinput = input; \
4108     scan = node; \
4109     st->resume_state = state; \
4110     goto push_state;
4111
4112 /* push a new state with success backtracking, then goto it */
4113
4114 #define PUSH_YES_STATE_GOTO(state, node, input) \
4115     pushinput = input; \
4116     scan = node; \
4117     st->resume_state = state; \
4118     goto push_yes_state;
4119
4120
4121
4122
4123 /*
4124
4125 regmatch() - main matching routine
4126
4127 This is basically one big switch statement in a loop. We execute an op,
4128 set 'next' to point the next op, and continue. If we come to a point which
4129 we may need to backtrack to on failure such as (A|B|C), we push a
4130 backtrack state onto the backtrack stack. On failure, we pop the top
4131 state, and re-enter the loop at the state indicated. If there are no more
4132 states to pop, we return failure.
4133
4134 Sometimes we also need to backtrack on success; for example /A+/, where
4135 after successfully matching one A, we need to go back and try to
4136 match another one; similarly for lookahead assertions: if the assertion
4137 completes successfully, we backtrack to the state just before the assertion
4138 and then carry on.  In these cases, the pushed state is marked as
4139 'backtrack on success too'. This marking is in fact done by a chain of
4140 pointers, each pointing to the previous 'yes' state. On success, we pop to
4141 the nearest yes state, discarding any intermediate failure-only states.
4142 Sometimes a yes state is pushed just to force some cleanup code to be
4143 called at the end of a successful match or submatch; e.g. (??{$re}) uses
4144 it to free the inner regex.
4145
4146 Note that failure backtracking rewinds the cursor position, while
4147 success backtracking leaves it alone.
4148
4149 A pattern is complete when the END op is executed, while a subpattern
4150 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
4151 ops trigger the "pop to last yes state if any, otherwise return true"
4152 behaviour.
4153
4154 A common convention in this function is to use A and B to refer to the two
4155 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
4156 the subpattern to be matched possibly multiple times, while B is the entire
4157 rest of the pattern. Variable and state names reflect this convention.
4158
4159 The states in the main switch are the union of ops and failure/success of
4160 substates associated with with that op.  For example, IFMATCH is the op
4161 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
4162 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
4163 successfully matched A and IFMATCH_A_fail is a state saying that we have
4164 just failed to match A. Resume states always come in pairs. The backtrack
4165 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
4166 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
4167 on success or failure.
4168
4169 The struct that holds a backtracking state is actually a big union, with
4170 one variant for each major type of op. The variable st points to the
4171 top-most backtrack struct. To make the code clearer, within each
4172 block of code we #define ST to alias the relevant union.
4173
4174 Here's a concrete example of a (vastly oversimplified) IFMATCH
4175 implementation:
4176
4177     switch (state) {
4178     ....
4179
4180 #define ST st->u.ifmatch
4181
4182     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
4183         ST.foo = ...; // some state we wish to save
4184         ...
4185         // push a yes backtrack state with a resume value of
4186         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
4187         // first node of A:
4188         PUSH_YES_STATE_GOTO(IFMATCH_A, A, newinput);
4189         // NOTREACHED
4190
4191     case IFMATCH_A: // we have successfully executed A; now continue with B
4192         next = B;
4193         bar = ST.foo; // do something with the preserved value
4194         break;
4195
4196     case IFMATCH_A_fail: // A failed, so the assertion failed
4197         ...;   // do some housekeeping, then ...
4198         sayNO; // propagate the failure
4199
4200 #undef ST
4201
4202     ...
4203     }
4204
4205 For any old-timers reading this who are familiar with the old recursive
4206 approach, the code above is equivalent to:
4207
4208     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
4209     {
4210         int foo = ...
4211         ...
4212         if (regmatch(A)) {
4213             next = B;
4214             bar = foo;
4215             break;
4216         }
4217         ...;   // do some housekeeping, then ...
4218         sayNO; // propagate the failure
4219     }
4220
4221 The topmost backtrack state, pointed to by st, is usually free. If you
4222 want to claim it, populate any ST.foo fields in it with values you wish to
4223 save, then do one of
4224
4225         PUSH_STATE_GOTO(resume_state, node, newinput);
4226         PUSH_YES_STATE_GOTO(resume_state, node, newinput);
4227
4228 which sets that backtrack state's resume value to 'resume_state', pushes a
4229 new free entry to the top of the backtrack stack, then goes to 'node'.
4230 On backtracking, the free slot is popped, and the saved state becomes the
4231 new free state. An ST.foo field in this new top state can be temporarily
4232 accessed to retrieve values, but once the main loop is re-entered, it
4233 becomes available for reuse.
4234
4235 Note that the depth of the backtrack stack constantly increases during the
4236 left-to-right execution of the pattern, rather than going up and down with
4237 the pattern nesting. For example the stack is at its maximum at Z at the
4238 end of the pattern, rather than at X in the following:
4239
4240     /(((X)+)+)+....(Y)+....Z/
4241
4242 The only exceptions to this are lookahead/behind assertions and the cut,
4243 (?>A), which pop all the backtrack states associated with A before
4244 continuing.
4245  
4246 Backtrack state structs are allocated in slabs of about 4K in size.
4247 PL_regmatch_state and st always point to the currently active state,
4248 and PL_regmatch_slab points to the slab currently containing
4249 PL_regmatch_state.  The first time regmatch() is called, the first slab is
4250 allocated, and is never freed until interpreter destruction. When the slab
4251 is full, a new one is allocated and chained to the end. At exit from
4252 regmatch(), slabs allocated since entry are freed.
4253
4254 */
4255  
4256
4257 #define DEBUG_STATE_pp(pp)                                  \
4258     DEBUG_STATE_r({                                         \
4259         DUMP_EXEC_POS(locinput, scan, utf8_target,depth);   \
4260         Perl_re_printf( aTHX_                                           \
4261             "%*s" pp " %s%s%s%s%s\n",                       \
4262             INDENT_CHARS(depth), "",                        \
4263             PL_reg_name[st->resume_state],                  \
4264             ((st==yes_state||st==mark_state) ? "[" : ""),   \
4265             ((st==yes_state) ? "Y" : ""),                   \
4266             ((st==mark_state) ? "M" : ""),                  \
4267             ((st==yes_state||st==mark_state) ? "]" : "")    \
4268         );                                                  \
4269     });
4270
4271
4272 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
4273
4274 #ifdef DEBUGGING
4275
4276 STATIC void
4277 S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target,
4278     const char *start, const char *end, const char *blurb)
4279 {
4280     const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
4281
4282     PERL_ARGS_ASSERT_DEBUG_START_MATCH;
4283
4284     if (!PL_colorset)   
4285             reginitcolors();    
4286     {
4287         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
4288             RX_PRECOMP_const(prog), RX_PRELEN(prog), PL_dump_re_max_len);
4289         
4290         RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1),
4291             start, end - start, PL_dump_re_max_len);
4292         
4293         Perl_re_printf( aTHX_
4294             "%s%s REx%s %s against %s\n", 
4295                        PL_colors[4], blurb, PL_colors[5], s0, s1); 
4296         
4297         if (utf8_target||utf8_pat)
4298             Perl_re_printf( aTHX_  "UTF-8 %s%s%s...\n",
4299                 utf8_pat ? "pattern" : "",
4300                 utf8_pat && utf8_target ? " and " : "",
4301                 utf8_target ? "string" : ""
4302             ); 
4303     }
4304 }
4305
4306 STATIC void
4307 S_dump_exec_pos(pTHX_ const char *locinput, 
4308                       const regnode *scan, 
4309                       const char *loc_regeol, 
4310                       const char *loc_bostr, 
4311                       const char *loc_reg_starttry,
4312                       const bool utf8_target,
4313                       const U32 depth
4314                 )
4315 {
4316     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
4317     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
4318     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
4319     /* The part of the string before starttry has one color
4320        (pref0_len chars), between starttry and current
4321        position another one (pref_len - pref0_len chars),
4322        after the current position the third one.
4323        We assume that pref0_len <= pref_len, otherwise we
4324        decrease pref0_len.  */
4325     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
4326         ? (5 + taill) - l : locinput - loc_bostr;
4327     int pref0_len;
4328
4329     PERL_ARGS_ASSERT_DUMP_EXEC_POS;
4330
4331     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
4332         pref_len++;
4333     pref0_len = pref_len  - (locinput - loc_reg_starttry);
4334     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
4335         l = ( loc_regeol - locinput > (5 + taill) - pref_len
4336               ? (5 + taill) - pref_len : loc_regeol - locinput);
4337     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
4338         l--;
4339     if (pref0_len < 0)
4340         pref0_len = 0;
4341     if (pref0_len > pref_len)
4342         pref0_len = pref_len;
4343     {
4344         const int is_uni = utf8_target ? 1 : 0;
4345
4346         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
4347             (locinput - pref_len),pref0_len, PL_dump_re_max_len, 4, 5);
4348         
4349         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
4350                     (locinput - pref_len + pref0_len),
4351                     pref_len - pref0_len, PL_dump_re_max_len, 2, 3);
4352         
4353         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
4354                     locinput, loc_regeol - locinput, 10, 0, 1);
4355
4356         const STRLEN tlen=len0+len1+len2;
4357         Perl_re_printf( aTHX_
4358                     "%4" IVdf " <%.*s%.*s%s%.*s>%*s|%4u| ",
4359                     (IV)(locinput - loc_bostr),
4360                     len0, s0,
4361                     len1, s1,
4362                     (docolor ? "" : "> <"),
4363                     len2, s2,
4364                     (int)(tlen > 19 ? 0 :  19 - tlen),
4365                     "",
4366                     depth);
4367     }
4368 }
4369
4370 #endif
4371
4372 /* reg_check_named_buff_matched()
4373  * Checks to see if a named buffer has matched. The data array of 
4374  * buffer numbers corresponding to the buffer is expected to reside
4375  * in the regexp->data->data array in the slot stored in the ARG() of
4376  * node involved. Note that this routine doesn't actually care about the
4377  * name, that information is not preserved from compilation to execution.
4378  * Returns the index of the leftmost defined buffer with the given name
4379  * or 0 if non of the buffers matched.
4380  */
4381 STATIC I32
4382 S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan)
4383 {
4384     I32 n;
4385     RXi_GET_DECL(rex,rexi);
4386     SV *sv_dat= MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
4387     I32 *nums=(I32*)SvPVX(sv_dat);
4388
4389     PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED;
4390
4391     for ( n=0; n<SvIVX(sv_dat); n++ ) {
4392         if ((I32)rex->lastparen >= nums[n] &&
4393             rex->offs[nums[n]].end != -1)
4394         {
4395             return nums[n];
4396         }
4397     }
4398     return 0;
4399 }
4400
4401
4402 static bool
4403 S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p,
4404         U8* c1_utf8, int *c2p, U8* c2_utf8, regmatch_info *reginfo)
4405 {
4406     /* This function determines if there are one or two characters that match
4407      * the first character of the passed-in EXACTish node <text_node>, and if
4408      * so, returns them in the passed-in pointers.
4409      *
4410      * If it determines that no possible character in the target string can
4411      * match, it returns FALSE; otherwise TRUE.  (The FALSE situation occurs if
4412      * the first character in <text_node> requires UTF-8 to represent, and the
4413      * target string isn't in UTF-8.)
4414      *
4415      * If there are more than two characters that could match the beginning of
4416      * <text_node>, or if more context is required to determine a match or not,
4417      * it sets both *<c1p> and *<c2p> to CHRTEST_VOID.
4418      *
4419      * The motiviation behind this function is to allow the caller to set up
4420      * tight loops for matching.  If <text_node> is of type EXACT, there is
4421      * only one possible character that can match its first character, and so
4422      * the situation is quite simple.  But things get much more complicated if
4423      * folding is involved.  It may be that the first character of an EXACTFish
4424      * node doesn't participate in any possible fold, e.g., punctuation, so it
4425      * can be matched only by itself.  The vast majority of characters that are
4426      * in folds match just two things, their lower and upper-case equivalents.
4427      * But not all are like that; some have multiple possible matches, or match
4428      * sequences of more than one character.  This function sorts all that out.
4429      *
4430      * Consider the patterns A*B or A*?B where A and B are arbitrary.  In a
4431      * loop of trying to match A*, we know we can't exit where the thing
4432      * following it isn't a B.  And something can't be a B unless it is the
4433      * beginning of B.  By putting a quick test for that beginning in a tight
4434      * loop, we can rule out things that can't possibly be B without having to
4435      * break out of the loop, thus avoiding work.  Similarly, if A is a single
4436      * character, we can make a tight loop matching A*, using the outputs of
4437      * this function.
4438      *
4439      * If the target string to match isn't in UTF-8, and there aren't
4440      * complications which require CHRTEST_VOID, *<c1p> and *<c2p> are set to
4441      * the one or two possible octets (which are characters in this situation)
4442      * that can match.  In all cases, if there is only one character that can
4443      * match, *<c1p> and *<c2p> will be identical.
4444      *
4445      * If the target string is in UTF-8, the buffers pointed to by <c1_utf8>
4446      * and <c2_utf8> will contain the one or two UTF-8 sequences of bytes that
4447      * can match the beginning of <text_node>.  They should be declared with at
4448      * least length UTF8_MAXBYTES+1.  (If the target string isn't in UTF-8, it is
4449      * undefined what these contain.)  If one or both of the buffers are
4450      * invariant under UTF-8, *<c1p>, and *<c2p> will also be set to the
4451      * corresponding invariant.  If variant, the corresponding *<c1p> and/or
4452      * *<c2p> will be set to a negative number(s) that shouldn't match any code
4453      * point (unless inappropriately coerced to unsigned).   *<c1p> will equal
4454      * *<c2p> if and only if <c1_utf8> and <c2_utf8> are the same. */
4455
4456     const bool utf8_target = reginfo->is_utf8_target;
4457
4458     UV c1 = (UV)CHRTEST_NOT_A_CP_1;
4459     UV c2 = (UV)CHRTEST_NOT_A_CP_2;
4460     bool use_chrtest_void = FALSE;
4461     const bool is_utf8_pat = reginfo->is_utf8_pat;
4462
4463     /* Used when we have both utf8 input and utf8 output, to avoid converting
4464      * to/from code points */
4465     bool utf8_has_been_setup = FALSE;
4466
4467     dVAR;
4468
4469     U8 *pat = (U8*)STRING(text_node);
4470     U8 folded[UTF8_MAX_FOLD_CHAR_EXPAND * UTF8_MAXBYTES_CASE + 1] = { '\0' };
4471
4472     if (OP(text_node) == EXACT || OP(text_node) == EXACTL) {
4473
4474         /* In an exact node, only one thing can be matched, that first
4475          * character.  If both the pat and the target are UTF-8, we can just
4476          * copy the input to the output, avoiding finding the code point of
4477          * that character */
4478         if (!is_utf8_pat) {
4479             c2 = c1 = *pat;
4480         }
4481         else if (utf8_target) {
4482             Copy(pat, c1_utf8, UTF8SKIP(pat), U8);
4483             Copy(pat, c2_utf8, UTF8SKIP(pat), U8);
4484             utf8_has_been_setup = TRUE;
4485         }
4486         else {
4487             c2 = c1 = valid_utf8_to_uvchr(pat, NULL);
4488         }
4489     }
4490     else { /* an EXACTFish node */
4491         U8 *pat_end = pat + STR_LEN(text_node);
4492
4493         /* An EXACTFL node has at least some characters unfolded, because what
4494          * they match is not known until now.  So, now is the time to fold
4495          * the first few of them, as many as are needed to determine 'c1' and
4496          * 'c2' later in the routine.  If the pattern isn't UTF-8, we only need
4497          * to fold if in a UTF-8 locale, and then only the Sharp S; everything
4498          * else is 1-1 and isn't assumed to be folded.  In a UTF-8 pattern, we
4499          * need to fold as many characters as a single character can fold to,
4500          * so that later we can check if the first ones are such a multi-char
4501          * fold.  But, in such a pattern only locale-problematic characters
4502          * aren't folded, so we can skip this completely if the first character
4503          * in the node isn't one of the tricky ones */
4504         if (OP(text_node) == EXACTFL) {
4505
4506             if (! is_utf8_pat) {
4507                 if (IN_UTF8_CTYPE_LOCALE && *pat == LATIN_SMALL_LETTER_SHARP_S)
4508                 {
4509                     folded[0] = folded[1] = 's';
4510                     pat = folded;
4511                     pat_end = folded + 2;
4512                 }
4513             }
4514             else if (is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8(pat)) {
4515                 U8 *s = pat;
4516                 U8 *d = folded;
4517                 int i;
4518
4519                 for (i = 0; i < UTF8_MAX_FOLD_CHAR_EXPAND && s < pat_end; i++) {
4520                     if (isASCII(*s)) {
4521                         *(d++) = (U8) toFOLD_LC(*s);
4522                         s++;
4523                     }
4524                     else {
4525                         STRLEN len;
4526                         _toFOLD_utf8_flags(s,
4527                                            pat_end,
4528                                            d,
4529                                            &len,
4530                                            FOLD_FLAGS_FULL | FOLD_FLAGS_LOCALE);
4531                         d += len;
4532                         s += UTF8SKIP(s);
4533                     }
4534                 }
4535
4536                 pat = folded;
4537                 pat_end = d;
4538             }
4539         }
4540
4541         if ((is_utf8_pat && is_MULTI_CHAR_FOLD_utf8_safe(pat, pat_end))
4542              || (!is_utf8_pat && is_MULTI_CHAR_FOLD_latin1_safe(pat, pat_end)))
4543         {
4544             /* Multi-character folds require more context to sort out.  Also
4545              * PL_utf8_foldclosures used below doesn't handle them, so have to
4546              * be handled outside this routine */
4547             use_chrtest_void = TRUE;
4548         }
4549         else { /* an EXACTFish node which doesn't begin with a multi-char fold */
4550             c1 = is_utf8_pat ? valid_utf8_to_uvchr(pat, NULL) : *pat;
4551             if (c1 > 255) {
4552                 const unsigned int * remaining_folds_to_list;
4553                 unsigned int first_folds_to;
4554
4555                 /* Look up what code points (besides c1) fold to c1;  e.g.,
4556                  * [ 'K', KELVIN_SIGN ] both fold to 'k'. */
4557                 Size_t folds_to_count = _inverse_folds(c1,
4558                                                      &first_folds_to,
4559                                                      &remaining_folds_to_list);
4560                 if (folds_to_count == 0) {
4561                     c2 = c1;    /* there is only a single character that could
4562                                    match */
4563                 }
4564                 else if (folds_to_count != 1) {
4565                     /* If there aren't exactly two folds to this (itself and
4566                      * another), it is outside the scope of this function */
4567                     use_chrtest_void = TRUE;
4568                 }
4569                 else {  /* There are two.  We already have one, get the other */
4570                     c2 = first_folds_to;
4571
4572                     /* Folds that cross the 255/256 boundary are forbidden if
4573                      * EXACTFL (and isnt a UTF8 locale), or EXACTFAA and one is
4574                      * ASCIII.  The only other match to c1 is c2, and since c1
4575                      * is above 255, c2 better be as well under these
4576                      * circumstances.  If it isn't, it means the only legal
4577                      * match of c1 is itself. */
4578                     if (    c2 < 256
4579                         && (   (   OP(text_node) == EXACTFL
4580                                 && ! IN_UTF8_CTYPE_LOCALE)
4581                             || ((     OP(text_node) == EXACTFAA
4582                                    || OP(text_node) == EXACTFAA_NO_TRIE)
4583                                 && (isASCII(c1) || isASCII(c2)))))
4584                     {
4585                         c2 = c1;
4586                     }
4587                 }
4588             }
4589             else /* Here, c1 is <= 255 */
4590                 if (utf8_target
4591                     && HAS_NONLATIN1_FOLD_CLOSURE(c1)
4592                     && ( ! (OP(text_node) == EXACTFL && ! IN_UTF8_CTYPE_LOCALE))
4593                     && ((OP(text_node) != EXACTFAA
4594                         && OP(text_node) != EXACTFAA_NO_TRIE)
4595                         || ! isASCII(c1)))
4596             {
4597                 /* Here, there could be something above Latin1 in the target
4598                  * which folds to this character in the pattern.  All such
4599                  * cases except LATIN SMALL LETTER Y WITH DIAERESIS have more
4600                  * than two characters involved in their folds, so are outside
4601                  * the scope of this function */
4602                 if (UNLIKELY(c1 == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
4603                     c2 = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS;
4604                 }
4605                 else {
4606                     use_chrtest_void = TRUE;
4607                 }
4608             }
4609             else { /* Here nothing above Latin1 can fold to the pattern
4610                       character */
4611                 switch (OP(text_node)) {
4612
4613                     case EXACTFL:   /* /l rules */
4614                         c2 = PL_fold_locale[c1];
4615                         break;
4616
4617                     case EXACTF:   /* This node only generated for non-utf8
4618                                     patterns */
4619                         assert(! is_utf8_pat);
4620                         if (! utf8_target) {    /* /d rules */
4621                             c2 = PL_fold[c1];
4622                             break;
4623                         }
4624                         /* FALLTHROUGH */
4625                         /* /u rules for all these.  This happens to work for
4626                         * EXACTFAA as nothing in Latin1 folds to ASCII */
4627                     case EXACTFAA_NO_TRIE:   /* This node only generated for
4628                                                 non-utf8 patterns */
4629                         assert(! is_utf8_pat);
4630                         /* FALLTHROUGH */
4631                     case EXACTFAA:
4632                     case EXACTFU_SS:
4633                     case EXACTFU:
4634                         c2 = PL_fold_latin1[c1];
4635                         break;
4636
4637                     default:
4638                         Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node));
4639                         NOT_REACHED; /* NOTREACHED */
4640                 }
4641             }
4642         }
4643     }
4644
4645     /* Here have figured things out.  Set up the returns */
4646     if (use_chrtest_void) {
4647         *c2p = *c1p = CHRTEST_VOID;
4648     }
4649     else if (utf8_target) {
4650         if (! utf8_has_been_setup) {    /* Don't have the utf8; must get it */
4651             uvchr_to_utf8(c1_utf8, c1);
4652             uvchr_to_utf8(c2_utf8, c2);
4653         }
4654
4655         /* Invariants are stored in both the utf8 and byte outputs; Use
4656          * negative numbers otherwise for the byte ones.  Make sure that the
4657          * byte ones are the same iff the utf8 ones are the same */
4658         *c1p = (UTF8_IS_INVARIANT(*c1_utf8)) ? *c1_utf8 : CHRTEST_NOT_A_CP_1;
4659         *c2p = (UTF8_IS_INVARIANT(*c2_utf8))
4660                 ? *c2_utf8
4661                 : (c1 == c2)
4662                   ? CHRTEST_NOT_A_CP_1
4663                   : CHRTEST_NOT_A_CP_2;
4664     }
4665     else if (c1 > 255) {
4666        if (c2 > 255) {  /* both possibilities are above what a non-utf8 string
4667                            can represent */
4668            return FALSE;
4669        }
4670
4671        *c1p = *c2p = c2;    /* c2 is the only representable value */
4672     }
4673     else {  /* c1 is representable; see about c2 */
4674        *c1p = c1;
4675        *c2p = (c2 < 256) ? c2 : c1;
4676     }
4677
4678     return TRUE;
4679 }
4680
4681 STATIC bool
4682 S_isGCB(pTHX_ const GCB_enum before, const GCB_enum after, const U8 * const strbeg, const U8 * const curpos, const bool utf8_target)
4683 {
4684     /* returns a boolean indicating if there is a Grapheme Cluster Boundary
4685      * between the inputs.  See http://www.unicode.org/reports/tr29/. */
4686
4687     PERL_ARGS_ASSERT_ISGCB;
4688
4689     switch (GCB_table[before][after]) {
4690         case GCB_BREAKABLE:
4691             return TRUE;
4692
4693         case GCB_NOBREAK:
4694             return FALSE;
4695
4696         case GCB_RI_then_RI:
4697             {
4698                 int RI_count = 1;
4699                 U8 * temp_pos = (U8 *) curpos;
4700
4701                 /* Do not break within emoji flag sequences. That is, do not
4702                  * break between regional indicator (RI) symbols if there is an
4703                  * odd number of RI characters before the break point.
4704                  *  GB12   sot (RI RI)* RI Ã— RI
4705                  *  GB13 [^RI] (RI RI)* RI Ã— RI */
4706
4707                 while (backup_one_GCB(strbeg,
4708                                     &temp_pos,
4709                                     utf8_target) == GCB_Regional_Indicator)
4710                 {
4711                     RI_count++;
4712                 }
4713
4714                 return RI_count % 2 != 1;
4715             }
4716
4717         case GCB_EX_then_EM:
4718
4719             /* GB10  ( E_Base | E_Base_GAZ ) Extend* Ã—  E_Modifier */
4720             {
4721                 U8 * temp_pos = (U8 *) curpos;
4722                 GCB_enum prev;
4723
4724                 do {
4725                     prev = backup_one_GCB(strbeg, &temp_pos, utf8_target);
4726                 }
4727                 while (prev == GCB_Extend);
4728
4729                 return prev != GCB_E_Base && prev != GCB_E_Base_GAZ;
4730             }
4731
4732         case GCB_Maybe_Emoji_NonBreak:
4733
4734             {
4735
4736             /* Do not break within emoji modifier sequences or emoji zwj sequences.
4737               GB11 \p{Extended_Pictographic} Extend* ZWJ Ã— \p{Extended_Pictographic}
4738               */
4739                 U8 * temp_pos = (U8 *) curpos;
4740                 GCB_enum prev;
4741
4742                 do {
4743                     prev = backup_one_GCB(strbeg, &temp_pos, utf8_target);
4744                 }
4745                 while (prev == GCB_Extend);
4746
4747                 return prev != GCB_XPG_XX;
4748             }
4749
4750         default:
4751             break;
4752     }
4753
4754 #ifdef DEBUGGING
4755     Perl_re_printf( aTHX_  "Unhandled GCB pair: GCB_table[%d, %d] = %d\n",
4756                                   before, after, GCB_table[before][after]);
4757     assert(0);
4758 #endif
4759     return TRUE;
4760 }
4761
4762 STATIC GCB_enum
4763 S_backup_one_GCB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
4764 {
4765     GCB_enum gcb;
4766
4767     PERL_ARGS_ASSERT_BACKUP_ONE_GCB;
4768
4769     if (*curpos < strbeg) {
4770         return GCB_EDGE;
4771     }
4772
4773     if (utf8_target) {
4774         U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg);
4775         U8 * prev_prev_char_pos;
4776
4777         if (! prev_char_pos) {
4778             return GCB_EDGE;
4779         }
4780
4781         if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos, -1, strbeg))) {
4782             gcb = getGCB_VAL_UTF8(prev_prev_char_pos, prev_char_pos);
4783             *curpos = prev_char_pos;
4784             prev_char_pos = prev_prev_char_pos;
4785         }
4786         else {
4787             *curpos = (U8 *) strbeg;
4788             return GCB_EDGE;
4789         }
4790     }
4791     else {
4792         if (*curpos - 2 < strbeg) {
4793             *curpos = (U8 *) strbeg;
4794             return GCB_EDGE;
4795         }
4796         (*curpos)--;
4797         gcb = getGCB_VAL_CP(*(*curpos - 1));
4798     }
4799
4800     return gcb;
4801 }
4802
4803 /* Combining marks attach to most classes that precede them, but this defines
4804  * the exceptions (from TR14) */
4805 #define LB_CM_ATTACHES_TO(prev) ( ! (   prev == LB_EDGE                 \
4806                                      || prev == LB_Mandatory_Break      \
4807                                      || prev == LB_Carriage_Return      \
4808                                      || prev == LB_Line_Feed            \
4809                                      || prev == LB_Next_Line            \
4810                                      || prev == LB_Space                \
4811                                      || prev == LB_ZWSpace))
4812
4813 STATIC bool
4814 S_isLB(pTHX_ LB_enum before,
4815              LB_enum after,
4816              const U8 * const strbeg,
4817              const U8 * const curpos,
4818              const U8 * const strend,
4819              const bool utf8_target)
4820 {
4821     U8 * temp_pos = (U8 *) curpos;
4822     LB_enum prev = before;
4823
4824     /* Is the boundary between 'before' and 'after' line-breakable?
4825      * Most of this is just a table lookup of a generated table from Unicode
4826      * rules.  But some rules require context to decide, and so have to be
4827      * implemented in code */
4828
4829     PERL_ARGS_ASSERT_ISLB;
4830
4831     /* Rule numbers in the comments below are as of Unicode 9.0 */
4832
4833   redo:
4834     before = prev;
4835     switch (LB_table[before][after]) {
4836         case LB_BREAKABLE:
4837             return TRUE;
4838
4839         case LB_NOBREAK:
4840         case LB_NOBREAK_EVEN_WITH_SP_BETWEEN:
4841             return FALSE;
4842
4843         case LB_SP_foo + LB_BREAKABLE:
4844         case LB_SP_foo + LB_NOBREAK:
4845         case LB_SP_foo + LB_NOBREAK_EVEN_WITH_SP_BETWEEN:
4846
4847             /* When we have something following a SP, we have to look at the
4848              * context in order to know what to do.
4849              *
4850              * SP SP should not reach here because LB7: Do not break before
4851              * spaces.  (For two spaces in a row there is nothing that
4852              * overrides that) */
4853             assert(after != LB_Space);
4854
4855             /* Here we have a space followed by a non-space.  Mostly this is a
4856              * case of LB18: "Break after spaces".  But there are complications
4857              * as the handling of spaces is somewhat tricky.  They are in a
4858              * number of rules, which have to be applied in priority order, but
4859              * something earlier in the string can cause a rule to be skipped
4860              * and a lower priority rule invoked.  A prime example is LB7 which
4861              * says don't break before a space.  But rule LB8 (lower priority)
4862              * says that the first break opportunity after a ZW is after any
4863              * span of spaces immediately after it.  If a ZW comes before a SP
4864              * in the input, rule LB8 applies, and not LB7.  Other such rules
4865              * involve combining marks which are rules 9 and 10, but they may
4866              * override higher priority rules if they come earlier in the
4867              * string.  Since we're doing random access into the middle of the
4868              * string, we have to look for rules that should get applied based
4869              * on both string position and priority.  Combining marks do not
4870              * attach to either ZW nor SP, so we don't have to consider them
4871              * until later.
4872              *
4873              * To check for LB8, we have to find the first non-space character
4874              * before this span of spaces */
4875             do {
4876                 prev = backup_one_LB(strbeg, &temp_pos, utf8_target);
4877             }
4878             while (prev == LB_Space);
4879
4880             /* LB8 Break before any character following a zero-width space,
4881              * even if one or more spaces intervene.
4882              *      ZW SP* Ã·
4883              * So if we have a ZW just before this span, and to get here this
4884              * is the final space in the span. */
4885             if (prev == LB_ZWSpace) {
4886                 return TRUE;
4887             }
4888
4889             /* Here, not ZW SP+.  There are several rules that have higher
4890              * priority than LB18 and can be resolved now, as they don't depend
4891              * on anything earlier in the string (except ZW, which we have
4892              * already handled).  One of these rules is LB11 Do not break
4893              * before Word joiner, but we have specially encoded that in the
4894              * lookup table so it is caught by the single test below which
4895              * catches the other ones. */
4896             if (LB_table[LB_Space][after] - LB_SP_foo
4897                                             == LB_NOBREAK_EVEN_WITH_SP_BETWEEN)
4898             {
4899                 return FALSE;
4900             }
4901
4902             /* If we get here, we have to XXX consider combining marks. */
4903             if (prev == LB_Combining_Mark) {
4904
4905                 /* What happens with these depends on the character they
4906                  * follow.  */
4907                 do {
4908                     prev = backup_one_LB(strbeg, &temp_pos, utf8_target);
4909                 }
4910                 while (prev == LB_Combining_Mark);
4911
4912                 /* Most times these attach to and inherit the characteristics
4913                  * of that character, but not always, and when not, they are to
4914                  * be treated as AL by rule LB10. */
4915                 if (! LB_CM_ATTACHES_TO(prev)) {
4916                     prev = LB_Alphabetic;
4917                 }
4918             }
4919
4920             /* Here, we have the character preceding the span of spaces all set
4921              * up.  We follow LB18: "Break after spaces" unless the table shows
4922              * that is overriden */
4923             return LB_table[prev][after] != LB_NOBREAK_EVEN_WITH_SP_BETWEEN;
4924
4925         case LB_CM_ZWJ_foo:
4926
4927             /* We don't know how to treat the CM except by looking at the first
4928              * non-CM character preceding it.  ZWJ is treated as CM */
4929             do {
4930                 prev = backup_one_LB(strbeg, &temp_pos, utf8_target);
4931             }
4932             while (prev == LB_Combining_Mark || prev == LB_ZWJ);
4933
4934             /* Here, 'prev' is that first earlier non-CM character.  If the CM
4935              * attatches to it, then it inherits the behavior of 'prev'.  If it
4936              * doesn't attach, it is to be treated as an AL */
4937             if (! LB_CM_ATTACHES_TO(prev)) {
4938                 prev = LB_Alphabetic;
4939             }
4940
4941             goto redo;
4942
4943         case LB_HY_or_BA_then_foo + LB_BREAKABLE:
4944         case LB_HY_or_BA_then_foo + LB_NOBREAK:
4945
4946             /* LB21a Don't break after Hebrew + Hyphen.
4947              * HL (HY | BA) Ã— */
4948
4949             if (backup_one_LB(strbeg, &temp_pos, utf8_target)
4950                                                           == LB_Hebrew_Letter)
4951             {
4952                 return FALSE;
4953             }
4954
4955             return LB_table[prev][after] - LB_HY_or_BA_then_foo == LB_BREAKABLE;
4956
4957         case LB_PR_or_PO_then_OP_or_HY + LB_BREAKABLE:
4958         case LB_PR_or_PO_then_OP_or_HY + LB_NOBREAK:
4959
4960             /* LB25a (PR | PO) Ã— ( OP | HY )? NU */
4961             if (advance_one_LB(&temp_pos, strend, utf8_target) == LB_Numeric) {
4962                 return FALSE;
4963             }
4964
4965             return LB_table[prev][after] - LB_PR_or_PO_then_OP_or_HY
4966                                                                 == LB_BREAKABLE;
4967
4968         case LB_SY_or_IS_then_various + LB_BREAKABLE:
4969         case LB_SY_or_IS_then_various + LB_NOBREAK:
4970         {
4971             /* LB25d NU (SY | IS)* Ã— (NU | SY | IS | CL | CP ) */
4972
4973             LB_enum temp = prev;
4974             do {
4975                 temp = backup_one_LB(strbeg, &temp_pos, utf8_target);
4976             }
4977             while (temp == LB_Break_Symbols || temp == LB_Infix_Numeric);
4978             if (temp == LB_Numeric) {
4979                 return FALSE;
4980             }
4981
4982             return LB_table[prev][after] - LB_SY_or_IS_then_various
4983                                                                == LB_BREAKABLE;
4984         }
4985
4986         case LB_various_then_PO_or_PR + LB_BREAKABLE:
4987         case LB_various_then_PO_or_PR + LB_NOBREAK:
4988         {
4989             /* LB25e NU (SY | IS)* (CL | CP)? Ã— (PO | PR) */
4990
4991             LB_enum temp = prev;
4992             if (temp == LB_Close_Punctuation || temp == LB_Close_Parenthesis)
4993             {
4994                 temp = backup_one_LB(strbeg, &temp_pos, utf8_target);
4995             }
4996             while (temp == LB_Break_Symbols || temp == LB_Infix_Numeric) {
4997                 temp = backup_one_LB(strbeg, &temp_pos, utf8_target);
4998             }
4999             if (temp == LB_Numeric) {
5000                 return FALSE;
5001             }
5002             return LB_various_then_PO_or_PR;
5003         }
5004
5005         case LB_RI_then_RI + LB_NOBREAK:
5006         case LB_RI_then_RI + LB_BREAKABLE:
5007             {
5008                 int RI_count = 1;
5009
5010                 /* LB30a Break between two regional indicator symbols if and
5011                  * only if there are an even number of regional indicators
5012                  * preceding the position of the break.
5013                  *
5014                  *    sot (RI RI)* RI Ã— RI
5015                  *  [^RI] (RI RI)* RI Ã— RI */
5016
5017                 while (backup_one_LB(strbeg,
5018                                      &temp_pos,
5019                                      utf8_target) == LB_Regional_Indicator)
5020                 {
5021                     RI_count++;
5022                 }
5023
5024                 return RI_count % 2 == 0;
5025             }
5026
5027         default:
5028             break;
5029     }
5030
5031 #ifdef DEBUGGING
5032     Perl_re_printf( aTHX_  "Unhandled LB pair: LB_table[%d, %d] = %d\n",
5033                                   before, after, LB_table[before][after]);
5034     assert(0);
5035 #endif
5036     return TRUE;
5037 }
5038
5039 STATIC LB_enum
5040 S_advance_one_LB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
5041 {
5042     LB_enum lb;
5043
5044     PERL_ARGS_ASSERT_ADVANCE_ONE_LB;
5045
5046     if (*curpos >= strend) {
5047         return LB_EDGE;
5048     }
5049
5050     if (utf8_target) {
5051         *curpos += UTF8SKIP(*curpos);
5052         if (*curpos >= strend) {
5053             return LB_EDGE;
5054         }
5055         lb = getLB_VAL_UTF8(*curpos, strend);
5056     }
5057     else {
5058         (*curpos)++;
5059         if (*curpos >= strend) {
5060             return LB_EDGE;
5061         }
5062         lb = getLB_VAL_CP(**curpos);
5063     }
5064
5065     return lb;
5066 }
5067
5068 STATIC LB_enum
5069 S_backup_one_LB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
5070 {
5071     LB_enum lb;
5072
5073     PERL_ARGS_ASSERT_BACKUP_ONE_LB;
5074
5075     if (*curpos < strbeg) {
5076         return LB_EDGE;
5077     }
5078
5079     if (utf8_target) {
5080         U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg);
5081         U8 * prev_prev_char_pos;
5082
5083         if (! prev_char_pos) {
5084             return LB_EDGE;
5085         }
5086
5087         if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos, -1, strbeg))) {
5088             lb = getLB_VAL_UTF8(prev_prev_char_pos, prev_char_pos);
5089             *curpos = prev_char_pos;
5090             prev_char_pos = prev_prev_char_pos;
5091         }
5092         else {
5093             *curpos = (U8 *) strbeg;
5094             return LB_EDGE;
5095         }
5096     }
5097     else {
5098         if (*curpos - 2 < strbeg) {
5099             *curpos = (U8 *) strbeg;
5100             return LB_EDGE;
5101         }
5102         (*curpos)--;
5103         lb = getLB_VAL_CP(*(*curpos - 1));
5104     }
5105
5106     return lb;
5107 }
5108
5109 STATIC bool
5110 S_isSB(pTHX_ SB_enum before,
5111              SB_enum after,
5112              const U8 * const strbeg,
5113              const U8 * const curpos,
5114              const U8 * const strend,
5115              const bool utf8_target)
5116 {
5117     /* returns a boolean indicating if there is a Sentence Boundary Break
5118      * between the inputs.  See http://www.unicode.org/reports/tr29/ */
5119
5120     U8 * lpos = (U8 *) curpos;
5121     bool has_para_sep = FALSE;
5122     bool has_sp = FALSE;
5123
5124     PERL_ARGS_ASSERT_ISSB;
5125
5126     /* Break at the start and end of text.
5127         SB1.  sot  Ã·
5128         SB2.  Ã·  eot
5129       But unstated in Unicode is don't break if the text is empty */
5130     if (before == SB_EDGE || after == SB_EDGE) {
5131         return before != after;
5132     }
5133
5134     /* SB 3: Do not break within CRLF. */
5135     if (before == SB_CR && after == SB_LF) {
5136         return FALSE;
5137     }
5138
5139     /* Break after paragraph separators.  CR and LF are considered
5140      * so because Unicode views text as like word processing text where there
5141      * are no newlines except between paragraphs, and the word processor takes
5142      * care of wrapping without there being hard line-breaks in the text *./
5143        SB4.  Sep | CR | LF  Ã· */
5144     if (before == SB_Sep || before == SB_CR || before == SB_LF) {
5145         return TRUE;
5146     }
5147
5148     /* Ignore Format and Extend characters, except after sot, Sep, CR, or LF.
5149      * (See Section 6.2, Replacing Ignore Rules.)
5150         SB5.  X (Extend | Format)*  â†’  X */
5151     if (after == SB_Extend || after == SB_Format) {
5152
5153         /* Implied is that the these characters attach to everything
5154          * immediately prior to them except for those separator-type
5155          * characters.  And the rules earlier have already handled the case
5156          * when one of those immediately precedes the extend char */
5157         return FALSE;
5158     }
5159
5160     if (before == SB_Extend || before == SB_Format) {
5161         U8 * temp_pos = lpos;
5162         const SB_enum backup = backup_one_SB(strbeg, &temp_pos, utf8_target);
5163         if (   backup != SB_EDGE
5164             && backup != SB_Sep
5165             && backup != SB_CR
5166             && backup != SB_LF)
5167         {
5168             before = backup;
5169             lpos = temp_pos;
5170         }
5171
5172         /* Here, both 'before' and 'backup' are these types; implied is that we
5173          * don't break between them */
5174         if (backup == SB_Extend || backup == SB_Format) {
5175             return FALSE;
5176         }
5177     }
5178
5179     /* Do not break after ambiguous terminators like period, if they are
5180      * immediately followed by a number or lowercase letter, if they are
5181      * between uppercase letters, if the first following letter (optionally
5182      * after certain punctuation) is lowercase, or if they are followed by
5183      * "continuation" punctuation such as comma, colon, or semicolon. For
5184      * example, a period may be an abbreviation or numeric period, and thus may
5185      * not mark the end of a sentence.
5186
5187      * SB6. ATerm  Ã—  Numeric */
5188     if (before == SB_ATerm && after == SB_Numeric) {
5189         return FALSE;
5190     }
5191
5192     /* SB7.  (Upper | Lower) ATerm  Ã—  Upper */
5193     if (before == SB_ATerm && after == SB_Upper) {
5194         U8 * temp_pos = lpos;
5195         SB_enum backup = backup_one_SB(strbeg, &temp_pos, utf8_target);
5196         if (backup == SB_Upper || backup == SB_Lower) {
5197             return FALSE;
5198         }
5199     }
5200
5201     /* The remaining rules that aren't the final one, all require an STerm or
5202      * an ATerm after having backed up over some Close* Sp*, and in one case an
5203      * optional Paragraph separator, although one rule doesn't have any Sp's in it.
5204      * So do that backup now, setting flags if either Sp or a paragraph
5205      * separator are found */
5206
5207     if (before == SB_Sep || before == SB_CR || before == SB_LF) {
5208         has_para_sep = TRUE;
5209         before = backup_one_SB(strbeg, &lpos, utf8_target);
5210     }
5211
5212     if (before == SB_Sp) {
5213         has_sp = TRUE;
5214         do {
5215             before = backup_one_SB(strbeg, &lpos, utf8_target);
5216         }
5217         while (before == SB_Sp);
5218     }
5219
5220     while (before == SB_Close) {
5221         before = backup_one_SB(strbeg, &lpos, utf8_target);
5222     }
5223
5224     /* The next few rules apply only when the backed-up-to is an ATerm, and in
5225      * most cases an STerm */
5226     if (before == SB_STerm || before == SB_ATerm) {
5227
5228         /* So, here the lhs matches
5229          *      (STerm | ATerm) Close* Sp* (Sep | CR | LF)?
5230          * and we have set flags if we found an Sp, or the optional Sep,CR,LF.
5231          * The rules that apply here are:
5232          *
5233          * SB8    ATerm Close* Sp*  Ã—  ( Â¬(OLetter | Upper | Lower | Sep | CR
5234                                            | LF | STerm | ATerm) )* Lower
5235            SB8a  (STerm | ATerm) Close* Sp*  Ã—  (SContinue | STerm | ATerm)
5236            SB9   (STerm | ATerm) Close*  Ã—  (Close | Sp | Sep | CR | LF)
5237            SB10  (STerm | ATerm) Close* Sp*  Ã—  (Sp | Sep | CR | LF)
5238            SB11  (STerm | ATerm) Close* Sp* (Sep | CR | LF)?  Ã·
5239          */
5240
5241         /* And all but SB11 forbid having seen a paragraph separator */
5242         if (! has_para_sep) {
5243             if (before == SB_ATerm) {          /* SB8 */
5244                 U8 * rpos = (U8 *) curpos;
5245                 SB_enum later = after;
5246
5247                 while (    later != SB_OLetter
5248                         && later != SB_Upper
5249                         && later != SB_Lower
5250                         && later != SB_Sep
5251                         && later != SB_CR
5252                         && later != SB_LF
5253                         && later != SB_STerm
5254                         && later != SB_ATerm
5255                         && later != SB_EDGE)
5256                 {
5257                     later = advance_one_SB(&rpos, strend, utf8_target);
5258                 }
5259                 if (later == SB_Lower) {
5260                     return FALSE;
5261                 }
5262             }
5263
5264             if (   after == SB_SContinue    /* SB8a */
5265                 || after == SB_STerm
5266                 || after == SB_ATerm)
5267             {
5268                 return FALSE;
5269             }
5270
5271             if (! has_sp) {     /* SB9 applies only if there was no Sp* */
5272                 if (   after == SB_Close
5273                     || after == SB_Sp
5274                     || after == SB_Sep
5275                     || after == SB_CR
5276                     || after == SB_LF)
5277                 {
5278                     return FALSE;
5279                 }
5280             }
5281
5282             /* SB10.  This and SB9 could probably be combined some way, but khw
5283              * has decided to follow the Unicode rule book precisely for
5284              * simplified maintenance */
5285             if (   after == SB_Sp
5286                 || after == SB_Sep
5287                 || after == SB_CR
5288                 || after == SB_LF)
5289             {
5290                 return FALSE;
5291             }
5292         }
5293
5294         /* SB11.  */
5295         return TRUE;
5296     }
5297
5298     /* Otherwise, do not break.
5299     SB12.  Any  Ã—  Any */
5300
5301     return FALSE;
5302 }
5303
5304 STATIC SB_enum
5305 S_advance_one_SB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
5306 {
5307     SB_enum sb;
5308
5309     PERL_ARGS_ASSERT_ADVANCE_ONE_SB;
5310
5311     if (*curpos >= strend) {
5312         return SB_EDGE;
5313     }
5314
5315     if (utf8_target) {
5316         do {
5317             *curpos += UTF8SKIP(*curpos);
5318             if (*curpos >= strend) {
5319                 return SB_EDGE;
5320             }
5321             sb = getSB_VAL_UTF8(*curpos, strend);
5322         } while (sb == SB_Extend || sb == SB_Format);
5323     }
5324     else {
5325         do {
5326             (*curpos)++;
5327             if (*curpos >= strend) {
5328                 return SB_EDGE;
5329             }
5330             sb = getSB_VAL_CP(**curpos);
5331         } while (sb == SB_Extend || sb == SB_Format);
5332     }
5333
5334     return sb;
5335 }
5336
5337 STATIC SB_enum
5338 S_backup_one_SB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
5339 {
5340     SB_enum sb;
5341
5342     PERL_ARGS_ASSERT_BACKUP_ONE_SB;
5343
5344     if (*curpos < strbeg) {
5345         return SB_EDGE;
5346     }
5347
5348     if (utf8_target) {
5349         U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg);
5350         if (! prev_char_pos) {
5351             return SB_EDGE;
5352         }
5353
5354         /* Back up over Extend and Format.  curpos is always just to the right
5355          * of the characater whose value we are getting */
5356         do {
5357             U8 * prev_prev_char_pos;
5358             if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos, -1,
5359                                                                       strbeg)))
5360             {
5361                 sb = getSB_VAL_UTF8(prev_prev_char_pos, prev_char_pos);
5362                 *curpos = prev_char_pos;
5363                 prev_char_pos = prev_prev_char_pos;
5364             }
5365             else {
5366                 *curpos = (U8 *) strbeg;
5367                 return SB_EDGE;
5368             }
5369         } while (sb == SB_Extend || sb == SB_Format);
5370     }
5371     else {
5372         do {
5373             if (*curpos - 2 < strbeg) {
5374                 *curpos = (U8 *) strbeg;
5375                 return SB_EDGE;
5376             }
5377             (*curpos)--;
5378             sb = getSB_VAL_CP(*(*curpos - 1));
5379         } while (sb == SB_Extend || sb == SB_Format);
5380     }
5381
5382     return sb;
5383 }
5384
5385 STATIC bool
5386 S_isWB(pTHX_ WB_enum previous,
5387              WB_enum before,
5388              WB_enum after,
5389              const U8 * const strbeg,
5390              const U8 * const curpos,
5391              const U8 * const strend,
5392              const bool utf8_target)
5393 {
5394     /*  Return a boolean as to if the boundary between 'before' and 'after' is
5395      *  a Unicode word break, using their published algorithm, but tailored for
5396      *  Perl by treating spans of white space as one unit.  Context may be
5397      *  needed to make this determination.  If the value for the character
5398      *  before 'before' is known, it is passed as 'previous'; otherwise that
5399      *  should be set to WB_UNKNOWN.  The other input parameters give the
5400      *  boundaries and current position in the matching of the string.  That
5401      *  is, 'curpos' marks the position where the character whose wb value is
5402      *  'after' begins.  See http://www.unicode.org/reports/tr29/ */
5403
5404     U8 * before_pos = (U8 *) curpos;
5405     U8 * after_pos = (U8 *) curpos;
5406     WB_enum prev = before;
5407     WB_enum next;
5408
5409     PERL_ARGS_ASSERT_ISWB;
5410
5411     /* Rule numbers in the comments below are as of Unicode 9.0 */
5412
5413   redo:
5414     before = prev;
5415     switch (WB_table[before][after]) {
5416         case WB_BREAKABLE:
5417             return TRUE;
5418
5419         case WB_NOBREAK:
5420             return FALSE;
5421
5422         case WB_hs_then_hs:     /* 2 horizontal spaces in a row */
5423             next = advance_one_WB(&after_pos, strend, utf8_target,
5424                                  FALSE /* Don't skip Extend nor Format */ );
5425             /* A space immediately preceeding an Extend or Format is attached
5426              * to by them, and hence gets separated from previous spaces.
5427              * Otherwise don't break between horizontal white space */
5428             return next == WB_Extend || next == WB_Format;
5429
5430         /* WB4 Ignore Format and Extend characters, except when they appear at
5431          * the beginning of a region of text.  This code currently isn't
5432          * general purpose, but it works as the rules are currently and likely
5433          * to be laid out.  The reason it works is that when 'they appear at
5434          * the beginning of a region of text', the rule is to break before
5435          * them, just like any other character.  Therefore, the default rule
5436          * applies and we don't have to look in more depth.  Should this ever
5437          * change, we would have to have 2 'case' statements, like in the rules
5438          * below, and backup a single character (not spacing over the extend
5439          * ones) and then see if that is one of the region-end characters and
5440          * go from there */
5441         case WB_Ex_or_FO_or_ZWJ_then_foo:
5442             prev = backup_one_WB(&previous, strbeg, &before_pos, utf8_target);
5443             goto redo;
5444
5445         case WB_DQ_then_HL + WB_BREAKABLE:
5446         case WB_DQ_then_HL + WB_NOBREAK:
5447
5448             /* WB7c  Hebrew_Letter Double_Quote  Ã—  Hebrew_Letter */
5449
5450             if (backup_one_WB(&previous, strbeg, &before_pos, utf8_target)
5451                                                             == WB_Hebrew_Letter)
5452             {
5453                 return FALSE;
5454             }
5455
5456              return WB_table[before][after] - WB_DQ_then_HL == WB_BREAKABLE;
5457
5458         case WB_HL_then_DQ + WB_BREAKABLE:
5459         case WB_HL_then_DQ + WB_NOBREAK:
5460
5461             /* WB7b  Hebrew_Letter  Ã—  Double_Quote Hebrew_Letter */
5462
5463             if (advance_one_WB(&after_pos, strend, utf8_target,
5464                                        TRUE /* Do skip Extend and Format */ )
5465                                                             == WB_Hebrew_Letter)
5466             {
5467                 return FALSE;
5468             }
5469
5470             return WB_table[before][after] - WB_HL_then_DQ == WB_BREAKABLE;
5471
5472         case WB_LE_or_HL_then_MB_or_ML_or_SQ + WB_NOBREAK:
5473         case WB_LE_or_HL_then_MB_or_ML_or_SQ + WB_BREAKABLE:
5474
5475             /* WB6  (ALetter | Hebrew_Letter)  Ã—  (MidLetter | MidNumLet
5476              *       | Single_Quote) (ALetter | Hebrew_Letter) */
5477
5478             next = advance_one_WB(&after_pos, strend, utf8_target,
5479                                        TRUE /* Do skip Extend and Format */ );
5480
5481             if (next == WB_ALetter || next == WB_Hebrew_Letter)
5482             {
5483                 return FALSE;
5484             }
5485
5486             return WB_table[before][after]
5487                             - WB_LE_or_HL_then_MB_or_ML_or_SQ == WB_BREAKABLE;
5488
5489         case WB_MB_or_ML_or_SQ_then_LE_or_HL + WB_NOBREAK:
5490         case WB_MB_or_ML_or_SQ_then_LE_or_HL + WB_BREAKABLE:
5491
5492             /* WB7  (ALetter | Hebrew_Letter) (MidLetter | MidNumLet
5493              *       | Single_Quote)  Ã—  (ALetter | Hebrew_Letter) */
5494
5495             prev = backup_one_WB(&previous, strbeg, &before_pos, utf8_target);
5496             if (prev == WB_ALetter || prev == WB_Hebrew_Letter)
5497             {
5498                 return FALSE;
5499             }
5500
5501             return WB_table[before][after]
5502                             - WB_MB_or_ML_or_SQ_then_LE_or_HL == WB_BREAKABLE;
5503
5504         case WB_MB_or_MN_or_SQ_then_NU + WB_NOBREAK:
5505         case WB_MB_or_MN_or_SQ_then_NU + WB_BREAKABLE:
5506
5507             /* WB11  Numeric (MidNum | (MidNumLet | Single_Quote))  Ã—  Numeric
5508              * */
5509
5510             if (backup_one_WB(&previous, strbeg, &before_pos, utf8_target)
5511                                                             == WB_Numeric)
5512             {
5513                 return FALSE;
5514             }
5515
5516             return WB_table[before][after]
5517                                 - WB_MB_or_MN_or_SQ_then_NU == WB_BREAKABLE;
5518
5519         case WB_NU_then_MB_or_MN_or_SQ + WB_NOBREAK:
5520         case WB_NU_then_MB_or_MN_or_SQ + WB_BREAKABLE:
5521
5522             /* WB12  Numeric  Ã—  (MidNum | MidNumLet | Single_Quote) Numeric */
5523
5524             if (advance_one_WB(&after_pos, strend, utf8_target,
5525                                        TRUE /* Do skip Extend and Format */ )
5526                                                             == WB_Numeric)
5527             {
5528                 return FALSE;
5529             }
5530
5531             return WB_table[before][after]
5532                                 - WB_NU_then_MB_or_MN_or_SQ == WB_BREAKABLE;
5533
5534         case WB_RI_then_RI + WB_NOBREAK:
5535         case WB_RI_then_RI + WB_BREAKABLE:
5536             {
5537                 int RI_count = 1;
5538
5539                 /* Do not break within emoji flag sequences. That is, do not
5540                  * break between regional indicator (RI) symbols if there is an
5541                  * odd number of RI characters before the potential break
5542                  * point.
5543                  *
5544                  * WB15   sot (RI RI)* RI Ã— RI
5545                  * WB16 [^RI] (RI RI)* RI Ã— RI */
5546
5547                 while (backup_one_WB(&previous,
5548                                      strbeg,
5549                                      &before_pos,
5550                                      utf8_target) == WB_Regional_Indicator)
5551                 {
5552                     RI_count++;
5553                 }
5554
5555                 return RI_count % 2 != 1;
5556             }
5557
5558         default:
5559             break;
5560     }
5561
5562 #ifdef DEBUGGING
5563     Perl_re_printf( aTHX_  "Unhandled WB pair: WB_table[%d, %d] = %d\n",
5564                                   before, after, WB_table[before][after]);
5565     assert(0);
5566 #endif
5567     return TRUE;
5568 }
5569
5570 STATIC WB_enum
5571 S_advance_one_WB(pTHX_ U8 ** curpos,
5572                        const U8 * const strend,
5573                        const bool utf8_target,
5574                        const bool skip_Extend_Format)
5575 {
5576     WB_enum wb;
5577
5578     PERL_ARGS_ASSERT_ADVANCE_ONE_WB;
5579
5580     if (*curpos >= strend) {
5581         return WB_EDGE;
5582     }
5583
5584     if (utf8_target) {
5585
5586         /* Advance over Extend and Format */
5587         do {
5588             *curpos += UTF8SKIP(*curpos);
5589             if (*curpos >= strend) {
5590                 return WB_EDGE;
5591             }
5592             wb = getWB_VAL_UTF8(*curpos, strend);
5593         } while (    skip_Extend_Format
5594                  && (wb == WB_Extend || wb == WB_Format));
5595     }
5596     else {
5597         do {
5598             (*curpos)++;
5599             if (*curpos >= strend) {
5600                 return WB_EDGE;
5601             }
5602             wb = getWB_VAL_CP(**curpos);
5603         } while (    skip_Extend_Format
5604                  && (wb == WB_Extend || wb == WB_Format));
5605     }
5606
5607     return wb;
5608 }
5609
5610 STATIC WB_enum
5611 S_backup_one_WB(pTHX_ WB_enum * previous, const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
5612 {
5613     WB_enum wb;
5614
5615     PERL_ARGS_ASSERT_BACKUP_ONE_WB;
5616
5617     /* If we know what the previous character's break value is, don't have
5618         * to look it up */
5619     if (*previous != WB_UNKNOWN) {
5620         wb = *previous;
5621
5622         /* But we need to move backwards by one */
5623         if (utf8_target) {
5624             *curpos = reghopmaybe3(*curpos, -1, strbeg);
5625             if (! *curpos) {
5626                 *previous = WB_EDGE;
5627                 *curpos = (U8 *) strbeg;
5628             }
5629             else {
5630                 *previous = WB_UNKNOWN;
5631             }
5632         }
5633         else {
5634             (*curpos)--;
5635             *previous = (*curpos <= strbeg) ? WB_EDGE : WB_UNKNOWN;
5636         }
5637
5638         /* And we always back up over these three types */
5639         if (wb != WB_Extend && wb != WB_Format && wb != WB_ZWJ) {
5640             return wb;
5641         }
5642     }
5643
5644     if (*curpos < strbeg) {
5645         return WB_EDGE;
5646     }
5647
5648     if (utf8_target) {
5649         U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg);
5650         if (! prev_char_pos) {
5651             return WB_EDGE;
5652         }
5653
5654         /* Back up over Extend and Format.  curpos is always just to the right
5655          * of the characater whose value we are getting */
5656         do {
5657             U8 * prev_prev_char_pos;
5658             if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos,
5659                                                    -1,
5660                                                    strbeg)))
5661             {
5662                 wb = getWB_VAL_UTF8(prev_prev_char_pos, prev_char_pos);
5663                 *curpos = prev_char_pos;
5664                 prev_char_pos = prev_prev_char_pos;
5665             }
5666             else {
5667                 *curpos = (U8 *) strbeg;
5668                 return WB_EDGE;
5669             }
5670         } while (wb == WB_Extend || wb == WB_Format || wb == WB_ZWJ);
5671     }
5672     else {
5673         do {
5674             if (*curpos - 2 < strbeg) {
5675                 *curpos = (U8 *) strbeg;
5676                 return WB_EDGE;
5677             }
5678             (*curpos)--;
5679             wb = getWB_VAL_CP(*(*curpos - 1));
5680         } while (wb == WB_Extend || wb == WB_Format);
5681     }
5682
5683     return wb;
5684 }
5685
5686 #define EVAL_CLOSE_PAREN_IS(st,expr)                        \
5687 (                                                           \
5688     (   ( st )                                         ) && \
5689     (   ( st )->u.eval.close_paren                     ) && \
5690     ( ( ( st )->u.eval.close_paren ) == ( (expr) + 1 ) )    \
5691 )
5692
5693 #define EVAL_CLOSE_PAREN_IS_TRUE(st,expr)                   \
5694 (                                                           \
5695     (   ( st )                                         ) && \
5696     (   ( st )->u.eval.close_paren                     ) && \
5697     (   ( expr )                                       ) && \
5698     ( ( ( st )->u.eval.close_paren ) == ( (expr) + 1 ) )    \
5699 )
5700
5701
5702 #define EVAL_CLOSE_PAREN_SET(st,expr) \
5703     (st)->u.eval.close_paren = ( (expr) + 1 )
5704
5705 #define EVAL_CLOSE_PAREN_CLEAR(st) \
5706     (st)->u.eval.close_paren = 0
5707
5708 /* returns -1 on failure, $+[0] on success */
5709 STATIC SSize_t
5710 S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
5711 {
5712     dVAR;
5713     const bool utf8_target = reginfo->is_utf8_target;
5714     const U32 uniflags = UTF8_ALLOW_DEFAULT;
5715     REGEXP *rex_sv = reginfo->prog;
5716     regexp *rex = ReANY(rex_sv);
5717     RXi_GET_DECL(rex,rexi);
5718     /* the current state. This is a cached copy of PL_regmatch_state */
5719     regmatch_state *st;
5720     /* cache heavy used fields of st in registers */
5721     regnode *scan;
5722     regnode *next;
5723     U32 n = 0;  /* general value; init to avoid compiler warning */
5724     SSize_t ln = 0; /* len or last;  init to avoid compiler warning */
5725     SSize_t endref = 0; /* offset of end of backref when ln is start */
5726     char *locinput = startpos;
5727     char *pushinput; /* where to continue after a PUSH */
5728     I32 nextchr;   /* is always set to UCHARAT(locinput), or -1 at EOS */
5729
5730     bool result = 0;        /* return value of S_regmatch */
5731     U32 depth = 0;            /* depth of backtrack stack */
5732     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
5733     const U32 max_nochange_depth =
5734         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
5735         3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
5736     regmatch_state *yes_state = NULL; /* state to pop to on success of
5737                                                             subpattern */
5738     /* mark_state piggy backs on the yes_state logic so that when we unwind 
5739        the stack on success we can update the mark_state as we go */
5740     regmatch_state *mark_state = NULL; /* last mark state we have seen */
5741     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
5742     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
5743     U32 state_num;
5744     bool no_final = 0;      /* prevent failure from backtracking? */
5745     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
5746     char *startpoint = locinput;
5747     SV *popmark = NULL;     /* are we looking for a mark? */
5748     SV *sv_commit = NULL;   /* last mark name seen in failure */
5749     SV *sv_yes_mark = NULL; /* last mark name we have seen 
5750                                during a successful match */
5751     U32 lastopen = 0;       /* last open we saw */
5752     bool has_cutgroup = RXp_HAS_CUTGROUP(rex) ? 1 : 0;
5753     SV* const oreplsv = GvSVn(PL_replgv);
5754     /* these three flags are set by various ops to signal information to
5755      * the very next op. They have a useful lifetime of exactly one loop
5756      * iteration, and are not preserved or restored by state pushes/pops
5757      */
5758     bool sw = 0;            /* the condition value in (?(cond)a|b) */
5759     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
5760     int logical = 0;        /* the following EVAL is:
5761                                 0: (?{...})
5762                                 1: (?(?{...})X|Y)
5763                                 2: (??{...})
5764                                or the following IFMATCH/UNLESSM is:
5765                                 false: plain (?=foo)
5766                                 true:  used as a condition: (?(?=foo))
5767                             */
5768     PAD* last_pad = NULL;
5769     dMULTICALL;
5770     U8 gimme = G_SCALAR;
5771     CV *caller_cv = NULL;       /* who called us */
5772     CV *last_pushed_cv = NULL;  /* most recently called (?{}) CV */
5773     U32 maxopenparen = 0;       /* max '(' index seen so far */
5774     int to_complement;  /* Invert the result? */
5775     _char_class_number classnum;
5776     bool is_utf8_pat = reginfo->is_utf8_pat;
5777     bool match = FALSE;
5778     I32 orig_savestack_ix = PL_savestack_ix;
5779     U8 * script_run_begin = NULL;
5780
5781 /* Solaris Studio 12.3 messes up fetching PL_charclass['\n'] */
5782 #if (defined(__SUNPRO_C) && (__SUNPRO_C == 0x5120) && defined(__x86_64) && defined(USE_64_BIT_ALL))
5783 #  define SOLARIS_BAD_OPTIMIZER
5784     const U32 *pl_charclass_dup = PL_charclass;
5785 #  define PL_charclass pl_charclass_dup
5786 #endif
5787
5788 #ifdef DEBUGGING
5789     GET_RE_DEBUG_FLAGS_DECL;
5790 #endif
5791
5792     /* protect against undef(*^R) */
5793     SAVEFREESV(SvREFCNT_inc_simple_NN(oreplsv));
5794
5795     /* shut up 'may be used uninitialized' compiler warnings for dMULTICALL */
5796     multicall_oldcatch = 0;
5797     PERL_UNUSED_VAR(multicall_cop);
5798
5799     PERL_ARGS_ASSERT_REGMATCH;
5800
5801     st = PL_regmatch_state;
5802
5803     /* Note that nextchr is a byte even in UTF */
5804     SET_nextchr;
5805     scan = prog;
5806
5807     DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
5808             DUMP_EXEC_POS( locinput, scan, utf8_target, depth );
5809             Perl_re_printf( aTHX_ "regmatch start\n" );
5810     }));
5811
5812     while (scan != NULL) {
5813         next = scan + NEXT_OFF(scan);
5814         if (next == scan)
5815             next = NULL;
5816         state_num = OP(scan);
5817
5818       reenter_switch:
5819         DEBUG_EXECUTE_r(
5820             if (state_num <= REGNODE_MAX) {
5821                 SV * const prop = sv_newmortal();
5822                 regnode *rnext = regnext(scan);
5823
5824                 DUMP_EXEC_POS( locinput, scan, utf8_target, depth );
5825                 regprop(rex, prop, scan, reginfo, NULL);
5826                 Perl_re_printf( aTHX_
5827                     "%*s%" IVdf ":%s(%" IVdf ")\n",
5828                     INDENT_CHARS(depth), "",
5829                     (IV)(scan - rexi->program),
5830                     SvPVX_const(prop),
5831                     (PL_regkind[OP(scan)] == END || !rnext) ?
5832                         0 : (IV)(rnext - rexi->program));
5833             }
5834         );
5835
5836         to_complement = 0;
5837
5838         SET_nextchr;
5839         assert(nextchr < 256 && (nextchr >= 0 || nextchr == NEXTCHR_EOS));
5840
5841         switch (state_num) {
5842         case SBOL: /*  /^../ and /\A../  */
5843             if (locinput == reginfo->strbeg)
5844                 break;
5845             sayNO;
5846
5847         case MBOL: /*  /^../m  */
5848             if (locinput == reginfo->strbeg ||
5849                 (!NEXTCHR_IS_EOS && locinput[-1] == '\n'))
5850             {
5851                 break;
5852             }
5853             sayNO;
5854
5855         case GPOS: /*  \G  */
5856             if (locinput == reginfo->ganch)
5857                 break;
5858             sayNO;
5859
5860         case KEEPS: /*   \K  */
5861             /* update the startpoint */
5862             st->u.keeper.val = rex->offs[0].start;
5863             rex->offs[0].start = locinput - reginfo->strbeg;
5864             PUSH_STATE_GOTO(KEEPS_next, next, locinput);
5865             NOT_REACHED; /* NOTREACHED */
5866
5867         case KEEPS_next_fail:
5868             /* rollback the start point change */
5869             rex->offs[0].start = st->u.keeper.val;
5870             sayNO_SILENT;
5871             NOT_REACHED; /* NOTREACHED */
5872
5873         case MEOL: /* /..$/m  */
5874             if (!NEXTCHR_IS_EOS && nextchr != '\n')
5875                 sayNO;
5876             break;
5877
5878         case SEOL: /* /..$/  */
5879             if (!NEXTCHR_IS_EOS && nextchr != '\n')
5880                 sayNO;
5881             if (reginfo->strend - locinput > 1)
5882                 sayNO;
5883             break;
5884
5885         case EOS: /*  \z  */
5886             if (!NEXTCHR_IS_EOS)
5887                 sayNO;
5888             break;
5889
5890         case SANY: /*  /./s  */
5891             if (NEXTCHR_IS_EOS)
5892                 sayNO;
5893             goto increment_locinput;
5894
5895         case REG_ANY: /*  /./  */
5896             if ((NEXTCHR_IS_EOS) || nextchr == '\n')
5897                 sayNO;
5898             goto increment_locinput;
5899
5900
5901 #undef  ST
5902 #define ST st->u.trie
5903         case TRIEC: /* (ab|cd) with known charclass */
5904             /* In this case the charclass data is available inline so
5905                we can fail fast without a lot of extra overhead. 
5906              */
5907             if(!NEXTCHR_IS_EOS && !ANYOF_BITMAP_TEST(scan, nextchr)) {
5908                 DEBUG_EXECUTE_r(
5909                     Perl_re_exec_indentf( aTHX_  "%sTRIE: failed to match trie start class...%s\n",
5910                               depth, PL_colors[4], PL_colors[5])
5911                 );
5912                 sayNO_SILENT;
5913                 NOT_REACHED; /* NOTREACHED */
5914             }
5915             /* FALLTHROUGH */
5916         case TRIE:  /* (ab|cd)  */
5917             /* the basic plan of execution of the trie is:
5918              * At the beginning, run though all the states, and
5919              * find the longest-matching word. Also remember the position
5920              * of the shortest matching word. For example, this pattern:
5921              *    1  2 3 4    5
5922              *    ab|a|x|abcd|abc
5923              * when matched against the string "abcde", will generate
5924              * accept states for all words except 3, with the longest
5925              * matching word being 4, and the shortest being 2 (with
5926              * the position being after char 1 of the string).
5927              *
5928              * Then for each matching word, in word order (i.e. 1,2,4,5),
5929              * we run the remainder of the pattern; on each try setting
5930              * the current position to the character following the word,
5931              * returning to try the next word on failure.
5932              *
5933              * We avoid having to build a list of words at runtime by
5934              * using a compile-time structure, wordinfo[].prev, which
5935              * gives, for each word, the previous accepting word (if any).
5936              * In the case above it would contain the mappings 1->2, 2->0,
5937              * 3->0, 4->5, 5->1.  We can use this table to generate, from
5938              * the longest word (4 above), a list of all words, by
5939              * following the list of prev pointers; this gives us the
5940              * unordered list 4,5,1,2. Then given the current word we have
5941              * just tried, we can go through the list and find the
5942              * next-biggest word to try (so if we just failed on word 2,
5943              * the next in the list is 4).
5944              *
5945              * Since at runtime we don't record the matching position in
5946              * the string for each word, we have to work that out for
5947              * each word we're about to process. The wordinfo table holds
5948              * the character length of each word; given that we recorded
5949              * at the start: the position of the shortest word and its
5950              * length in chars, we just need to move the pointer the
5951              * difference between the two char lengths. Depending on
5952              * Unicode status and folding, that's cheap or expensive.
5953              *
5954              * This algorithm is optimised for the case where are only a
5955              * small number of accept states, i.e. 0,1, or maybe 2.
5956              * With lots of accepts states, and having to try all of them,
5957              * it becomes quadratic on number of accept states to find all
5958              * the next words.
5959              */
5960
5961             {
5962                 /* what type of TRIE am I? (utf8 makes this contextual) */
5963                 DECL_TRIE_TYPE(scan);
5964
5965                 /* what trie are we using right now */
5966                 reg_trie_data * const trie
5967                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
5968                 HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]);
5969                 U32 state = trie->startstate;
5970
5971                 if (scan->flags == EXACTL || scan->flags == EXACTFLU8) {
5972                     _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
5973                     if (utf8_target
5974                         && ! NEXTCHR_IS_EOS
5975                         && UTF8_IS_ABOVE_LATIN1(nextchr)
5976                         && scan->flags == EXACTL)
5977                     {
5978                         /* We only output for EXACTL, as we let the folder
5979                          * output this message for EXACTFLU8 to avoid
5980                          * duplication */
5981                         _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput,
5982                                                                reginfo->strend);
5983                     }
5984                 }
5985                 if (   trie->bitmap
5986                     && (NEXTCHR_IS_EOS || !TRIE_BITMAP_TEST(trie, nextchr)))
5987                 {
5988                     if (trie->states[ state ].wordnum) {
5989                          DEBUG_EXECUTE_r(
5990                             Perl_re_exec_indentf( aTHX_  "%sTRIE: matched empty string...%s\n",
5991                                           depth, PL_colors[4], PL_colors[5])
5992                         );
5993                         if (!trie->jump)
5994                             break;
5995                     } else {
5996                         DEBUG_EXECUTE_r(
5997                             Perl_re_exec_indentf( aTHX_  "%sTRIE: failed to match trie start class...%s\n",
5998                                           depth, PL_colors[4], PL_colors[5])
5999                         );
6000                         sayNO_SILENT;
6001                    }
6002                 }
6003
6004             { 
6005                 U8 *uc = ( U8* )locinput;
6006
6007                 STRLEN len = 0;
6008                 STRLEN foldlen = 0;
6009                 U8 *uscan = (U8*)NULL;
6010                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
6011                 U32 charcount = 0; /* how many input chars we have matched */
6012                 U32 accepted = 0; /* have we seen any accepting states? */
6013
6014                 ST.jump = trie->jump;
6015                 ST.me = scan;
6016                 ST.firstpos = NULL;
6017                 ST.longfold = FALSE; /* char longer if folded => it's harder */
6018                 ST.nextword = 0;
6019
6020                 /* fully traverse the TRIE; note the position of the
6021                    shortest accept state and the wordnum of the longest
6022                    accept state */
6023
6024                 while ( state && uc <= (U8*)(reginfo->strend) ) {
6025                     U32 base = trie->states[ state ].trans.base;
6026                     UV uvc = 0;
6027                     U16 charid = 0;
6028                     U16 wordnum;
6029                     wordnum = trie->states[ state ].wordnum;
6030
6031                     if (wordnum) { /* it's an accept state */
6032                         if (!accepted) {
6033                             accepted = 1;
6034                             /* record first match position */
6035                             if (ST.longfold) {
6036                                 ST.firstpos = (U8*)locinput;
6037                                 ST.firstchars = 0;
6038                             }
6039                             else {
6040                                 ST.firstpos = uc;
6041                                 ST.firstchars = charcount;
6042                             }
6043                         }
6044                         if (!ST.nextword || wordnum < ST.nextword)
6045                             ST.nextword = wordnum;
6046                         ST.topword = wordnum;
6047                     }
6048
6049                     DEBUG_TRIE_EXECUTE_r({
6050                                 DUMP_EXEC_POS( (char *)uc, scan, utf8_target, depth );
6051                                 /* HERE */
6052                                 PerlIO_printf( Perl_debug_log,
6053                                     "%*s%sTRIE: State: %4" UVxf " Accepted: %c ",
6054                                     INDENT_CHARS(depth), "", PL_colors[4],
6055                                     (UV)state, (accepted ? 'Y' : 'N'));
6056                     });
6057
6058                     /* read a char and goto next state */
6059                     if ( base && (foldlen || uc < (U8*)(reginfo->strend))) {
6060                         I32 offset;
6061                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
6062                                              (U8 *) reginfo->strend, uscan,
6063                                              len, uvc, charid, foldlen,
6064                                              foldbuf, uniflags);
6065                         charcount++;
6066                         if (foldlen>0)
6067                             ST.longfold = TRUE;
6068                         if (charid &&
6069                              ( ((offset =
6070                               base + charid - 1 - trie->uniquecharcount)) >= 0)
6071
6072                              && ((U32)offset < trie->lasttrans)
6073                              && trie->trans[offset].check == state)
6074                         {
6075                             state = trie->trans[offset].next;
6076                         }
6077                         else {
6078                             state = 0;
6079                         }
6080                         uc += len;
6081
6082                     }
6083                     else {
6084                         state = 0;
6085                     }
6086                     DEBUG_TRIE_EXECUTE_r(
6087                         Perl_re_printf( aTHX_
6088                             "TRIE: Charid:%3x CP:%4" UVxf " After State: %4" UVxf "%s\n",
6089                             charid, uvc, (UV)state, PL_colors[5] );
6090                     );
6091                 }
6092                 if (!accepted)
6093                    sayNO;
6094
6095                 /* calculate total number of accept states */
6096                 {
6097                     U16 w = ST.topword;
6098                     accepted = 0;
6099                     while (w) {
6100                         w = trie->wordinfo[w].prev;
6101                         accepted++;
6102                     }
6103                     ST.accepted = accepted;
6104                 }
6105
6106                 DEBUG_EXECUTE_r(
6107                     Perl_re_exec_indentf( aTHX_  "%sTRIE: got %" IVdf " possible matches%s\n",
6108                         depth,
6109                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
6110                 );
6111                 goto trie_first_try; /* jump into the fail handler */
6112             }}
6113             NOT_REACHED; /* NOTREACHED */
6114
6115         case TRIE_next_fail: /* we failed - try next alternative */
6116         {
6117             U8 *uc;
6118             if ( ST.jump ) {
6119                 /* undo any captures done in the tail part of a branch,
6120                  * e.g.
6121                  *    /(?:X(.)(.)|Y(.)).../
6122                  * where the trie just matches X then calls out to do the
6123                  * rest of the branch */
6124                 REGCP_UNWIND(ST.cp);
6125                 UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
6126             }
6127             if (!--ST.accepted) {
6128                 DEBUG_EXECUTE_r({
6129                     Perl_re_exec_indentf( aTHX_  "%sTRIE failed...%s\n",
6130                         depth,
6131                         PL_colors[4],
6132                         PL_colors[5] );
6133                 });
6134                 sayNO_SILENT;
6135             }
6136             {
6137                 /* Find next-highest word to process.  Note that this code
6138                  * is O(N^2) per trie run (O(N) per branch), so keep tight */
6139                 U16 min = 0;
6140                 U16 word;
6141                 U16 const nextword = ST.nextword;
6142                 reg_trie_wordinfo * const wordinfo
6143                     = ((reg_trie_data*)rexi->data->data[ARG(ST.me)])->wordinfo;
6144                 for (word=ST.topword; word; word=wordinfo[word].prev) {
6145                     if (word > nextword && (!min || word < min))
6146                         min = word;
6147                 }
6148                 ST.nextword = min;
6149             }
6150
6151           trie_first_try:
6152             if (do_cutgroup) {
6153                 do_cutgroup = 0;
6154                 no_final = 0;
6155             }
6156
6157             if ( ST.jump ) {
6158                 ST.lastparen = rex->lastparen;
6159                 ST.lastcloseparen = rex->lastcloseparen;
6160                 REGCP_SET(ST.cp);
6161             }
6162
6163             /* find start char of end of current word */
6164             {
6165                 U32 chars; /* how many chars to skip */
6166                 reg_trie_data * const trie
6167                     = (reg_trie_data*)rexi->data->data[ARG(ST.me)];
6168
6169                 assert((trie->wordinfo[ST.nextword].len - trie->prefixlen)
6170                             >=  ST.firstchars);
6171                 chars = (trie->wordinfo[ST.nextword].len - trie->prefixlen)
6172                             - ST.firstchars;
6173                 uc = ST.firstpos;
6174
6175                 if (ST.longfold) {
6176                     /* the hard option - fold each char in turn and find
6177                      * its folded length (which may be different */
6178                     U8 foldbuf[UTF8_MAXBYTES_CASE + 1];
6179                     STRLEN foldlen;
6180                     STRLEN len;
6181                     UV uvc;
6182                     U8 *uscan;
6183
6184                     while (chars) {
6185                         if (utf8_target) {
6186                             uvc = utf8n_to_uvchr((U8*)uc, UTF8_MAXLEN, &len,
6187                                                     uniflags);
6188                             uc += len;
6189                         }
6190                         else {
6191                             uvc = *uc;
6192                             uc++;
6193                         }
6194                         uvc = to_uni_fold(uvc, foldbuf, &foldlen);
6195                         uscan = foldbuf;
6196                         while (foldlen) {
6197                             if (!--chars)
6198                                 break;
6199                             uvc = utf8n_to_uvchr(uscan, foldlen, &len,
6200                                                  uniflags);
6201                             uscan += len;
6202                             foldlen -= len;
6203                         }
6204                     }
6205                 }
6206                 else {
6207                     if (utf8_target)
6208                         while (chars--)
6209                             uc += UTF8SKIP(uc);
6210                     else
6211                         uc += chars;
6212                 }
6213             }
6214
6215             scan = ST.me + ((ST.jump && ST.jump[ST.nextword])
6216                             ? ST.jump[ST.nextword]
6217                             : NEXT_OFF(ST.me));
6218
6219             DEBUG_EXECUTE_r({
6220                 Perl_re_exec_indentf( aTHX_  "%sTRIE matched word #%d, continuing%s\n",
6221                     depth,
6222                     PL_colors[4],
6223                     ST.nextword,
6224                     PL_colors[5]
6225                     );
6226             });
6227
6228             if ( ST.accepted > 1 || has_cutgroup || ST.jump ) {
6229                 PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc);
6230                 NOT_REACHED; /* NOTREACHED */
6231             }
6232             /* only one choice left - just continue */
6233             DEBUG_EXECUTE_r({
6234                 AV *const trie_words
6235                     = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
6236                 SV ** const tmp = trie_words
6237                         ? av_fetch(trie_words, ST.nextword - 1, 0) : NULL;
6238                 SV *sv= tmp ? sv_newmortal() : NULL;
6239
6240                 Perl_re_exec_indentf( aTHX_  "%sTRIE: only one match left, short-circuiting: #%d <%s>%s\n",
6241                     depth, PL_colors[4],
6242                     ST.nextword,
6243                     tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
6244                             PL_colors[0], PL_colors[1],
6245                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)|PERL_PV_ESCAPE_NONASCII
6246                         ) 
6247                     : "not compiled under -Dr",
6248                     PL_colors[5] );
6249             });
6250
6251             locinput = (char*)uc;
6252             continue; /* execute rest of RE */
6253             /* NOTREACHED */
6254         }
6255 #undef  ST
6256
6257         case EXACTL:             /*  /abc/l       */
6258             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
6259
6260             /* Complete checking would involve going through every character
6261              * matched by the string to see if any is above latin1.  But the
6262              * comparision otherwise might very well be a fast assembly
6263              * language routine, and I (khw) don't think slowing things down
6264              * just to check for this warning is worth it.  So this just checks
6265              * the first character */
6266             if (utf8_target && UTF8_IS_ABOVE_LATIN1(*locinput)) {
6267                 _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend);
6268             }
6269             /* FALLTHROUGH */
6270         case EXACT: {            /*  /abc/        */
6271             char *s = STRING(scan);
6272             ln = STR_LEN(scan);
6273             if (utf8_target != is_utf8_pat) {
6274                 /* The target and the pattern have differing utf8ness. */
6275                 char *l = locinput;
6276                 const char * const e = s + ln;
6277
6278                 if (utf8_target) {
6279                     /* The target is utf8, the pattern is not utf8.
6280                      * Above-Latin1 code points can't match the pattern;
6281                      * invariants match exactly, and the other Latin1 ones need
6282                      * to be downgraded to a single byte in order to do the
6283                      * comparison.  (If we could be confident that the target
6284                      * is not malformed, this could be refactored to have fewer
6285                      * tests by just assuming that if the first bytes match, it
6286                      * is an invariant, but there are tests in the test suite
6287                      * dealing with (??{...}) which violate this) */
6288                     while (s < e) {
6289                         if (l >= reginfo->strend
6290                             || UTF8_IS_ABOVE_LATIN1(* (U8*) l))
6291                         {
6292                             sayNO;
6293                         }
6294                         if (UTF8_IS_INVARIANT(*(U8*)l)) {
6295                             if (*l != *s) {
6296                                 sayNO;
6297                             }
6298                             l++;
6299                         }
6300                         else {
6301                             if (EIGHT_BIT_UTF8_TO_NATIVE(*l, *(l+1)) != * (U8*) s)
6302                             {
6303                                 sayNO;
6304                             }
6305                             l += 2;
6306                         }
6307                         s++;
6308                     }
6309                 }
6310                 else {
6311                     /* The target is not utf8, the pattern is utf8. */
6312                     while (s < e) {
6313                         if (l >= reginfo->strend
6314                             || UTF8_IS_ABOVE_LATIN1(* (U8*) s))
6315                         {
6316                             sayNO;
6317                         }
6318                         if (UTF8_IS_INVARIANT(*(U8*)s)) {
6319                             if (*s != *l) {
6320                                 sayNO;
6321                             }
6322                             s++;
6323                         }
6324                         else {
6325                             if (EIGHT_BIT_UTF8_TO_NATIVE(*s, *(s+1)) != * (U8*) l)
6326                             {
6327                                 sayNO;
6328                             }
6329                             s += 2;
6330                         }
6331                         l++;
6332                     }
6333                 }
6334                 locinput = l;
6335             }
6336             else {
6337                 /* The target and the pattern have the same utf8ness. */
6338                 /* Inline the first character, for speed. */
6339                 if (reginfo->strend - locinput < ln
6340                     || UCHARAT(s) != nextchr
6341                     || (ln > 1 && memNE(s, locinput, ln)))
6342                 {
6343                     sayNO;
6344                 }
6345                 locinput += ln;
6346             }
6347             break;
6348             }
6349
6350         case EXACTFL: {          /*  /abc/il      */
6351             re_fold_t folder;
6352             const U8 * fold_array;
6353             const char * s;
6354             U32 fold_utf8_flags;
6355
6356             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
6357             folder = foldEQ_locale;
6358             fold_array = PL_fold_locale;
6359             fold_utf8_flags = FOLDEQ_LOCALE;
6360             goto do_exactf;
6361
6362         case EXACTFLU8:           /*  /abc/il; but all 'abc' are above 255, so
6363                                       is effectively /u; hence to match, target
6364                                       must be UTF-8. */
6365             if (! utf8_target) {
6366                 sayNO;
6367             }
6368             fold_utf8_flags =  FOLDEQ_LOCALE | FOLDEQ_S1_ALREADY_FOLDED
6369                                              | FOLDEQ_S1_FOLDS_SANE;
6370             folder = foldEQ_latin1;
6371             fold_array = PL_fold_latin1;
6372             goto do_exactf;
6373
6374         case EXACTFU_SS:         /*  /\x{df}/iu   */
6375         case EXACTFU:            /*  /abc/iu      */
6376             folder = foldEQ_latin1;
6377             fold_array = PL_fold_latin1;
6378             fold_utf8_flags = is_utf8_pat ? FOLDEQ_S1_ALREADY_FOLDED : 0;
6379             goto do_exactf;
6380
6381         case EXACTFAA_NO_TRIE:   /* This node only generated for non-utf8
6382                                    patterns */
6383             assert(! is_utf8_pat);
6384             /* FALLTHROUGH */
6385         case EXACTFAA:            /*  /abc/iaa     */
6386             folder = foldEQ_latin1;
6387             fold_array = PL_fold_latin1;
6388             fold_utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
6389             goto do_exactf;
6390
6391         case EXACTF:             /*  /abc/i    This node only generated for
6392                                                non-utf8 patterns */
6393             assert(! is_utf8_pat);
6394             folder = foldEQ;
6395             fold_array = PL_fold;
6396             fold_utf8_flags = 0;
6397
6398           do_exactf:
6399             s = STRING(scan);
6400             ln = STR_LEN(scan);
6401
6402             if (utf8_target
6403                 || is_utf8_pat
6404                 || state_num == EXACTFU_SS
6405                 || (state_num == EXACTFL && IN_UTF8_CTYPE_LOCALE))
6406             {
6407               /* Either target or the pattern are utf8, or has the issue where
6408                * the fold lengths may differ. */
6409                 const char * const l = locinput;
6410                 char *e = reginfo->strend;
6411
6412                 if (! foldEQ_utf8_flags(s, 0,  ln, is_utf8_pat,
6413                                         l, &e, 0,  utf8_target, fold_utf8_flags))
6414                 {
6415                     sayNO;
6416                 }
6417                 locinput = e;
6418                 break;
6419             }
6420
6421             /* Neither the target nor the pattern are utf8 */
6422             if (UCHARAT(s) != nextchr
6423                 && !NEXTCHR_IS_EOS
6424                 && UCHARAT(s) != fold_array[nextchr])
6425             {
6426                 sayNO;
6427             }
6428             if (reginfo->strend - locinput < ln)
6429                 sayNO;
6430             if (ln > 1 && ! folder(s, locinput, ln))
6431                 sayNO;
6432             locinput += ln;
6433             break;
6434         }
6435
6436         case NBOUNDL: /*  /\B/l  */
6437             to_complement = 1;
6438             /* FALLTHROUGH */
6439
6440         case BOUNDL:  /*  /\b/l  */
6441         {
6442             bool b1, b2;
6443             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
6444
6445             if (FLAGS(scan) != TRADITIONAL_BOUND) {
6446                 if (! IN_UTF8_CTYPE_LOCALE) {
6447                     Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE),
6448                                                 B_ON_NON_UTF8_LOCALE_IS_WRONG);
6449                 }
6450                 goto boundu;
6451             }
6452
6453             if (utf8_target) {
6454                 if (locinput == reginfo->strbeg)
6455                     b1 = isWORDCHAR_LC('\n');
6456                 else {
6457                     b1 = isWORDCHAR_LC_utf8_safe(reghop3((U8*)locinput, -1,
6458                                                         (U8*)(reginfo->strbeg)),
6459                                                  (U8*)(reginfo->strend));
6460                 }
6461                 b2 = (NEXTCHR_IS_EOS)
6462                     ? isWORDCHAR_LC('\n')
6463                     : isWORDCHAR_LC_utf8_safe((U8*) locinput,
6464                                               (U8*) reginfo->strend);
6465             }
6466             else { /* Here the string isn't utf8 */
6467                 b1 = (locinput == reginfo->strbeg)
6468                      ? isWORDCHAR_LC('\n')
6469                      : isWORDCHAR_LC(UCHARAT(locinput - 1));
6470                 b2 = (NEXTCHR_IS_EOS)
6471                     ? isWORDCHAR_LC('\n')
6472                     : isWORDCHAR_LC(nextchr);
6473             }
6474             if (to_complement ^ (b1 == b2)) {
6475                 sayNO;
6476             }
6477             break;
6478         }
6479
6480         case NBOUND:  /*  /\B/   */
6481             to_complement = 1;
6482             /* FALLTHROUGH */
6483
6484         case BOUND:   /*  /\b/   */
6485             if (utf8_target) {
6486                 goto bound_utf8;
6487             }
6488             goto bound_ascii_match_only;
6489
6490         case NBOUNDA: /*  /\B/a  */
6491             to_complement = 1;
6492             /* FALLTHROUGH */
6493
6494         case BOUNDA:  /*  /\b/a  */
6495         {
6496             bool b1, b2;
6497
6498           bound_ascii_match_only:
6499             /* Here the string isn't utf8, or is utf8 and only ascii characters
6500              * are to match \w.  In the latter case looking at the byte just
6501              * prior to the current one may be just the final byte of a
6502              * multi-byte character.  This is ok.  There are two cases:
6503              * 1) it is a single byte character, and then the test is doing
6504              *    just what it's supposed to.
6505              * 2) it is a multi-byte character, in which case the final byte is
6506              *    never mistakable for ASCII, and so the test will say it is
6507              *    not a word character, which is the correct answer. */
6508             b1 = (locinput == reginfo->strbeg)
6509                  ? isWORDCHAR_A('\n')
6510                  : isWORDCHAR_A(UCHARAT(locinput - 1));
6511             b2 = (NEXTCHR_IS_EOS)
6512                 ? isWORDCHAR_A('\n')
6513                 : isWORDCHAR_A(nextchr);
6514             if (to_complement ^ (b1 == b2)) {
6515                 sayNO;
6516             }
6517             break;
6518         }
6519
6520         case NBOUNDU: /*  /\B/u  */
6521             to_complement = 1;
6522             /* FALLTHROUGH */
6523
6524         case BOUNDU:  /*  /\b/u  */
6525
6526           boundu:
6527             if (UNLIKELY(reginfo->strbeg >= reginfo->strend)) {
6528                 match = FALSE;
6529             }
6530             else if (utf8_target) {
6531               bound_utf8:
6532                 switch((bound_type) FLAGS(scan)) {
6533                     case TRADITIONAL_BOUND:
6534                     {
6535                         bool b1, b2;
6536                         b1 = (locinput == reginfo->strbeg)
6537                              ? 0 /* isWORDCHAR_L1('\n') */
6538                              : isWORDCHAR_utf8_safe(
6539                                                reghop3((U8*)locinput,
6540                                                        -1,
6541                                                        (U8*)(reginfo->strbeg)),
6542                                                     (U8*) reginfo->strend);
6543                         b2 = (NEXTCHR_IS_EOS)
6544                             ? 0 /* isWORDCHAR_L1('\n') */
6545                             : isWORDCHAR_utf8_safe((U8*)locinput,
6546                                                    (U8*) reginfo->strend);
6547                         match = cBOOL(b1 != b2);
6548                         break;
6549                     }
6550                     case GCB_BOUND:
6551                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6552                             match = TRUE; /* GCB always matches at begin and
6553                                              end */
6554                         }
6555                         else {
6556                             /* Find the gcb values of previous and current
6557                              * chars, then see if is a break point */
6558                             match = isGCB(getGCB_VAL_UTF8(
6559                                                 reghop3((U8*)locinput,
6560                                                         -1,
6561                                                         (U8*)(reginfo->strbeg)),
6562                                                 (U8*) reginfo->strend),
6563                                           getGCB_VAL_UTF8((U8*) locinput,
6564                                                         (U8*) reginfo->strend),
6565                                           (U8*) reginfo->strbeg,
6566                                           (U8*) locinput,
6567                                           utf8_target);
6568                         }
6569                         break;
6570
6571                     case LB_BOUND:
6572                         if (locinput == reginfo->strbeg) {
6573                             match = FALSE;
6574                         }
6575                         else if (NEXTCHR_IS_EOS) {
6576                             match = TRUE;
6577                         }
6578                         else {
6579                             match = isLB(getLB_VAL_UTF8(
6580                                                 reghop3((U8*)locinput,
6581                                                         -1,
6582                                                         (U8*)(reginfo->strbeg)),
6583                                                 (U8*) reginfo->strend),
6584                                           getLB_VAL_UTF8((U8*) locinput,
6585                                                         (U8*) reginfo->strend),
6586                                           (U8*) reginfo->strbeg,
6587                                           (U8*) locinput,
6588                                           (U8*) reginfo->strend,
6589                                           utf8_target);
6590                         }
6591                         break;
6592
6593                     case SB_BOUND: /* Always matches at begin and end */
6594                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6595                             match = TRUE;
6596                         }
6597                         else {
6598                             match = isSB(getSB_VAL_UTF8(
6599                                                 reghop3((U8*)locinput,
6600                                                         -1,
6601                                                         (U8*)(reginfo->strbeg)),
6602                                                 (U8*) reginfo->strend),
6603                                           getSB_VAL_UTF8((U8*) locinput,
6604                                                         (U8*) reginfo->strend),
6605                                           (U8*) reginfo->strbeg,
6606                                           (U8*) locinput,
6607                                           (U8*) reginfo->strend,
6608                                           utf8_target);
6609                         }
6610                         break;
6611
6612                     case WB_BOUND:
6613                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6614                             match = TRUE;
6615                         }
6616                         else {
6617                             match = isWB(WB_UNKNOWN,
6618                                          getWB_VAL_UTF8(
6619                                                 reghop3((U8*)locinput,
6620                                                         -1,
6621                                                         (U8*)(reginfo->strbeg)),
6622                                                 (U8*) reginfo->strend),
6623                                           getWB_VAL_UTF8((U8*) locinput,
6624                                                         (U8*) reginfo->strend),
6625                                           (U8*) reginfo->strbeg,
6626                                           (U8*) locinput,
6627                                           (U8*) reginfo->strend,
6628                                           utf8_target);
6629                         }
6630                         break;
6631                 }
6632             }
6633             else {  /* Not utf8 target */
6634                 switch((bound_type) FLAGS(scan)) {
6635                     case TRADITIONAL_BOUND:
6636                     {
6637                         bool b1, b2;
6638                         b1 = (locinput == reginfo->strbeg)
6639                             ? 0 /* isWORDCHAR_L1('\n') */
6640                             : isWORDCHAR_L1(UCHARAT(locinput - 1));
6641                         b2 = (NEXTCHR_IS_EOS)
6642                             ? 0 /* isWORDCHAR_L1('\n') */
6643                             : isWORDCHAR_L1(nextchr);
6644                         match = cBOOL(b1 != b2);
6645                         break;
6646                     }
6647
6648                     case GCB_BOUND:
6649                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6650                             match = TRUE; /* GCB always matches at begin and
6651                                              end */
6652                         }
6653                         else {  /* Only CR-LF combo isn't a GCB in 0-255
6654                                    range */
6655                             match =    UCHARAT(locinput - 1) != '\r'
6656                                     || UCHARAT(locinput) != '\n';
6657                         }
6658                         break;
6659
6660                     case LB_BOUND:
6661                         if (locinput == reginfo->strbeg) {
6662                             match = FALSE;
6663                         }
6664                         else if (NEXTCHR_IS_EOS) {
6665                             match = TRUE;
6666                         }
6667                         else {
6668                             match = isLB(getLB_VAL_CP(UCHARAT(locinput -1)),
6669                                          getLB_VAL_CP(UCHARAT(locinput)),
6670                                          (U8*) reginfo->strbeg,
6671                                          (U8*) locinput,
6672                                          (U8*) reginfo->strend,
6673                                          utf8_target);
6674                         }
6675                         break;
6676
6677                     case SB_BOUND: /* Always matches at begin and end */
6678                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6679                             match = TRUE;
6680                         }
6681                         else {
6682                             match = isSB(getSB_VAL_CP(UCHARAT(locinput -1)),
6683                                          getSB_VAL_CP(UCHARAT(locinput)),
6684                                          (U8*) reginfo->strbeg,
6685                                          (U8*) locinput,
6686                                          (U8*) reginfo->strend,
6687                                          utf8_target);
6688                         }
6689                         break;
6690
6691                     case WB_BOUND:
6692                         if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) {
6693                             match = TRUE;
6694                         }
6695                         else {
6696                             match = isWB(WB_UNKNOWN,
6697                                          getWB_VAL_CP(UCHARAT(locinput -1)),
6698                                          getWB_VAL_CP(UCHARAT(locinput)),
6699                                          (U8*) reginfo->strbeg,
6700                                          (U8*) locinput,
6701                                          (U8*) reginfo->strend,
6702                                          utf8_target);
6703                         }
6704                         break;
6705                 }
6706             }
6707
6708             if (to_complement ^ ! match) {
6709                 sayNO;
6710             }
6711             break;
6712
6713         case ANYOFPOSIXL:
6714         case ANYOFL:  /*  /[abc]/l      */
6715             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
6716
6717             if (ANYOFL_UTF8_LOCALE_REQD(FLAGS(scan)) && ! IN_UTF8_CTYPE_LOCALE)
6718             {
6719               Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), utf8_locale_required);
6720             }
6721             /* FALLTHROUGH */
6722         case ANYOFD:  /*   /[abc]/d       */
6723         case ANYOF:  /*   /[abc]/       */
6724             if (NEXTCHR_IS_EOS)
6725                 sayNO;
6726             if (utf8_target && ! UTF8_IS_INVARIANT(*locinput)) {
6727                 if (!reginclass(rex, scan, (U8*)locinput, (U8*)reginfo->strend,
6728                                                                    utf8_target))
6729                     sayNO;
6730                 locinput += UTF8SKIP(locinput);
6731             }
6732             else {
6733                 if (!REGINCLASS(rex, scan, (U8*)locinput, utf8_target))
6734                     sayNO;
6735                 locinput++;
6736             }
6737             break;
6738
6739         case ANYOFM:
6740             if (NEXTCHR_IS_EOS || (UCHARAT(locinput) & FLAGS(scan)) != ARG(scan)) {
6741                 sayNO;
6742             }
6743             locinput++;
6744             break;
6745
6746         case NANYOFM:
6747             if (NEXTCHR_IS_EOS || (UCHARAT(locinput) & FLAGS(scan)) == ARG(scan)) {
6748                 sayNO;
6749             }
6750             goto increment_locinput;
6751             break;
6752
6753         case ASCII:
6754             if (NEXTCHR_IS_EOS || ! isASCII(UCHARAT(locinput))) {
6755                 sayNO;
6756             }
6757
6758             locinput++;     /* ASCII is always single byte */
6759             break;
6760
6761         case NASCII:
6762             if (NEXTCHR_IS_EOS || isASCII(UCHARAT(locinput))) {
6763                 sayNO;
6764             }
6765
6766             goto increment_locinput;
6767             break;
6768
6769         /* The argument (FLAGS) to all the POSIX node types is the class number
6770          * */
6771
6772         case NPOSIXL:   /* \W or [:^punct:] etc. under /l */
6773             to_complement = 1;
6774             /* FALLTHROUGH */
6775
6776         case POSIXL:    /* \w or [:punct:] etc. under /l */
6777             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
6778             if (NEXTCHR_IS_EOS)
6779                 sayNO;
6780
6781             /* Use isFOO_lc() for characters within Latin1.  (Note that
6782              * UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else
6783              * wouldn't be invariant) */
6784             if (UTF8_IS_INVARIANT(nextchr) || ! utf8_target) {
6785                 if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), (U8) nextchr)))) {
6786                     sayNO;
6787                 }
6788
6789                 locinput++;
6790                 break;
6791             }
6792
6793             if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(locinput, reginfo->strend)) {
6794                 /* An above Latin-1 code point, or malformed */
6795                 _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput,
6796                                                        reginfo->strend);
6797                 goto utf8_posix_above_latin1;
6798             }
6799
6800             /* Here is a UTF-8 variant code point below 256 and the target is
6801              * UTF-8 */
6802             if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan),
6803                                             EIGHT_BIT_UTF8_TO_NATIVE(nextchr,
6804                                             *(locinput + 1))))))
6805             {
6806                 sayNO;
6807             }
6808
6809             goto increment_locinput;
6810
6811         case NPOSIXD:   /* \W or [:^punct:] etc. under /d */
6812             to_complement = 1;
6813             /* FALLTHROUGH */
6814
6815         case POSIXD:    /* \w or [:punct:] etc. under /d */
6816             if (utf8_target) {
6817                 goto utf8_posix;
6818             }
6819             goto posixa;
6820
6821         case NPOSIXA:   /* \W or [:^punct:] etc. under /a */
6822
6823             if (NEXTCHR_IS_EOS) {
6824                 sayNO;
6825             }
6826
6827             /* All UTF-8 variants match */
6828             if (! UTF8_IS_INVARIANT(nextchr)) {
6829                 goto increment_locinput;
6830             }
6831
6832             to_complement = 1;
6833             goto join_nposixa;
6834
6835         case POSIXA:    /* \w or [:punct:] etc. under /a */
6836
6837           posixa:
6838             /* We get here through POSIXD, NPOSIXD, and NPOSIXA when not in
6839              * UTF-8, and also from NPOSIXA even in UTF-8 when the current
6840              * character is a single byte */
6841
6842             if (NEXTCHR_IS_EOS) {
6843                 sayNO;
6844             }
6845
6846           join_nposixa:
6847
6848             if (! (to_complement ^ cBOOL(_generic_isCC_A(nextchr,
6849                                                                 FLAGS(scan)))))
6850             {
6851                 sayNO;
6852             }
6853
6854             /* Here we are either not in utf8, or we matched a utf8-invariant,
6855              * so the next char is the next byte */
6856             locinput++;
6857             break;
6858
6859         case NPOSIXU:   /* \W or [:^punct:] etc. under /u */
6860             to_complement = 1;
6861             /* FALLTHROUGH */
6862
6863         case POSIXU:    /* \w or [:punct:] etc. under /u */
6864           utf8_posix:
6865             if (NEXTCHR_IS_EOS) {
6866                 sayNO;
6867             }
6868
6869             /* Use _generic_isCC() for characters within Latin1.  (Note that
6870              * UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else
6871              * wouldn't be invariant) */
6872             if (UTF8_IS_INVARIANT(nextchr) || ! utf8_target) {
6873                 if (! (to_complement ^ cBOOL(_generic_isCC(nextchr,
6874                                                            FLAGS(scan)))))
6875                 {
6876                     sayNO;
6877                 }
6878                 locinput++;
6879             }
6880             else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(locinput, reginfo->strend)) {
6881                 if (! (to_complement
6882                        ^ cBOOL(_generic_isCC(EIGHT_BIT_UTF8_TO_NATIVE(nextchr,
6883                                                                *(locinput + 1)),
6884                                              FLAGS(scan)))))
6885                 {
6886                     sayNO;
6887                 }
6888                 locinput += 2;
6889             }
6890             else {  /* Handle above Latin-1 code points */
6891               utf8_posix_above_latin1:
6892                 classnum = (_char_class_number) FLAGS(scan);
6893                 switch (classnum) {
6894                     default:
6895                         if (! (to_complement
6896                            ^ cBOOL(_invlist_contains_cp(
6897                                       PL_XPosix_ptrs[classnum],
6898                                       utf8_to_uvchr_buf((U8 *) locinput,
6899                                                         (U8 *) reginfo->strend,
6900                                                         NULL)))))
6901                         {
6902                             sayNO;
6903                         }
6904                         break;
6905                     case _CC_ENUM_SPACE:
6906                         if (! (to_complement
6907                                     ^ cBOOL(is_XPERLSPACE_high(locinput))))
6908                         {
6909                             sayNO;
6910                         }
6911                         break;
6912                     case _CC_ENUM_BLANK:
6913                         if (! (to_complement
6914                                         ^ cBOOL(is_HORIZWS_high(locinput))))
6915                         {
6916                             sayNO;
6917                         }
6918                         break;
6919                     case _CC_ENUM_XDIGIT:
6920                         if (! (to_complement
6921                                         ^ cBOOL(is_XDIGIT_high(locinput))))
6922                         {
6923                             sayNO;
6924                         }
6925                         break;
6926                     case _CC_ENUM_VERTSPACE:
6927                         if (! (to_complement
6928                                         ^ cBOOL(is_VERTWS_high(locinput))))
6929                         {
6930                             sayNO;
6931                         }
6932                         break;
6933                     case _CC_ENUM_CNTRL:    /* These can't match above Latin1 */
6934                     case _CC_ENUM_ASCII:
6935                         if (! to_complement) {
6936                             sayNO;
6937                         }
6938                         break;
6939                 }
6940                 locinput += UTF8SKIP(locinput);
6941             }
6942             break;
6943
6944         case CLUMP: /* Match \X: logical Unicode character.  This is defined as
6945                        a Unicode extended Grapheme Cluster */
6946             if (NEXTCHR_IS_EOS)
6947                 sayNO;
6948             if  (! utf8_target) {
6949
6950                 /* Match either CR LF  or '.', as all the other possibilities
6951                  * require utf8 */
6952                 locinput++;         /* Match the . or CR */
6953                 if (nextchr == '\r' /* And if it was CR, and the next is LF,
6954                                        match the LF */
6955                     && locinput < reginfo->strend
6956                     && UCHARAT(locinput) == '\n')
6957                 {
6958                     locinput++;
6959                 }
6960             }
6961             else {
6962
6963                 /* Get the gcb type for the current character */
6964                 GCB_enum prev_gcb = getGCB_VAL_UTF8((U8*) locinput,
6965                                                        (U8*) reginfo->strend);
6966
6967                 /* Then scan through the input until we get to the first
6968                  * character whose type is supposed to be a gcb with the
6969                  * current character.  (There is always a break at the
6970                  * end-of-input) */
6971                 locinput += UTF8SKIP(locinput);
6972                 while (locinput < reginfo->strend) {
6973                     GCB_enum cur_gcb = getGCB_VAL_UTF8((U8*) locinput,
6974                                                          (U8*) reginfo->strend);
6975                     if (isGCB(prev_gcb, cur_gcb,
6976                               (U8*) reginfo->strbeg, (U8*) locinput,
6977                               utf8_target))
6978                     {
6979                         break;
6980                     }
6981
6982                     prev_gcb = cur_gcb;
6983                     locinput += UTF8SKIP(locinput);
6984                 }
6985
6986
6987             }
6988             break;
6989             
6990         case NREFFL:  /*  /\g{name}/il  */
6991         {   /* The capture buffer cases.  The ones beginning with N for the
6992                named buffers just convert to the equivalent numbered and
6993                pretend they were called as the corresponding numbered buffer
6994                op.  */
6995             /* don't initialize these in the declaration, it makes C++
6996                unhappy */
6997             const char *s;
6998             char type;
6999             re_fold_t folder;
7000             const U8 *fold_array;
7001             UV utf8_fold_flags;
7002
7003             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
7004             folder = foldEQ_locale;
7005             fold_array = PL_fold_locale;
7006             type = REFFL;
7007             utf8_fold_flags = FOLDEQ_LOCALE;
7008             goto do_nref;
7009
7010         case NREFFA:  /*  /\g{name}/iaa  */
7011             folder = foldEQ_latin1;
7012             fold_array = PL_fold_latin1;
7013             type = REFFA;
7014             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
7015             goto do_nref;
7016
7017         case NREFFU:  /*  /\g{name}/iu  */
7018             folder = foldEQ_latin1;
7019             fold_array = PL_fold_latin1;
7020             type = REFFU;
7021             utf8_fold_flags = 0;
7022             goto do_nref;
7023
7024         case NREFF:  /*  /\g{name}/i  */
7025             folder = foldEQ;
7026             fold_array = PL_fold;
7027             type = REFF;
7028             utf8_fold_flags = 0;
7029             goto do_nref;
7030
7031         case NREF:  /*  /\g{name}/   */
7032             type = REF;
7033             folder = NULL;
7034             fold_array = NULL;
7035             utf8_fold_flags = 0;
7036           do_nref:
7037
7038             /* For the named back references, find the corresponding buffer
7039              * number */
7040             n = reg_check_named_buff_matched(rex,scan);
7041
7042             if ( ! n ) {
7043                 sayNO;
7044             }
7045             goto do_nref_ref_common;
7046
7047         case REFFL:  /*  /\1/il  */
7048             _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
7049             folder = foldEQ_locale;
7050             fold_array = PL_fold_locale;
7051             utf8_fold_flags = FOLDEQ_LOCALE;
7052             goto do_ref;
7053
7054         case REFFA:  /*  /\1/iaa  */
7055             folder = foldEQ_latin1;
7056             fold_array = PL_fold_latin1;
7057             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
7058             goto do_ref;
7059
7060         case REFFU:  /*  /\1/iu  */
7061             folder = foldEQ_latin1;
7062             fold_array = PL_fold_latin1;
7063             utf8_fold_flags = 0;
7064             goto do_ref;
7065
7066         case REFF:  /*  /\1/i  */
7067             folder = foldEQ;
7068             fold_array = PL_fold;
7069             utf8_fold_flags = 0;
7070             goto do_ref;
7071
7072         case REF:  /*  /\1/    */
7073             folder = NULL;
7074             fold_array = NULL;
7075             utf8_fold_flags = 0;
7076
7077           do_ref:
7078             type = OP(scan);
7079             n = ARG(scan);  /* which paren pair */
7080
7081           do_nref_ref_common:
7082             ln = rex->offs[n].start;
7083             endref = rex->offs[n].end;
7084             reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
7085             if (rex->lastparen < n || ln == -1 || endref == -1)
7086                 sayNO;                  /* Do not match unless seen CLOSEn. */
7087             if (ln == endref)
7088                 break;
7089
7090             s = reginfo->strbeg + ln;
7091             if (type != REF     /* REF can do byte comparison */
7092                 && (utf8_target || type == REFFU || type == REFFL))
7093             {
7094                 char * limit = reginfo->strend;
7095
7096                 /* This call case insensitively compares the entire buffer
7097                     * at s, with the current input starting at locinput, but
7098                     * not going off the end given by reginfo->strend, and
7099                     * returns in <limit> upon success, how much of the
7100                     * current input was matched */
7101                 if (! foldEQ_utf8_flags(s, NULL, endref - ln, utf8_target,
7102                                     locinput, &limit, 0, utf8_target, utf8_fold_flags))
7103                 {
7104                     sayNO;
7105                 }
7106                 locinput = limit;
7107                 break;
7108             }
7109
7110             /* Not utf8:  Inline the first character, for speed. */
7111             if (!NEXTCHR_IS_EOS &&
7112                 UCHARAT(s) != nextchr &&
7113                 (type == REF ||
7114                  UCHARAT(s) != fold_array[nextchr]))
7115                 sayNO;
7116             ln = endref - ln;
7117             if (locinput + ln > reginfo->strend)
7118                 sayNO;
7119             if (ln > 1 && (type == REF
7120                            ? memNE(s, locinput, ln)
7121                            : ! folder(s, locinput, ln)))
7122                 sayNO;
7123             locinput += ln;
7124             break;
7125         }
7126
7127         case NOTHING: /* null op; e.g. the 'nothing' following
7128                        * the '*' in m{(a+|b)*}' */
7129             break;
7130         case TAIL: /* placeholder while compiling (A|B|C) */
7131             break;
7132
7133 #undef  ST
7134 #define ST st->u.eval
7135 #define CUR_EVAL cur_eval->u.eval
7136
7137         {
7138             SV *ret;
7139             REGEXP *re_sv;
7140             regexp *re;
7141             regexp_internal *rei;
7142             regnode *startpoint;
7143             U32 arg;
7144
7145         case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
7146             arg= (U32)ARG(scan);
7147             if (cur_eval && cur_eval->locinput == locinput) {
7148                 if ( ++nochange_depth > max_nochange_depth )
7149                     Perl_croak(aTHX_ 
7150                         "Pattern subroutine nesting without pos change"
7151                         " exceeded limit in regex");
7152             } else {
7153                 nochange_depth = 0;
7154             }
7155             re_sv = rex_sv;
7156             re = rex;
7157             rei = rexi;
7158             startpoint = scan + ARG2L(scan);
7159             EVAL_CLOSE_PAREN_SET( st, arg );
7160             /* Detect infinite recursion
7161              *
7162              * A pattern like /(?R)foo/ or /(?<x>(?&y)foo)(?<y>(?&x)bar)/
7163              * or "a"=~/(.(?2))((?<=(?=(?1)).))/ could recurse forever.
7164              * So we track the position in the string we are at each time
7165              * we recurse and if we try to enter the same routine twice from
7166              * the same position we throw an error.
7167              */
7168             if ( rex->recurse_locinput[arg] == locinput ) {
7169                 /* FIXME: we should show the regop that is failing as part
7170                  * of the error message. */
7171                 Perl_croak(aTHX_ "Infinite recursion in regex");
7172             } else {
7173                 ST.prev_recurse_locinput= rex->recurse_locinput[arg];
7174                 rex->recurse_locinput[arg]= locinput;
7175
7176                 DEBUG_r({
7177                     GET_RE_DEBUG_FLAGS_DECL;
7178                     DEBUG_STACK_r({
7179                         Perl_re_exec_indentf( aTHX_
7180                             "entering GOSUB, prev_recurse_locinput=%p recurse_locinput[%d]=%p\n",
7181                             depth, ST.prev_recurse_locinput, arg, rex->recurse_locinput[arg]
7182                         );
7183                     });
7184                 });
7185             }
7186
7187             /* Save all the positions seen so far. */
7188             ST.cp = regcppush(rex, 0, maxopenparen);
7189             REGCP_SET(ST.lastcp);
7190
7191             /* and then jump to the code we share with EVAL */
7192             goto eval_recurse_doit;
7193             /* NOTREACHED */
7194
7195         case EVAL:  /*   /(?{...})B/   /(??{A})B/  and  /(?(?{...})X|Y)B/   */
7196             if (cur_eval && cur_eval->locinput==locinput) {
7197                 if ( ++nochange_depth > max_nochange_depth )
7198                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
7199             } else {
7200                 nochange_depth = 0;
7201             }    
7202             {
7203                 /* execute the code in the {...} */
7204
7205                 dSP;
7206                 IV before;
7207                 OP * const oop = PL_op;
7208                 COP * const ocurcop = PL_curcop;
7209                 OP *nop;
7210                 CV *newcv;
7211
7212                 /* save *all* paren positions */
7213                 regcppush(rex, 0, maxopenparen);
7214                 REGCP_SET(ST.lastcp);
7215
7216                 if (!caller_cv)
7217                     caller_cv = find_runcv(NULL);
7218
7219                 n = ARG(scan);
7220
7221                 if (rexi->data->what[n] == 'r') { /* code from an external qr */
7222                     newcv = (ReANY(
7223                                     (REGEXP*)(rexi->data->data[n])
7224                             ))->qr_anoncv;
7225                     nop = (OP*)rexi->data->data[n+1];
7226                 }
7227                 else if (rexi->data->what[n] == 'l') { /* literal code */
7228                     newcv = caller_cv;
7229                     nop = (OP*)rexi->data->data[n];
7230                     assert(CvDEPTH(newcv));
7231                 }
7232                 else {
7233                     /* literal with own CV */
7234                     assert(rexi->data->what[n] == 'L');
7235                     newcv = rex->qr_anoncv;
7236                     nop = (OP*)rexi->data->data[n];
7237                 }
7238
7239                 /* Some notes about MULTICALL and the context and save stacks.
7240                  *
7241                  * In something like
7242                  *   /...(?{ my $x)}...(?{ my $y)}...(?{ my $z)}.../
7243                  * since codeblocks don't introduce a new scope (so that
7244                  * local() etc accumulate), at the end of a successful
7245                  * match there will be a SAVEt_CLEARSV on the savestack
7246                  * for each of $x, $y, $z. If the three code blocks above
7247                  * happen to have come from different CVs (e.g. via
7248                  * embedded qr//s), then we must ensure that during any
7249                  * savestack unwinding, PL_comppad always points to the
7250                  * right pad at each moment. We achieve this by
7251                  * interleaving SAVEt_COMPPAD's on the savestack whenever
7252                  * there is a change of pad.
7253                  * In theory whenever we call a code block, we should
7254                  * push a CXt_SUB context, then pop it on return from
7255                  * that code block. This causes a bit of an issue in that
7256                  * normally popping a context also clears the savestack
7257                  * back to cx->blk_oldsaveix, but here we specifically
7258                  * don't want to clear the save stack on exit from the
7259                  * code block.
7260                  * Also for efficiency we don't want to keep pushing and
7261                  * popping the single SUB context as we backtrack etc.
7262                  * So instead, we push a single context the first time
7263                  * we need, it, then hang onto it until the end of this
7264                  * function. Whenever we encounter a new code block, we
7265                  * update the CV etc if that's changed. During the times
7266                  * in this function where we're not executing a code
7267                  * block, having the SUB context still there is a bit
7268                  * naughty - but we hope that no-one notices.
7269                  * When the SUB context is initially pushed, we fake up
7270                  * cx->blk_oldsaveix to be as if we'd pushed this context
7271                  * on first entry to S_regmatch rather than at some random
7272                  * point during the regexe execution. That way if we
7273                  * croak, popping the context stack will ensure that
7274                  * *everything* SAVEd by this function is undone and then
7275                  * the context popped, rather than e.g., popping the
7276                  * context (and restoring the original PL_comppad) then
7277                  * popping more of the savestack and restoring a bad
7278                  * PL_comppad.
7279                  */
7280
7281                 /* If this is the first EVAL, push a MULTICALL. On
7282                  * subsequent calls, if we're executing a different CV, or
7283                  * if PL_comppad has got messed up from backtracking
7284                  * through SAVECOMPPADs, then refresh the context.
7285                  */
7286                 if (newcv != last_pushed_cv || PL_comppad != last_pad)
7287                 {
7288                     U8 flags = (CXp_SUB_RE |
7289                                 ((newcv == caller_cv) ? CXp_SUB_RE_FAKE : 0));
7290                     SAVECOMPPAD();
7291                     if (last_pushed_cv) {
7292                         CHANGE_MULTICALL_FLAGS(newcv, flags);
7293                     }
7294                     else {
7295                         PUSH_MULTICALL_FLAGS(newcv, flags);
7296                     }
7297                     /* see notes above */
7298                     CX_CUR()->blk_oldsaveix = orig_savestack_ix;
7299
7300                     last_pushed_cv = newcv;
7301                 }
7302                 else {
7303                     /* these assignments are just to silence compiler
7304                      * warnings */
7305                     multicall_cop = NULL;
7306                 }
7307                 last_pad = PL_comppad;
7308
7309                 /* the initial nextstate you would normally execute
7310                  * at the start of an eval (which would cause error
7311                  * messages to come from the eval), may be optimised
7312                  * away from the execution path in the regex code blocks;
7313                  * so manually set PL_curcop to it initially */
7314                 {
7315                     OP *o = cUNOPx(nop)->op_first;
7316                     assert(o->op_type == OP_NULL);
7317                     if (o->op_targ == OP_SCOPE) {
7318                         o = cUNOPo->op_first;
7319                     }
7320                     else {
7321                         assert(o->op_targ == OP_LEAVE);
7322                         o = cUNOPo->op_first;
7323                         assert(o->op_type == OP_ENTER);
7324                         o = OpSIBLING(o);
7325                     }
7326
7327                     if (o->op_type != OP_STUB) {
7328                         assert(    o->op_type == OP_NEXTSTATE
7329                                 || o->op_type == OP_DBSTATE
7330                                 || (o->op_type == OP_NULL
7331                                     &&  (  o->op_targ == OP_NEXTSTATE
7332                                         || o->op_targ == OP_DBSTATE
7333                                         )
7334                                     )
7335                         );
7336                         PL_curcop = (COP*)o;
7337                     }
7338                 }
7339                 nop = nop->op_next;
7340
7341                 DEBUG_STATE_r( Perl_re_printf( aTHX_
7342                     "  re EVAL PL_op=0x%" UVxf "\n", PTR2UV(nop)) );
7343
7344                 rex->offs[0].end = locinput - reginfo->strbeg;
7345                 if (reginfo->info_aux_eval->pos_magic)
7346                     MgBYTEPOS_set(reginfo->info_aux_eval->pos_magic,
7347                                   reginfo->sv, reginfo->strbeg,
7348                                   locinput - reginfo->strbeg);
7349
7350                 if (sv_yes_mark) {
7351                     SV *sv_mrk = get_sv("REGMARK", 1);
7352                     sv_setsv(sv_mrk, sv_yes_mark);
7353                 }
7354
7355                 /* we don't use MULTICALL here as we want to call the
7356                  * first op of the block of interest, rather than the
7357                  * first op of the sub. Also, we don't want to free
7358                  * the savestack frame */
7359                 before = (IV)(SP-PL_stack_base);
7360                 PL_op = nop;
7361                 CALLRUNOPS(aTHX);                       /* Scalar context. */
7362                 SPAGAIN;
7363                 if ((IV)(SP-PL_stack_base) == before)
7364                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
7365                 else {
7366                     ret = POPs;
7367                     PUTBACK;
7368                 }
7369
7370                 /* before restoring everything, evaluate the returned
7371                  * value, so that 'uninit' warnings don't use the wrong
7372                  * PL_op or pad. Also need to process any magic vars
7373                  * (e.g. $1) *before* parentheses are restored */
7374
7375                 PL_op = NULL;
7376
7377                 re_sv = NULL;
7378                 if (logical == 0)        /*   (?{})/   */
7379                     sv_setsv(save_scalar(PL_replgv), ret); /* $^R */
7380                 else if (logical == 1) { /*   /(?(?{...})X|Y)/    */
7381                     sw = cBOOL(SvTRUE_NN(ret));
7382                     logical = 0;
7383                 }
7384                 else {                   /*  /(??{})  */
7385                     /*  if its overloaded, let the regex compiler handle
7386                      *  it; otherwise extract regex, or stringify  */
7387                     if (SvGMAGICAL(ret))
7388                         ret = sv_mortalcopy(ret);
7389                     if (!SvAMAGIC(ret)) {
7390                         SV *sv = ret;
7391                         if (SvROK(sv))
7392                             sv = SvRV(sv);
7393                         if (SvTYPE(sv) == SVt_REGEXP)
7394                             re_sv = (REGEXP*) sv;
7395                         else if (SvSMAGICAL(ret)) {
7396                             MAGIC *mg = mg_find(ret, PERL_MAGIC_qr);
7397                             if (mg)
7398                                 re_sv = (REGEXP *) mg->mg_obj;
7399                         }
7400
7401                         /* force any undef warnings here */
7402                         if (!re_sv && !SvPOK(ret) && !SvNIOK(ret)) {
7403                             ret = sv_mortalcopy(ret);
7404                             (void) SvPV_force_nolen(ret);
7405                         }
7406                     }
7407
7408                 }
7409
7410                 /* *** Note that at this point we don't restore
7411                  * PL_comppad, (or pop the CxSUB) on the assumption it may
7412                  * be used again soon. This is safe as long as nothing
7413                  * in the regexp code uses the pad ! */
7414                 PL_op = oop;
7415                 PL_curcop = ocurcop;
7416                 regcp_restore(rex, ST.lastcp, &maxopenparen);
7417                 PL_curpm_under = PL_curpm;
7418                 PL_curpm = PL_reg_curpm;
7419
7420                 if (logical != 2) {
7421                     PUSH_STATE_GOTO(EVAL_B, next, locinput);
7422                     /* NOTREACHED */
7423                 }
7424             }
7425
7426                 /* only /(??{})/  from now on */
7427                 logical = 0;
7428                 {
7429                     /* extract RE object from returned value; compiling if
7430                      * necessary */
7431
7432                     if (re_sv) {
7433                         re_sv = reg_temp_copy(NULL, re_sv);
7434                     }
7435                     else {
7436                         U32 pm_flags = 0;
7437
7438                         if (SvUTF8(ret) && IN_BYTES) {
7439                             /* In use 'bytes': make a copy of the octet
7440                              * sequence, but without the flag on */
7441                             STRLEN len;
7442                             const char *const p = SvPV(ret, len);
7443                             ret = newSVpvn_flags(p, len, SVs_TEMP);
7444                         }
7445                         if (rex->intflags & PREGf_USE_RE_EVAL)
7446                             pm_flags |= PMf_USE_RE_EVAL;
7447
7448                         /* if we got here, it should be an engine which
7449                          * supports compiling code blocks and stuff */
7450                         assert(rex->engine && rex->engine->op_comp);
7451                         assert(!(scan->flags & ~RXf_PMf_COMPILETIME));
7452                         re_sv = rex->engine->op_comp(aTHX_ &ret, 1, NULL,
7453                                     rex->engine, NULL, NULL,
7454                                     /* copy /msixn etc to inner pattern */
7455                                     ARG2L(scan),
7456                                     pm_flags);
7457
7458                         if (!(SvFLAGS(ret)
7459                               & (SVs_TEMP | SVs_GMG | SVf_ROK))
7460                          && (!SvPADTMP(ret) || SvREADONLY(ret))) {
7461                             /* This isn't a first class regexp. Instead, it's
7462                                caching a regexp onto an existing, Perl visible
7463                                scalar.  */
7464                             sv_magic(ret, MUTABLE_SV(re_sv), PERL_MAGIC_qr, 0, 0);
7465                         }
7466                     }
7467                     SAVEFREESV(re_sv);
7468                     re = ReANY(re_sv);
7469                 }
7470                 RXp_MATCH_COPIED_off(re);
7471                 re->subbeg = rex->subbeg;
7472                 re->sublen = rex->sublen;
7473                 re->suboffset = rex->suboffset;
7474                 re->subcoffset = rex->subcoffset;
7475                 re->lastparen = 0;
7476                 re->lastcloseparen = 0;
7477                 rei = RXi_GET(re);
7478                 DEBUG_EXECUTE_r(
7479                     debug_start_match(re_sv, utf8_target, locinput,
7480                                     reginfo->strend, "EVAL/GOSUB: Matching embedded");
7481                 );              
7482                 startpoint = rei->program + 1;
7483                 EVAL_CLOSE_PAREN_CLEAR(st); /* ST.close_paren = 0;
7484                                              * close_paren only for GOSUB */
7485                 ST.prev_recurse_locinput= NULL; /* only used for GOSUB */
7486                 /* Save all the seen positions so far. */
7487                 ST.cp = regcppush(rex, 0, maxopenparen);
7488                 REGCP_SET(ST.lastcp);
7489                 /* and set maxopenparen to 0, since we are starting a "fresh" match */
7490                 maxopenparen = 0;
7491                 /* run the pattern returned from (??{...}) */
7492
7493               eval_recurse_doit: /* Share code with GOSUB below this line
7494                             * At this point we expect the stack context to be
7495                             * set up correctly */
7496
7497                 /* invalidate the S-L poscache. We're now executing a
7498                  * different set of WHILEM ops (and their associated
7499                  * indexes) against the same string, so the bits in the
7500                  * cache are meaningless. Setting maxiter to zero forces
7501                  * the cache to be invalidated and zeroed before reuse.
7502                  * XXX This is too dramatic a measure. Ideally we should
7503                  * save the old cache and restore when running the outer
7504                  * pattern again */
7505                 reginfo->poscache_maxiter = 0;
7506
7507                 /* the new regexp might have a different is_utf8_pat than we do */
7508                 is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(re_sv));
7509
7510                 ST.prev_rex = rex_sv;
7511                 ST.prev_curlyx = cur_curlyx;
7512                 rex_sv = re_sv;
7513                 SET_reg_curpm(rex_sv);
7514                 rex = re;
7515                 rexi = rei;
7516                 cur_curlyx = NULL;
7517                 ST.B = next;
7518                 ST.prev_eval = cur_eval;
7519                 cur_eval = st;
7520                 /* now continue from first node in postoned RE */
7521                 PUSH_YES_STATE_GOTO(EVAL_postponed_AB, startpoint, locinput);
7522                 NOT_REACHED; /* NOTREACHED */
7523         }
7524
7525         case EVAL_postponed_AB: /* cleanup after a successful (??{A})B */
7526             /* note: this is called twice; first after popping B, then A */
7527             DEBUG_STACK_r({
7528                 Perl_re_exec_indentf( aTHX_  "EVAL_AB cur_eval=%p prev_eval=%p\n",
7529                     depth, cur_eval, ST.prev_eval);
7530             });
7531
7532 #define SET_RECURSE_LOCINPUT(STR,VAL)\
7533             if ( cur_eval && CUR_EVAL.close_paren ) {\
7534                 DEBUG_STACK_r({ \
7535                     Perl_re_exec_indentf( aTHX_  STR " GOSUB%d ce=%p recurse_locinput=%p\n",\
7536                         depth,    \
7537                         CUR_EVAL.close_paren - 1,\
7538                         cur_eval, \
7539                         VAL);     \
7540                 });               \
7541                 rex->recurse_locinput[CUR_EVAL.close_paren - 1] = VAL;\
7542             }
7543
7544             SET_RECURSE_LOCINPUT("EVAL_AB[before]", CUR_EVAL.prev_recurse_locinput);
7545
7546             rex_sv = ST.prev_rex;
7547             is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
7548             SET_reg_curpm(rex_sv);
7549             rex = ReANY(rex_sv);
7550             rexi = RXi_GET(rex);
7551             {
7552                 /* preserve $^R across LEAVE's. See Bug 121070. */
7553                 SV *save_sv= GvSV(PL_replgv);
7554                 SvREFCNT_inc(save_sv);
7555                 regcpblow(ST.cp); /* LEAVE in disguise */
7556                 sv_setsv(GvSV(PL_replgv), save_sv);
7557                 SvREFCNT_dec(save_sv);
7558             }
7559             cur_eval = ST.prev_eval;
7560             cur_curlyx = ST.prev_curlyx;
7561
7562             /* Invalidate cache. See "invalidate" comment above. */
7563             reginfo->poscache_maxiter = 0;
7564             if ( nochange_depth )
7565                 nochange_depth--;
7566
7567             SET_RECURSE_LOCINPUT("EVAL_AB[after]", cur_eval->locinput);
7568             sayYES;
7569
7570
7571         case EVAL_B_fail: /* unsuccessful B in (?{...})B */
7572             REGCP_UNWIND(ST.lastcp);
7573             sayNO;
7574
7575         case EVAL_postponed_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
7576             /* note: this is called twice; first after popping B, then A */
7577             DEBUG_STACK_r({
7578                 Perl_re_exec_indentf( aTHX_  "EVAL_AB_fail cur_eval=%p prev_eval=%p\n",
7579                     depth, cur_eval, ST.prev_eval);
7580             });
7581
7582             SET_RECURSE_LOCINPUT("EVAL_AB_fail[before]", CUR_EVAL.prev_recurse_locinput);
7583
7584             rex_sv = ST.prev_rex;
7585             is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
7586             SET_reg_curpm(rex_sv);
7587             rex = ReANY(rex_sv);
7588             rexi = RXi_GET(rex); 
7589
7590             REGCP_UNWIND(ST.lastcp);
7591             regcppop(rex, &maxopenparen);
7592             cur_eval = ST.prev_eval;
7593             cur_curlyx = ST.prev_curlyx;
7594
7595             /* Invalidate cache. See "invalidate" comment above. */
7596             reginfo->poscache_maxiter = 0;
7597             if ( nochange_depth )
7598                 nochange_depth--;
7599
7600             SET_RECURSE_LOCINPUT("EVAL_AB_fail[after]", cur_eval->locinput);
7601             sayNO_SILENT;
7602 #undef ST
7603
7604         case OPEN: /*  (  */
7605             n = ARG(scan);  /* which paren pair */
7606             rex->offs[n].start_tmp = locinput - reginfo->strbeg;
7607             if (n > maxopenparen)
7608                 maxopenparen = n;
7609             DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
7610                 "OPEN: rex=0x%" UVxf " offs=0x%" UVxf ": \\%" UVuf ": set %" IVdf " tmp; maxopenparen=%" UVuf "\n",
7611                 depth,
7612                 PTR2UV(rex),
7613                 PTR2UV(rex->offs),
7614                 (UV)n,
7615                 (IV)rex->offs[n].start_tmp,
7616                 (UV)maxopenparen
7617             ));
7618             lastopen = n;
7619             break;
7620
7621         case SROPEN: /*  (*SCRIPT_RUN:  */
7622             script_run_begin = (U8 *) locinput;
7623             break;
7624
7625
7626         case CLOSE:  /*  )  */
7627             n = ARG(scan);  /* which paren pair */
7628             CLOSE_CAPTURE(n, rex->offs[n].start_tmp,
7629                              locinput - reginfo->strbeg);
7630             if ( EVAL_CLOSE_PAREN_IS( cur_eval, n ) )
7631                 goto fake_end;
7632
7633             break;
7634
7635         case SRCLOSE:  /*  (*SCRIPT_RUN: ... )   */
7636
7637             if (! isSCRIPT_RUN(script_run_begin, (U8 *) locinput, utf8_target))
7638             {
7639                 sayNO;
7640             }
7641
7642             break;
7643
7644
7645         case ACCEPT:  /*  (*ACCEPT)  */
7646             if (scan->flags)
7647                 sv_yes_mark = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
7648             if (ARG2L(scan)){
7649                 regnode *cursor;
7650                 for (cursor=scan;
7651                      cursor && OP(cursor)!=END; 
7652                      cursor=regnext(cursor)) 
7653                 {
7654                     if ( OP(cursor)==CLOSE ){
7655                         n = ARG(cursor);
7656                         if ( n <= lastopen ) {
7657                             CLOSE_CAPTURE(n, rex->offs[n].start_tmp,
7658                                              locinput - reginfo->strbeg);
7659                             if ( n == ARG(scan) || EVAL_CLOSE_PAREN_IS(cur_eval, n) )
7660                                 break;
7661                         }
7662                     }
7663                 }
7664             }
7665             goto fake_end;
7666             /* NOTREACHED */
7667
7668         case GROUPP:  /*  (?(1))  */
7669             n = ARG(scan);  /* which paren pair */
7670             sw = cBOOL(rex->lastparen >= n && rex->offs[n].end != -1);
7671             break;
7672
7673         case NGROUPP:  /*  (?(<name>))  */
7674             /* reg_check_named_buff_matched returns 0 for no match */
7675             sw = cBOOL(0 < reg_check_named_buff_matched(rex,scan));
7676             break;
7677
7678         case INSUBP:   /*  (?(R))  */
7679             n = ARG(scan);
7680             /* this does not need to use EVAL_CLOSE_PAREN macros, as the arg
7681              * of SCAN is already set up as matches a eval.close_paren */
7682             sw = cur_eval && (n == 0 || CUR_EVAL.close_paren == n);
7683             break;
7684
7685         case DEFINEP:  /*  (?(DEFINE))  */
7686             sw = 0;
7687             break;
7688
7689         case IFTHEN:   /*  (?(cond)A|B)  */
7690             reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
7691             if (sw)
7692                 next = NEXTOPER(NEXTOPER(scan));
7693             else {
7694                 next = scan + ARG(scan);
7695                 if (OP(next) == IFTHEN) /* Fake one. */
7696                     next = NEXTOPER(NEXTOPER(next));
7697             }
7698             break;
7699
7700         case LOGICAL:  /* modifier for EVAL and IFMATCH */
7701             logical = scan->flags;
7702             break;
7703
7704 /*******************************************************************
7705
7706 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
7707 pattern, where A and B are subpatterns. (For simple A, CURLYM or
7708 STAR/PLUS/CURLY/CURLYN are used instead.)
7709
7710 A*B is compiled as <CURLYX><A><WHILEM><B>
7711
7712 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
7713 state, which contains the current count, initialised to -1. It also sets
7714 cur_curlyx to point to this state, with any previous value saved in the
7715 state block.
7716
7717 CURLYX then jumps straight to the WHILEM op, rather than executing A,
7718 since the pattern may possibly match zero times (i.e. it's a while {} loop
7719 rather than a do {} while loop).
7720
7721 Each entry to WHILEM represents a successful match of A. The count in the
7722 CURLYX block is incremented, another WHILEM state is pushed, and execution
7723 passes to A or B depending on greediness and the current count.
7724
7725 For example, if matching against the string a1a2a3b (where the aN are
7726 substrings that match /A/), then the match progresses as follows: (the
7727 pushed states are interspersed with the bits of strings matched so far):
7728
7729     <CURLYX cnt=-1>
7730     <CURLYX cnt=0><WHILEM>
7731     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
7732     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
7733     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
7734     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
7735
7736 (Contrast this with something like CURLYM, which maintains only a single
7737 backtrack state:
7738
7739     <CURLYM cnt=0> a1
7740     a1 <CURLYM cnt=1> a2
7741     a1 a2 <CURLYM cnt=2> a3
7742     a1 a2 a3 <CURLYM cnt=3> b
7743 )
7744
7745 Each WHILEM state block marks a point to backtrack to upon partial failure
7746 of A or B, and also contains some minor state data related to that
7747 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
7748 overall state, such as the count, and pointers to the A and B ops.
7749
7750 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
7751 must always point to the *current* CURLYX block, the rules are:
7752
7753 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
7754 and set cur_curlyx to point the new block.
7755
7756 When popping the CURLYX block after a successful or unsuccessful match,
7757 restore the previous cur_curlyx.
7758
7759 When WHILEM is about to execute B, save the current cur_curlyx, and set it
7760 to the outer one saved in the CURLYX block.
7761
7762 When popping the WHILEM block after a successful or unsuccessful B match,
7763 restore the previous cur_curlyx.
7764
7765 Here's an example for the pattern (AI* BI)*BO
7766 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
7767
7768 cur_
7769 curlyx backtrack stack
7770 ------ ---------------
7771 NULL   
7772 CO     <CO prev=NULL> <WO>
7773 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai 
7774 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi 
7775 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
7776
7777 At this point the pattern succeeds, and we work back down the stack to
7778 clean up, restoring as we go:
7779
7780 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi 
7781 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai 
7782 CO     <CO prev=NULL> <WO>
7783 NULL   
7784
7785 *******************************************************************/
7786
7787 #define ST st->u.curlyx
7788
7789         case CURLYX:    /* start of /A*B/  (for complex A) */
7790         {
7791             /* No need to save/restore up to this paren */
7792             I32 parenfloor = scan->flags;
7793             
7794             assert(next); /* keep Coverity happy */
7795             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
7796                 next += ARG(next);
7797
7798             /* XXXX Probably it is better to teach regpush to support
7799                parenfloor > maxopenparen ... */
7800             if (parenfloor > (I32)rex->lastparen)
7801                 parenfloor = rex->lastparen; /* Pessimization... */
7802
7803             ST.prev_curlyx= cur_curlyx;
7804             cur_curlyx = st;
7805             ST.cp = PL_savestack_ix;
7806
7807             /* these fields contain the state of the current curly.
7808              * they are accessed by subsequent WHILEMs */
7809             ST.parenfloor = parenfloor;
7810             ST.me = scan;
7811             ST.B = next;
7812             ST.minmod = minmod;
7813             minmod = 0;
7814             ST.count = -1;      /* this will be updated by WHILEM */
7815             ST.lastloc = NULL;  /* this will be updated by WHILEM */
7816
7817             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput);
7818             NOT_REACHED; /* NOTREACHED */
7819         }
7820
7821         case CURLYX_end: /* just finished matching all of A*B */
7822             cur_curlyx = ST.prev_curlyx;
7823             sayYES;
7824             NOT_REACHED; /* NOTREACHED */
7825
7826         case CURLYX_end_fail: /* just failed to match all of A*B */
7827             regcpblow(ST.cp);
7828             cur_curlyx = ST.prev_curlyx;
7829             sayNO;
7830             NOT_REACHED; /* NOTREACHED */
7831
7832
7833 #undef ST
7834 #define ST st->u.whilem
7835
7836         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
7837         {
7838             /* see the discussion above about CURLYX/WHILEM */
7839             I32 n;
7840             int min, max;
7841             regnode *A;
7842
7843             assert(cur_curlyx); /* keep Coverity happy */
7844
7845             min = ARG1(cur_curlyx->u.curlyx.me);
7846             max = ARG2(cur_curlyx->u.curlyx.me);
7847             A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS;
7848             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
7849             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
7850             ST.cache_offset = 0;
7851             ST.cache_mask = 0;
7852             
7853
7854             DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_  "WHILEM: matched %ld out of %d..%d\n",
7855                   depth, (long)n, min, max)
7856             );
7857
7858             /* First just match a string of min A's. */
7859
7860             if (n < min) {
7861                 ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, maxopenparen);
7862                 cur_curlyx->u.curlyx.lastloc = locinput;
7863                 REGCP_SET(ST.lastcp);
7864
7865                 PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput);
7866                 NOT_REACHED; /* NOTREACHED */
7867             }
7868
7869             /* If degenerate A matches "", assume A done. */
7870
7871             if (locinput == cur_curlyx->u.curlyx.lastloc) {
7872                 DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_  "WHILEM: empty match detected, trying continuation...\n",
7873                    depth)
7874                 );
7875                 goto do_whilem_B_max;
7876             }
7877
7878             /* super-linear cache processing.
7879              *
7880              * The idea here is that for certain types of CURLYX/WHILEM -
7881              * principally those whose upper bound is infinity (and
7882              * excluding regexes that have things like \1 and other very
7883              * non-regular expresssiony things), then if a pattern like
7884              * /....A*.../ fails and we backtrack to the WHILEM, then we
7885              * make a note that this particular WHILEM op was at string
7886              * position 47 (say) when the rest of pattern failed. Then, if
7887              * we ever find ourselves back at that WHILEM, and at string
7888              * position 47 again, we can just fail immediately rather than
7889              * running the rest of the pattern again.
7890              *
7891              * This is very handy when patterns start to go
7892              * 'super-linear', like in (a+)*(a+)*(a+)*, where you end up
7893              * with a combinatorial explosion of backtracking.
7894              *
7895              * The cache is implemented as a bit array, with one bit per
7896              * string byte position per WHILEM op (up to 16) - so its
7897              * between 0.25 and 2x the string size.
7898              *
7899              * To avoid allocating a poscache buffer every time, we do an
7900              * initially countdown; only after we have  executed a WHILEM
7901              * op (string-length x #WHILEMs) times do we allocate the
7902              * cache.
7903              *
7904              * The top 4 bits of scan->flags byte say how many different
7905              * relevant CURLLYX/WHILEM op pairs there are, while the
7906              * bottom 4-bits is the identifying index number of this
7907              * WHILEM.
7908              */
7909
7910             if (scan->flags) {
7911
7912                 if (!reginfo->poscache_maxiter) {
7913                     /* start the countdown: Postpone detection until we
7914                      * know the match is not *that* much linear. */
7915                     reginfo->poscache_maxiter
7916                         =    (reginfo->strend - reginfo->strbeg + 1)
7917                            * (scan->flags>>4);
7918                     /* possible overflow for long strings and many CURLYX's */
7919                     if (reginfo->poscache_maxiter < 0)
7920                         reginfo->poscache_maxiter = I32_MAX;
7921                     reginfo->poscache_iter = reginfo->poscache_maxiter;
7922                 }
7923
7924                 if (reginfo->poscache_iter-- == 0) {
7925                     /* initialise cache */
7926                     const SSize_t size = (reginfo->poscache_maxiter + 7)/8;
7927                     regmatch_info_aux *const aux = reginfo->info_aux;
7928                     if (aux->poscache) {
7929                         if ((SSize_t)reginfo->poscache_size < size) {
7930                             Renew(aux->poscache, size, char);
7931                             reginfo->poscache_size = size;
7932                         }
7933                         Zero(aux->poscache, size, char);
7934                     }
7935                     else {
7936                         reginfo->poscache_size = size;
7937                         Newxz(aux->poscache, size, char);
7938                     }
7939                     DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
7940       "%sWHILEM: Detected a super-linear match, switching on caching%s...\n",
7941                               PL_colors[4], PL_colors[5])
7942                     );
7943                 }
7944
7945                 if (reginfo->poscache_iter < 0) {
7946                     /* have we already failed at this position? */
7947                     SSize_t offset, mask;
7948
7949                     reginfo->poscache_iter = -1; /* stop eventual underflow */
7950                     offset  = (scan->flags & 0xf) - 1
7951                                 +   (locinput - reginfo->strbeg)
7952                                   * (scan->flags>>4);
7953                     mask    = 1 << (offset % 8);
7954                     offset /= 8;
7955                     if (reginfo->info_aux->poscache[offset] & mask) {
7956                         DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_  "WHILEM: (cache) already tried at this position...\n",
7957                             depth)
7958                         );
7959                         cur_curlyx->u.curlyx.count--;
7960                         sayNO; /* cache records failure */
7961                     }
7962                     ST.cache_offset = offset;
7963                     ST.cache_mask   = mask;
7964                 }
7965             }
7966
7967             /* Prefer B over A for minimal matching. */
7968
7969             if (cur_curlyx->u.curlyx.minmod) {
7970                 ST.save_curlyx = cur_curlyx;
7971                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
7972                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
7973                                     locinput);
7974                 NOT_REACHED; /* NOTREACHED */
7975             }
7976
7977             /* Prefer A over B for maximal matching. */
7978
7979             if (n < max) { /* More greed allowed? */
7980                 ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
7981                             maxopenparen);
7982                 cur_curlyx->u.curlyx.lastloc = locinput;
7983                 REGCP_SET(ST.lastcp);
7984                 PUSH_STATE_GOTO(WHILEM_A_max, A, locinput);
7985                 NOT_REACHED; /* NOTREACHED */
7986             }
7987             goto do_whilem_B_max;
7988         }
7989         NOT_REACHED; /* NOTREACHED */
7990
7991         case WHILEM_B_min: /* just matched B in a minimal match */
7992         case WHILEM_B_max: /* just matched B in a maximal match */
7993             cur_curlyx = ST.save_curlyx;
7994             sayYES;
7995             NOT_REACHED; /* NOTREACHED */
7996
7997         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
7998             cur_curlyx = ST.save_curlyx;
7999             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
8000             cur_curlyx->u.curlyx.count--;
8001             CACHEsayNO;
8002             NOT_REACHED; /* NOTREACHED */
8003
8004         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
8005             /* FALLTHROUGH */
8006         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
8007             REGCP_UNWIND(ST.lastcp);
8008             regcppop(rex, &maxopenparen);
8009             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
8010             cur_curlyx->u.curlyx.count--;
8011             CACHEsayNO;
8012             NOT_REACHED; /* NOTREACHED */
8013
8014         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
8015             REGCP_UNWIND(ST.lastcp);
8016             regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */
8017             DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_  "WHILEM: failed, trying continuation...\n",
8018                 depth)
8019             );
8020           do_whilem_B_max:
8021             if (cur_curlyx->u.curlyx.count >= REG_INFTY
8022                 && ckWARN(WARN_REGEXP)
8023                 && !reginfo->warned)
8024             {
8025                 reginfo->warned = TRUE;
8026                 Perl_warner(aTHX_ packWARN(WARN_REGEXP),
8027                      "Complex regular subexpression recursion limit (%d) "
8028                      "exceeded",
8029                      REG_INFTY - 1);
8030             }
8031
8032             /* now try B */
8033             ST.save_curlyx = cur_curlyx;
8034             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
8035             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B,
8036                                 locinput);
8037             NOT_REACHED; /* NOTREACHED */
8038
8039         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
8040             cur_curlyx = ST.save_curlyx;
8041
8042             if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
8043                 /* Maximum greed exceeded */
8044                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
8045                     && ckWARN(WARN_REGEXP)
8046                     && !reginfo->warned)
8047                 {
8048                     reginfo->warned     = TRUE;
8049                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
8050                         "Complex regular subexpression recursion "
8051                         "limit (%d) exceeded",
8052                         REG_INFTY - 1);
8053                 }
8054                 cur_curlyx->u.curlyx.count--;
8055                 CACHEsayNO;
8056             }
8057
8058             DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_  "WHILEM: B min fail: trying longer...\n", depth)
8059             );
8060             /* Try grabbing another A and see if it helps. */
8061             cur_curlyx->u.curlyx.lastloc = locinput;
8062             ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
8063                             maxopenparen);
8064             REGCP_SET(ST.lastcp);
8065             PUSH_STATE_GOTO(WHILEM_A_min,
8066                 /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
8067                 locinput);
8068             NOT_REACHED; /* NOTREACHED */
8069
8070 #undef  ST
8071 #define ST st->u.branch
8072
8073         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
8074             next = scan + ARG(scan);
8075             if (next == scan)
8076                 next = NULL;
8077             scan = NEXTOPER(scan);
8078             /* FALLTHROUGH */
8079
8080         case BRANCH:        /*  /(...|A|...)/ */
8081             scan = NEXTOPER(scan); /* scan now points to inner node */
8082             ST.lastparen = rex->lastparen;
8083             ST.lastcloseparen = rex->lastcloseparen;
8084             ST.next_branch = next;
8085             REGCP_SET(ST.cp);
8086
8087             /* Now go into the branch */
8088             if (has_cutgroup) {
8089                 PUSH_YES_STATE_GOTO(BRANCH_next, scan, locinput);
8090             } else {
8091                 PUSH_STATE_GOTO(BRANCH_next, scan, locinput);
8092             }
8093             NOT_REACHED; /* NOTREACHED */
8094
8095         case CUTGROUP:  /*  /(*THEN)/  */
8096             sv_yes_mark = st->u.mark.mark_name = scan->flags
8097                 ? MUTABLE_SV(rexi->data->data[ ARG( scan ) ])
8098                 : NULL;
8099             PUSH_STATE_GOTO(CUTGROUP_next, next, locinput);
8100             NOT_REACHED; /* NOTREACHED */
8101
8102         case CUTGROUP_next_fail:
8103             do_cutgroup = 1;
8104             no_final = 1;
8105             if (st->u.mark.mark_name)
8106                 sv_commit = st->u.mark.mark_name;
8107             sayNO;          
8108             NOT_REACHED; /* NOTREACHED */
8109
8110         case BRANCH_next:
8111             sayYES;
8112             NOT_REACHED; /* NOTREACHED */
8113
8114         case BRANCH_next_fail: /* that branch failed; try the next, if any */
8115             if (do_cutgroup) {
8116                 do_cutgroup = 0;
8117                 no_final = 0;
8118             }
8119             REGCP_UNWIND(ST.cp);
8120             UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
8121             scan = ST.next_branch;
8122             /* no more branches? */
8123             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
8124                 DEBUG_EXECUTE_r({
8125                     Perl_re_exec_indentf( aTHX_  "%sBRANCH failed...%s\n",
8126                         depth,
8127                         PL_colors[4],
8128                         PL_colors[5] );
8129                 });
8130                 sayNO_SILENT;
8131             }
8132             continue; /* execute next BRANCH[J] op */
8133             /* NOTREACHED */
8134     
8135         case MINMOD: /* next op will be non-greedy, e.g. A*?  */
8136             minmod = 1;
8137             break;
8138
8139 #undef  ST
8140 #define ST st->u.curlym
8141
8142         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
8143
8144             /* This is an optimisation of CURLYX that enables us to push
8145              * only a single backtracking state, no matter how many matches
8146              * there are in {m,n}. It relies on the pattern being constant
8147              * length, with no parens to influence future backrefs
8148              */
8149
8150             ST.me = scan;
8151             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
8152
8153             ST.lastparen      = rex->lastparen;
8154             ST.lastcloseparen = rex->lastcloseparen;
8155
8156             /* if paren positive, emulate an OPEN/CLOSE around A */
8157             if (ST.me->flags) {
8158                 U32 paren = ST.me->flags;
8159                 if (paren > maxopenparen)
8160                     maxopenparen = paren;
8161                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
8162             }
8163             ST.A = scan;
8164             ST.B = next;
8165             ST.alen = 0;
8166             ST.count = 0;
8167             ST.minmod = minmod;
8168             minmod = 0;
8169             ST.c1 = CHRTEST_UNINIT;
8170             REGCP_SET(ST.cp);
8171
8172             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
8173                 goto curlym_do_B;
8174
8175           curlym_do_A: /* execute the A in /A{m,n}B/  */
8176             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */
8177             NOT_REACHED; /* NOTREACHED */
8178
8179         case CURLYM_A: /* we've just matched an A */
8180             ST.count++;
8181             /* after first match, determine A's length: u.curlym.alen */
8182             if (ST.count == 1) {
8183                 if (reginfo->is_utf8_target) {
8184                     char *s = st->locinput;
8185                     while (s < locinput) {
8186                         ST.alen++;
8187                         s += UTF8SKIP(s);
8188                     }
8189                 }
8190                 else {
8191                     ST.alen = locinput - st->locinput;
8192                 }
8193                 if (ST.alen == 0)
8194                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
8195             }
8196             DEBUG_EXECUTE_r(
8197                 Perl_re_exec_indentf( aTHX_  "CURLYM now matched %" IVdf " times, len=%" IVdf "...\n",
8198                           depth, (IV) ST.count, (IV)ST.alen)
8199             );
8200
8201             if (EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags))
8202                 goto fake_end;
8203                 
8204             {
8205                 I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me));
8206                 if ( max == REG_INFTY || ST.count < max )
8207                     goto curlym_do_A; /* try to match another A */
8208             }
8209             goto curlym_do_B; /* try to match B */
8210
8211         case CURLYM_A_fail: /* just failed to match an A */
8212             REGCP_UNWIND(ST.cp);
8213
8214
8215             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ 
8216                 || EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags))
8217                 sayNO;
8218
8219           curlym_do_B: /* execute the B in /A{m,n}B/  */
8220             if (ST.c1 == CHRTEST_UNINIT) {
8221                 /* calculate c1 and c2 for possible match of 1st char
8222                  * following curly */
8223                 ST.c1 = ST.c2 = CHRTEST_VOID;
8224                 assert(ST.B);
8225                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
8226                     regnode *text_node = ST.B;
8227                     if (! HAS_TEXT(text_node))
8228                         FIND_NEXT_IMPT(text_node);
8229                     /* this used to be 
8230                         
8231                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
8232                         
8233                         But the former is redundant in light of the latter.
8234                         
8235                         if this changes back then the macro for 
8236                         IS_TEXT and friends need to change.
8237                      */
8238                     if (PL_regkind[OP(text_node)] == EXACT) {
8239                         if (! S_setup_EXACTISH_ST_c1_c2(aTHX_
8240                            text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8,
8241                            reginfo))
8242                         {
8243                             sayNO;
8244                         }
8245                     }
8246                 }
8247             }
8248
8249             DEBUG_EXECUTE_r(
8250                 Perl_re_exec_indentf( aTHX_  "CURLYM trying tail with matches=%" IVdf "...\n",
8251                     depth, (IV)ST.count)
8252                 );
8253             if (! NEXTCHR_IS_EOS && ST.c1 != CHRTEST_VOID) {
8254                 if (! UTF8_IS_INVARIANT(nextchr) && utf8_target) {
8255                     if (memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput))
8256                         && memNE(locinput, ST.c2_utf8, UTF8SKIP(locinput)))
8257                     {
8258                         /* simulate B failing */
8259                         DEBUG_OPTIMISE_r(
8260                             Perl_re_exec_indentf( aTHX_  "CURLYM Fast bail next target=0x%" UVXf " c1=0x%" UVXf " c2=0x%" UVXf "\n",
8261                                 depth,
8262                                 valid_utf8_to_uvchr((U8 *) locinput, NULL),
8263                                 valid_utf8_to_uvchr(ST.c1_utf8, NULL),
8264                                 valid_utf8_to_uvchr(ST.c2_utf8, NULL))
8265                         );
8266                         state_num = CURLYM_B_fail;
8267                         goto reenter_switch;
8268                     }
8269                 }
8270                 else if (nextchr != ST.c1 && nextchr != ST.c2) {
8271                     /* simulate B failing */
8272                     DEBUG_OPTIMISE_r(
8273                         Perl_re_exec_indentf( aTHX_  "CURLYM Fast bail next target=0x%X c1=0x%X c2=0x%X\n",
8274                             depth,
8275                             (int) nextchr, ST.c1, ST.c2)
8276                     );
8277                     state_num = CURLYM_B_fail;
8278                     goto reenter_switch;
8279                 }
8280             }
8281
8282             if (ST.me->flags) {
8283                 /* emulate CLOSE: mark current A as captured */
8284                 U32 paren = (U32)ST.me->flags;
8285                 if (ST.count) {
8286                     CLOSE_CAPTURE(paren,
8287                         HOPc(locinput, -ST.alen) - reginfo->strbeg,
8288                         locinput - reginfo->strbeg);
8289                 }
8290                 else
8291                     rex->offs[paren].end = -1;
8292
8293                 if (EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags))
8294                 {
8295                     if (ST.count) 
8296                         goto fake_end;
8297                     else
8298                         sayNO;
8299                 }
8300             }
8301             
8302             PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */
8303             NOT_REACHED; /* NOTREACHED */
8304
8305         case CURLYM_B_fail: /* just failed to match a B */
8306             REGCP_UNWIND(ST.cp);
8307             UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
8308             if (ST.minmod) {
8309                 I32 max = ARG2(ST.me);
8310                 if (max != REG_INFTY && ST.count == max)
8311                     sayNO;
8312                 goto curlym_do_A; /* try to match a further A */
8313             }
8314             /* backtrack one A */
8315             if (ST.count == ARG1(ST.me) /* min */)
8316                 sayNO;
8317             ST.count--;
8318             SET_locinput(HOPc(locinput, -ST.alen));
8319             goto curlym_do_B; /* try to match B */
8320
8321 #undef ST
8322 #define ST st->u.curly
8323
8324 #define CURLY_SETPAREN(paren, success) \
8325     if (paren) { \
8326         if (success) { \
8327             CLOSE_CAPTURE(paren, HOPc(locinput, -1) - reginfo->strbeg, \
8328                                  locinput - reginfo->strbeg); \
8329         } \
8330         else { \
8331             rex->offs[paren].end = -1; \
8332             rex->lastparen      = ST.lastparen; \
8333             rex->lastcloseparen = ST.lastcloseparen; \
8334         } \
8335     }
8336
8337         case STAR:              /*  /A*B/ where A is width 1 char */
8338             ST.paren = 0;
8339             ST.min = 0;
8340             ST.max = REG_INFTY;
8341             scan = NEXTOPER(scan);
8342             goto repeat;
8343
8344         case PLUS:              /*  /A+B/ where A is width 1 char */
8345             ST.paren = 0;
8346             ST.min = 1;
8347             ST.max = REG_INFTY;
8348             scan = NEXTOPER(scan);
8349             goto repeat;
8350
8351         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 char */
8352             ST.paren = scan->flags;     /* Which paren to set */
8353             ST.lastparen      = rex->lastparen;
8354             ST.lastcloseparen = rex->lastcloseparen;
8355             if (ST.paren > maxopenparen)
8356                 maxopenparen = ST.paren;
8357             ST.min = ARG1(scan);  /* min to match */
8358             ST.max = ARG2(scan);  /* max to match */
8359             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
8360
8361             /* handle the single-char capture called as a GOSUB etc */
8362             if (EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.paren))
8363             {
8364                 char *li = locinput;
8365                 if (!regrepeat(rex, &li, scan, reginfo, 1))
8366                     sayNO;
8367                 SET_locinput(li);
8368                 goto fake_end;
8369             }
8370
8371             goto repeat;
8372
8373         case CURLY:             /*  /A{m,n}B/ where A is width 1 char */
8374             ST.paren = 0;
8375             ST.min = ARG1(scan);  /* min to match */
8376             ST.max = ARG2(scan);  /* max to match */
8377             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
8378           repeat:
8379             /*
8380             * Lookahead to avoid useless match attempts
8381             * when we know what character comes next.
8382             *
8383             * Used to only do .*x and .*?x, but now it allows
8384             * for )'s, ('s and (?{ ... })'s to be in the way
8385             * of the quantifier and the EXACT-like node.  -- japhy
8386             */
8387
8388             assert(ST.min <= ST.max);
8389             if (! HAS_TEXT(next) && ! JUMPABLE(next)) {
8390                 ST.c1 = ST.c2 = CHRTEST_VOID;
8391             }
8392             else {
8393                 regnode *text_node = next;
8394
8395                 if (! HAS_TEXT(text_node)) 
8396                     FIND_NEXT_IMPT(text_node);
8397
8398                 if (! HAS_TEXT(text_node))
8399                     ST.c1 = ST.c2 = CHRTEST_VOID;
8400                 else {
8401                     if ( PL_regkind[OP(text_node)] != EXACT ) {
8402                         ST.c1 = ST.c2 = CHRTEST_VOID;
8403                     }
8404                     else {
8405                     
8406                     /*  Currently we only get here when 
8407                         
8408                         PL_rekind[OP(text_node)] == EXACT
8409                     
8410                         if this changes back then the macro for IS_TEXT and 
8411                         friends need to change. */
8412                         if (! S_setup_EXACTISH_ST_c1_c2(aTHX_
8413                            text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8,
8414                            reginfo))
8415                         {
8416                             sayNO;
8417                         }
8418                     }
8419                 }
8420             }
8421
8422             ST.A = scan;
8423             ST.B = next;
8424             if (minmod) {
8425                 char *li = locinput;
8426                 minmod = 0;
8427                 if (ST.min &&
8428                         regrepeat(rex, &li, ST.A, reginfo, ST.min)
8429                             < ST.min)
8430                     sayNO;
8431                 SET_locinput(li);
8432                 ST.count = ST.min;
8433                 REGCP_SET(ST.cp);
8434                 if (ST.c1 == CHRTEST_VOID)
8435                     goto curly_try_B_min;
8436
8437                 ST.oldloc = locinput;
8438
8439                 /* set ST.maxpos to the furthest point along the
8440                  * string that could possibly match */
8441                 if  (ST.max == REG_INFTY) {
8442                     ST.maxpos = reginfo->strend - 1;
8443                     if (utf8_target)
8444                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
8445                             ST.maxpos--;
8446                 }
8447                 else if (utf8_target) {
8448                     int m = ST.max - ST.min;
8449                     for (ST.maxpos = locinput;
8450                          m >0 && ST.maxpos < reginfo->strend; m--)
8451                         ST.maxpos += UTF8SKIP(ST.maxpos);
8452                 }
8453                 else {
8454                     ST.maxpos = locinput + ST.max - ST.min;
8455                     if (ST.maxpos >= reginfo->strend)
8456                         ST.maxpos = reginfo->strend - 1;
8457                 }
8458                 goto curly_try_B_min_known;
8459
8460             }
8461             else {
8462                 /* avoid taking address of locinput, so it can remain
8463                  * a register var */
8464                 char *li = locinput;
8465                 ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max);
8466                 if (ST.count < ST.min)
8467                     sayNO;
8468                 SET_locinput(li);
8469                 if ((ST.count > ST.min)
8470                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
8471                 {
8472                     /* A{m,n} must come at the end of the string, there's
8473                      * no point in backing off ... */
8474                     ST.min = ST.count;
8475                     /* ...except that $ and \Z can match before *and* after
8476                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
8477                        We may back off by one in this case. */
8478                     if (UCHARAT(locinput - 1) == '\n' && OP(ST.B) != EOS)
8479                         ST.min--;
8480                 }
8481                 REGCP_SET(ST.cp);
8482                 goto curly_try_B_max;
8483             }
8484             NOT_REACHED; /* NOTREACHED */
8485
8486         case CURLY_B_min_fail:
8487             /* failed to find B in a non-greedy match.
8488              * Handles both cases where c1,c2 valid or not */
8489
8490             REGCP_UNWIND(ST.cp);
8491             if (ST.paren) {
8492                 UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
8493             }
8494
8495             if (ST.c1 == CHRTEST_VOID) {
8496                 /* failed -- move forward one */
8497                 char *li = locinput;
8498                 if (!regrepeat(rex, &li, ST.A, reginfo, 1)) {
8499                     sayNO;
8500                 }
8501                 locinput = li;
8502                 ST.count++;
8503                 if (!(   ST.count <= ST.max
8504                         /* count overflow ? */
8505                      || (ST.max == REG_INFTY && ST.count > 0))
8506                 )
8507                     sayNO;
8508             }
8509             else {
8510                 int n;
8511                 /* Couldn't or didn't -- move forward. */
8512                 ST.oldloc = locinput;
8513                 if (utf8_target)
8514                     locinput += UTF8SKIP(locinput);
8515                 else
8516                     locinput++;
8517                 ST.count++;
8518
8519               curly_try_B_min_known:
8520                 /* find the next place where 'B' could work, then call B */
8521                 if (utf8_target) {
8522                     n = (ST.oldloc == locinput) ? 0 : 1;
8523                     if (ST.c1 == ST.c2) {
8524                         /* set n to utf8_distance(oldloc, locinput) */
8525                         while (locinput <= ST.maxpos
8526                               && memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput)))
8527                         {
8528                             locinput += UTF8SKIP(locinput);
8529                             n++;
8530                         }
8531                     }
8532                     else {
8533                         /* set n to utf8_distance(oldloc, locinput) */
8534                         while (locinput <= ST.maxpos
8535                               && memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput))
8536                               && memNE(locinput, ST.c2_utf8, UTF8SKIP(locinput)))
8537                         {
8538                             locinput += UTF8SKIP(locinput);
8539                             n++;
8540                         }
8541                     }
8542                 }
8543                 else {  /* Not utf8_target */
8544                     if (ST.c1 == ST.c2) {
8545                         locinput = (char *) memchr(locinput,
8546                                                    ST.c1,
8547                                                    ST.maxpos + 1 - locinput);
8548                         if (! locinput) {
8549                             locinput = ST.maxpos + 1;
8550                         }
8551                     }
8552                     else {
8553                         U8 c1_c2_bits_differing = ST.c1 ^ ST.c2;
8554
8555                         if (! isPOWER_OF_2(c1_c2_bits_differing)) {
8556                             while (   locinput <= ST.maxpos
8557                                    && UCHARAT(locinput) != ST.c1
8558                                    && UCHARAT(locinput) != ST.c2)
8559                             {
8560                                 locinput++;
8561                             }
8562                         }
8563                         else {
8564                             /* If c1 and c2 only differ by a single bit, we can
8565                              * avoid a conditional each time through the loop,
8566                              * at the expense of a little preliminary setup and
8567                              * an extra mask each iteration.  By masking out
8568                              * that bit, we match exactly two characters, c1
8569                              * and c2, and so we don't have to test for both.
8570                              * On both ASCII and EBCDIC platforms, most of the
8571                              * ASCII-range and Latin1-range folded equivalents
8572                              * differ only in a single bit, so this is actually
8573                              * the most common case. (e.g. 'A' 0x41 vs 'a'
8574                              * 0x61). */
8575                             U8 c1_masked = ST.c1 &~ c1_c2_bits_differing;
8576                             U8 c1_c2_mask = ~ c1_c2_bits_differing;
8577                             while (   locinput <= ST.maxpos
8578                                    && (UCHARAT(locinput) & c1_c2_mask)
8579                                                                 != c1_masked)
8580                             {
8581                                 locinput++;
8582                             }
8583                         }
8584                     }
8585                     n = locinput - ST.oldloc;
8586                 }
8587                 if (locinput > ST.maxpos)
8588                     sayNO;
8589                 if (n) {
8590                     /* In /a{m,n}b/, ST.oldloc is at "a" x m, locinput is
8591                      * at b; check that everything between oldloc and
8592                      * locinput matches */
8593                     char *li = ST.oldloc;
8594                     ST.count += n;
8595                     if (regrepeat(rex, &li, ST.A, reginfo, n) < n)
8596                         sayNO;
8597                     assert(n == REG_INFTY || locinput == li);
8598                 }
8599             }
8600
8601           curly_try_B_min:
8602             CURLY_SETPAREN(ST.paren, ST.count);
8603             PUSH_STATE_GOTO(CURLY_B_min, ST.B, locinput);
8604             NOT_REACHED; /* NOTREACHED */
8605
8606
8607           curly_try_B_max:
8608             /* a successful greedy match: now try to match B */
8609             {
8610                 bool could_match = locinput < reginfo->strend;
8611
8612                 /* If it could work, try it. */
8613                 if (ST.c1 != CHRTEST_VOID && could_match) {
8614                     if (! UTF8_IS_INVARIANT(UCHARAT(locinput)) && utf8_target)
8615                     {
8616                         could_match = memEQ(locinput,
8617                                             ST.c1_utf8,
8618                                             UTF8SKIP(locinput))
8619                                     || memEQ(locinput,
8620                                              ST.c2_utf8,
8621                                              UTF8SKIP(locinput));
8622                     }
8623                     else {
8624                         could_match = UCHARAT(locinput) == ST.c1
8625                                       || UCHARAT(locinput) == ST.c2;
8626                     }
8627                 }
8628                 if (ST.c1 == CHRTEST_VOID || could_match) {
8629                     CURLY_SETPAREN(ST.paren, ST.count);
8630                     PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput);
8631                     NOT_REACHED; /* NOTREACHED */
8632                 }
8633             }
8634             /* FALLTHROUGH */
8635
8636         case CURLY_B_max_fail:
8637             /* failed to find B in a greedy match */
8638
8639             REGCP_UNWIND(ST.cp);
8640             if (ST.paren) {
8641                 UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
8642             }
8643             /*  back up. */
8644             if (--ST.count < ST.min)
8645                 sayNO;
8646             locinput = HOPc(locinput, -1);
8647             goto curly_try_B_max;
8648
8649 #undef ST
8650
8651         case END: /*  last op of main pattern  */
8652           fake_end:
8653             if (cur_eval) {
8654                 /* we've just finished A in /(??{A})B/; now continue with B */
8655                 SET_RECURSE_LOCINPUT("FAKE-END[before]", CUR_EVAL.prev_recurse_locinput);
8656                 st->u.eval.prev_rex = rex_sv;           /* inner */
8657
8658                 /* Save *all* the positions. */
8659                 st->u.eval.cp = regcppush(rex, 0, maxopenparen);
8660                 rex_sv = CUR_EVAL.prev_rex;
8661                 is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
8662                 SET_reg_curpm(rex_sv);
8663                 rex = ReANY(rex_sv);
8664                 rexi = RXi_GET(rex);
8665
8666                 st->u.eval.prev_curlyx = cur_curlyx;
8667                 cur_curlyx = CUR_EVAL.prev_curlyx;
8668
8669                 REGCP_SET(st->u.eval.lastcp);
8670
8671                 /* Restore parens of the outer rex without popping the
8672                  * savestack */
8673                 regcp_restore(rex, CUR_EVAL.lastcp, &maxopenparen);
8674
8675                 st->u.eval.prev_eval = cur_eval;
8676                 cur_eval = CUR_EVAL.prev_eval;
8677                 DEBUG_EXECUTE_r(
8678                     Perl_re_exec_indentf( aTHX_  "END: EVAL trying tail ... (cur_eval=%p)\n",
8679                                       depth, cur_eval););
8680                 if ( nochange_depth )
8681                     nochange_depth--;
8682
8683                 SET_RECURSE_LOCINPUT("FAKE-END[after]", cur_eval->locinput);
8684
8685                 PUSH_YES_STATE_GOTO(EVAL_postponed_AB, st->u.eval.prev_eval->u.eval.B,
8686                                     locinput); /* match B */
8687             }
8688
8689             if (locinput < reginfo->till) {
8690                 DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
8691                                       "%sEND: Match possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
8692                                       PL_colors[4],
8693                                       (long)(locinput - startpos),
8694                                       (long)(reginfo->till - startpos),
8695                                       PL_colors[5]));
8696                                               
8697                 sayNO_SILENT;           /* Cannot match: too short. */
8698             }
8699             sayYES;                     /* Success! */
8700
8701         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
8702             DEBUG_EXECUTE_r(
8703             Perl_re_exec_indentf( aTHX_  "%sSUCCEED: subpattern success...%s\n",
8704                 depth, PL_colors[4], PL_colors[5]));
8705             sayYES;                     /* Success! */
8706
8707 #undef  ST
8708 #define ST st->u.ifmatch
8709
8710         {
8711             char *newstart;
8712
8713         case SUSPEND:   /* (?>A) */
8714             ST.wanted = 1;
8715             newstart = locinput;
8716             goto do_ifmatch;    
8717
8718         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
8719             ST.wanted = 0;
8720             goto ifmatch_trivial_fail_test;
8721
8722         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
8723             ST.wanted = 1;
8724           ifmatch_trivial_fail_test:
8725             if (scan->flags) {
8726                 char * const s = HOPBACKc(locinput, scan->flags);
8727                 if (!s) {
8728                     /* trivial fail */
8729                     if (logical) {
8730                         logical = 0;
8731                         sw = 1 - cBOOL(ST.wanted);
8732                     }
8733                     else if (ST.wanted)
8734                         sayNO;
8735                     next = scan + ARG(scan);
8736                     if (next == scan)
8737                         next = NULL;
8738                     break;
8739                 }
8740                 newstart = s;
8741             }
8742             else
8743                 newstart = locinput;
8744
8745           do_ifmatch:
8746             ST.me = scan;
8747             ST.logical = logical;
8748             logical = 0; /* XXX: reset state of logical once it has been saved into ST */
8749             
8750             /* execute body of (?...A) */
8751             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart);
8752             NOT_REACHED; /* NOTREACHED */
8753         }
8754
8755         case IFMATCH_A_fail: /* body of (?...A) failed */
8756             ST.wanted = !ST.wanted;
8757             /* FALLTHROUGH */
8758
8759         case IFMATCH_A: /* body of (?...A) succeeded */
8760             if (ST.logical) {
8761                 sw = cBOOL(ST.wanted);
8762             }
8763             else if (!ST.wanted)
8764                 sayNO;
8765
8766             if (OP(ST.me) != SUSPEND) {
8767                 /* restore old position except for (?>...) */
8768                 locinput = st->locinput;
8769             }
8770             scan = ST.me + ARG(ST.me);
8771             if (scan == ST.me)
8772                 scan = NULL;
8773             continue; /* execute B */
8774
8775 #undef ST
8776
8777         case LONGJMP: /*  alternative with many branches compiles to
8778                        * (BRANCHJ; EXACT ...; LONGJMP ) x N */
8779             next = scan + ARG(scan);
8780             if (next == scan)
8781                 next = NULL;
8782             break;
8783
8784         case COMMIT:  /*  (*COMMIT)  */
8785             reginfo->cutpoint = reginfo->strend;
8786             /* FALLTHROUGH */
8787
8788         case PRUNE:   /*  (*PRUNE)   */
8789             if (scan->flags)
8790                 sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
8791             PUSH_STATE_GOTO(COMMIT_next, next, locinput);
8792             NOT_REACHED; /* NOTREACHED */
8793
8794         case COMMIT_next_fail:
8795             no_final = 1;    
8796             /* FALLTHROUGH */       
8797             sayNO;
8798             NOT_REACHED; /* NOTREACHED */
8799
8800         case OPFAIL:   /* (*FAIL)  */
8801             if (scan->flags)
8802                 sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
8803             if (logical) {
8804                 /* deal with (?(?!)X|Y) properly,
8805                  * make sure we trigger the no branch
8806                  * of the trailing IFTHEN structure*/
8807                 sw= 0;
8808                 break;
8809             } else {
8810                 sayNO;
8811             }
8812             NOT_REACHED; /* NOTREACHED */
8813
8814 #define ST st->u.mark
8815         case MARKPOINT: /*  (*MARK:foo)  */
8816             ST.prev_mark = mark_state;
8817             ST.mark_name = sv_commit = sv_yes_mark 
8818                 = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
8819             mark_state = st;
8820             ST.mark_loc = locinput;
8821             PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput);
8822             NOT_REACHED; /* NOTREACHED */
8823
8824         case MARKPOINT_next:
8825             mark_state = ST.prev_mark;
8826             sayYES;
8827             NOT_REACHED; /* NOTREACHED */
8828
8829         case MARKPOINT_next_fail:
8830             if (popmark && sv_eq(ST.mark_name,popmark)) 
8831             {
8832                 if (ST.mark_loc > startpoint)
8833                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
8834                 popmark = NULL; /* we found our mark */
8835                 sv_commit = ST.mark_name;
8836
8837                 DEBUG_EXECUTE_r({
8838                         Perl_re_exec_indentf( aTHX_  "%sMARKPOINT: next fail: setting cutpoint to mark:%" SVf "...%s\n",
8839                             depth,
8840                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
8841                 });
8842             }
8843             mark_state = ST.prev_mark;
8844             sv_yes_mark = mark_state ? 
8845                 mark_state->u.mark.mark_name : NULL;
8846             sayNO;
8847             NOT_REACHED; /* NOTREACHED */
8848
8849         case SKIP:  /*  (*SKIP)  */
8850             if (!scan->flags) {
8851                 /* (*SKIP) : if we fail we cut here*/
8852                 ST.mark_name = NULL;
8853                 ST.mark_loc = locinput;
8854                 PUSH_STATE_GOTO(SKIP_next,next, locinput);
8855             } else {
8856                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, 
8857                    otherwise do nothing.  Meaning we need to scan 
8858                  */
8859                 regmatch_state *cur = mark_state;
8860                 SV *find = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
8861                 
8862                 while (cur) {
8863                     if ( sv_eq( cur->u.mark.mark_name, 
8864                                 find ) ) 
8865                     {
8866                         ST.mark_name = find;
8867                         PUSH_STATE_GOTO( SKIP_next, next, locinput);
8868                     }
8869                     cur = cur->u.mark.prev_mark;
8870                 }
8871             }    
8872             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
8873             break;    
8874
8875         case SKIP_next_fail:
8876             if (ST.mark_name) {
8877                 /* (*CUT:NAME) - Set up to search for the name as we 
8878                    collapse the stack*/
8879                 popmark = ST.mark_name;    
8880             } else {
8881                 /* (*CUT) - No name, we cut here.*/
8882                 if (ST.mark_loc > startpoint)
8883                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
8884                 /* but we set sv_commit to latest mark_name if there
8885                    is one so they can test to see how things lead to this
8886                    cut */    
8887                 if (mark_state) 
8888                     sv_commit=mark_state->u.mark.mark_name;                 
8889             } 
8890             no_final = 1; 
8891             sayNO;
8892             NOT_REACHED; /* NOTREACHED */
8893 #undef ST
8894
8895         case LNBREAK: /* \R */
8896             if ((n=is_LNBREAK_safe(locinput, reginfo->strend, utf8_target))) {
8897                 locinput += n;
8898             } else
8899                 sayNO;
8900             break;
8901
8902         default:
8903             PerlIO_printf(Perl_error_log, "%" UVxf " %d\n",
8904                           PTR2UV(scan), OP(scan));
8905             Perl_croak(aTHX_ "regexp memory corruption");
8906
8907         /* this is a point to jump to in order to increment
8908          * locinput by one character */
8909           increment_locinput:
8910             assert(!NEXTCHR_IS_EOS);
8911             if (utf8_target) {
8912                 locinput += PL_utf8skip[nextchr];
8913                 /* locinput is allowed to go 1 char off the end (signifying
8914                  * EOS), but not 2+ */
8915                 if (locinput > reginfo->strend)
8916                     sayNO;
8917             }
8918             else
8919                 locinput++;
8920             break;
8921             
8922         } /* end switch */ 
8923
8924         /* switch break jumps here */
8925         scan = next; /* prepare to execute the next op and ... */
8926         continue;    /* ... jump back to the top, reusing st */
8927         /* NOTREACHED */
8928
8929       push_yes_state:
8930         /* push a state that backtracks on success */
8931         st->u.yes.prev_yes_state = yes_state;
8932         yes_state = st;
8933         /* FALLTHROUGH */
8934       push_state:
8935         /* push a new regex state, then continue at scan  */
8936         {
8937             regmatch_state *newst;
8938
8939             DEBUG_STACK_r({
8940                 regmatch_state *cur = st;
8941                 regmatch_state *curyes = yes_state;
8942                 U32 i;
8943                 regmatch_slab *slab = PL_regmatch_slab;
8944                 for (i = 0; i < 3 && i <= depth; cur--,i++) {
8945                     if (cur < SLAB_FIRST(slab)) {
8946                         slab = slab->prev;
8947                         cur = SLAB_LAST(slab);
8948                     }
8949                     Perl_re_exec_indentf( aTHX_ "%4s #%-3d %-10s %s\n",
8950                         depth,
8951                         i ? "    " : "push",
8952                         depth - i, PL_reg_name[cur->resume_state],
8953                         (curyes == cur) ? "yes" : ""
8954                     );
8955                     if (curyes == cur)
8956                         curyes = cur->u.yes.prev_yes_state;
8957                 }
8958             } else 
8959                 DEBUG_STATE_pp("push")
8960             );
8961             depth++;
8962             st->locinput = locinput;
8963             newst = st+1; 
8964             if (newst >  SLAB_LAST(PL_regmatch_slab))
8965                 newst = S_push_slab(aTHX);
8966             PL_regmatch_state = newst;
8967
8968             locinput = pushinput;
8969             st = newst;
8970             continue;
8971             /* NOTREACHED */
8972         }
8973     }
8974 #ifdef SOLARIS_BAD_OPTIMIZER
8975 #  undef PL_charclass
8976 #endif
8977
8978     /*
8979     * We get here only if there's trouble -- normally "case END" is
8980     * the terminating point.
8981     */
8982     Perl_croak(aTHX_ "corrupted regexp pointers");
8983     NOT_REACHED; /* NOTREACHED */
8984
8985   yes:
8986     if (yes_state) {
8987         /* we have successfully completed a subexpression, but we must now
8988          * pop to the state marked by yes_state and continue from there */
8989         assert(st != yes_state);
8990 #ifdef DEBUGGING
8991         while (st != yes_state) {
8992             st--;
8993             if (st < SLAB_FIRST(PL_regmatch_slab)) {
8994                 PL_regmatch_slab = PL_regmatch_slab->prev;
8995                 st = SLAB_LAST(PL_regmatch_slab);
8996             }
8997             DEBUG_STATE_r({
8998                 if (no_final) {
8999                     DEBUG_STATE_pp("pop (no final)");        
9000                 } else {
9001                     DEBUG_STATE_pp("pop (yes)");
9002                 }
9003             });
9004             depth--;
9005         }
9006 #else
9007         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
9008             || yes_state > SLAB_LAST(PL_regmatch_slab))
9009         {
9010             /* not in this slab, pop slab */
9011             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
9012             PL_regmatch_slab = PL_regmatch_slab->prev;
9013             st = SLAB_LAST(PL_regmatch_slab);
9014         }
9015         depth -= (st - yes_state);
9016 #endif
9017         st = yes_state;
9018         yes_state = st->u.yes.prev_yes_state;
9019         PL_regmatch_state = st;
9020         
9021         if (no_final)
9022             locinput= st->locinput;
9023         state_num = st->resume_state + no_final;
9024         goto reenter_switch;
9025     }
9026
9027     DEBUG_EXECUTE_r(Perl_re_printf( aTHX_  "%sMatch successful!%s\n",
9028                           PL_colors[4], PL_colors[5]));
9029
9030     if (reginfo->info_aux_eval) {
9031         /* each successfully executed (?{...}) block does the equivalent of
9032          *   local $^R = do {...}
9033          * When popping the save stack, all these locals would be undone;
9034          * bypass this by setting the outermost saved $^R to the latest
9035          * value */
9036         /* I dont know if this is needed or works properly now.
9037          * see code related to PL_replgv elsewhere in this file.
9038          * Yves
9039          */
9040         if (oreplsv != GvSV(PL_replgv))
9041             sv_setsv(oreplsv, GvSV(PL_replgv));
9042     }
9043     result = 1;
9044     goto final_exit;
9045
9046   no:
9047     DEBUG_EXECUTE_r(
9048         Perl_re_exec_indentf( aTHX_  "%sfailed...%s\n",
9049             depth,
9050             PL_colors[4], PL_colors[5])
9051         );
9052
9053   no_silent:
9054     if (no_final) {
9055         if (yes_state) {
9056             goto yes;
9057         } else {
9058             goto final_exit;
9059         }
9060     }    
9061     if (depth) {
9062         /* there's a previous state to backtrack to */
9063         st--;
9064         if (st < SLAB_FIRST(PL_regmatch_slab)) {
9065             PL_regmatch_slab = PL_regmatch_slab->prev;
9066             st = SLAB_LAST(PL_regmatch_slab);
9067         }
9068         PL_regmatch_state = st;
9069         locinput= st->locinput;
9070
9071         DEBUG_STATE_pp("pop");
9072         depth--;
9073         if (yes_state == st)
9074             yes_state = st->u.yes.prev_yes_state;
9075
9076         state_num = st->resume_state + 1; /* failure = success + 1 */
9077         PERL_ASYNC_CHECK();
9078         goto reenter_switch;
9079     }
9080     result = 0;
9081
9082   final_exit:
9083     if (rex->intflags & PREGf_VERBARG_SEEN) {
9084         SV *sv_err = get_sv("REGERROR", 1);
9085         SV *sv_mrk = get_sv("REGMARK", 1);
9086         if (result) {
9087             sv_commit = &PL_sv_no;
9088             if (!sv_yes_mark) 
9089                 sv_yes_mark = &PL_sv_yes;
9090         } else {
9091             if (!sv_commit) 
9092                 sv_commit = &PL_sv_yes;
9093             sv_yes_mark = &PL_sv_no;
9094         }
9095         assert(sv_err);
9096         assert(sv_mrk);
9097         sv_setsv(sv_err, sv_commit);
9098         sv_setsv(sv_mrk, sv_yes_mark);
9099     }
9100
9101
9102     if (last_pushed_cv) {
9103         dSP;
9104         /* see "Some notes about MULTICALL" above */
9105         POP_MULTICALL;
9106         PERL_UNUSED_VAR(SP);
9107     }
9108     else
9109         LEAVE_SCOPE(orig_savestack_ix);
9110
9111     assert(!result ||  locinput - reginfo->strbeg >= 0);
9112     return result ?  locinput - reginfo->strbeg : -1;
9113 }
9114
9115 /*
9116  - regrepeat - repeatedly match something simple, report how many
9117  *
9118  * What 'simple' means is a node which can be the operand of a quantifier like
9119  * '+', or {1,3}
9120  *
9121  * startposp - pointer a pointer to the start position.  This is updated
9122  *             to point to the byte following the highest successful
9123  *             match.
9124  * p         - the regnode to be repeatedly matched against.
9125  * reginfo   - struct holding match state, such as strend
9126  * max       - maximum number of things to match.
9127  * depth     - (for debugging) backtracking depth.
9128  */
9129 STATIC I32
9130 S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
9131             regmatch_info *const reginfo, I32 max _pDEPTH)
9132 {
9133     char *scan;     /* Pointer to current position in target string */
9134     I32 c;
9135     char *loceol = reginfo->strend;   /* local version */
9136     I32 hardcount = 0;  /* How many matches so far */
9137     bool utf8_target = reginfo->is_utf8_target;
9138     unsigned int to_complement = 0;  /* Invert the result? */
9139     UV utf8_flags;
9140     _char_class_number classnum;
9141
9142     PERL_ARGS_ASSERT_REGREPEAT;
9143
9144     scan = *startposp;
9145     if (max == REG_INFTY)
9146         max = I32_MAX;
9147     else if (! utf8_target && loceol - scan > max)
9148         loceol = scan + max;
9149
9150     /* Here, for the case of a non-UTF-8 target we have adjusted <loceol> down
9151      * to the maximum of how far we should go in it (leaving it set to the real
9152      * end, if the maximum permissible would take us beyond that).  This allows
9153      * us to make the loop exit condition that we haven't gone past <loceol> to
9154      * also mean that we haven't exceeded the max permissible count, saving a
9155      * test each time through the loop.  But it assumes that the OP matches a
9156      * single byte, which is true for most of the OPs below when applied to a
9157      * non-UTF-8 target.  Those relatively few OPs that don't have this
9158      * characteristic will have to compensate.
9159      *
9160      * There is no adjustment for UTF-8 targets, as the number of bytes per
9161      * character varies.  OPs will have to test both that the count is less
9162      * than the max permissible (using <hardcount> to keep track), and that we
9163      * are still within the bounds of the string (using <loceol>.  A few OPs
9164      * match a single byte no matter what the encoding.  They can omit the max
9165      * test if, for the UTF-8 case, they do the adjustment that was skipped
9166      * above.
9167      *
9168      * Thus, the code above sets things up for the common case; and exceptional
9169      * cases need extra work; the common case is to make sure <scan> doesn't
9170      * go past <loceol>, and for UTF-8 to also use <hardcount> to make sure the
9171      * count doesn't exceed the maximum permissible */
9172
9173     switch (OP(p)) {
9174     case REG_ANY:
9175         if (utf8_target) {
9176             while (scan < loceol && hardcount < max && *scan != '\n') {
9177                 scan += UTF8SKIP(scan);
9178                 hardcount++;
9179             }
9180         } else {
9181             scan = (char *) memchr(scan, '\n', loceol - scan);
9182             if (! scan) {
9183                 scan = loceol;
9184             }
9185         }
9186         break;
9187     case SANY:
9188         if (utf8_target) {
9189             while (scan < loceol && hardcount < max) {
9190                 scan += UTF8SKIP(scan);
9191                 hardcount++;
9192             }
9193         }
9194         else
9195             scan = loceol;
9196         break;
9197     case EXACTL:
9198         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
9199         if (utf8_target && UTF8_IS_ABOVE_LATIN1(*scan)) {
9200             _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(scan, loceol);
9201         }
9202         /* FALLTHROUGH */
9203     case EXACT:
9204         assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1);
9205
9206         c = (U8)*STRING(p);
9207
9208         /* Can use a simple find if the pattern char to match on is invariant
9209          * under UTF-8, or both target and pattern aren't UTF-8.  Note that we
9210          * can use UTF8_IS_INVARIANT() even if the pattern isn't UTF-8, as it's
9211          * true iff it doesn't matter if the argument is in UTF-8 or not */
9212         if (UTF8_IS_INVARIANT(c) || (! utf8_target && ! reginfo->is_utf8_pat)) {
9213             if (utf8_target && loceol - scan > max) {
9214                 /* We didn't adjust <loceol> because is UTF-8, but ok to do so,
9215                  * since here, to match at all, 1 char == 1 byte */
9216                 loceol = scan + max;
9217             }
9218             scan = (char *) find_span_end((U8 *) scan, (U8 *) loceol, (U8) c);
9219         }
9220         else if (reginfo->is_utf8_pat) {
9221             if (utf8_target) {
9222                 STRLEN scan_char_len;
9223
9224                 /* When both target and pattern are UTF-8, we have to do
9225                  * string EQ */
9226                 while (hardcount < max
9227                        && scan < loceol
9228                        && (scan_char_len = UTF8SKIP(scan)) <= STR_LEN(p)
9229                        && memEQ(scan, STRING(p), scan_char_len))
9230                 {
9231                     scan += scan_char_len;
9232                     hardcount++;
9233                 }
9234             }
9235             else if (! UTF8_IS_ABOVE_LATIN1(c)) {
9236
9237                 /* Target isn't utf8; convert the character in the UTF-8
9238                  * pattern to non-UTF8, and do a simple find */
9239                 c = EIGHT_BIT_UTF8_TO_NATIVE(c, *(STRING(p) + 1));
9240                 scan = (char *) find_span_end((U8 *) scan, (U8 *) loceol, (U8) c);
9241             } /* else pattern char is above Latin1, can't possibly match the
9242                  non-UTF-8 target */
9243         }
9244         else {
9245
9246             /* Here, the string must be utf8; pattern isn't, and <c> is
9247              * different in utf8 than not, so can't compare them directly.
9248              * Outside the loop, find the two utf8 bytes that represent c, and
9249              * then look for those in sequence in the utf8 string */
9250             U8 high = UTF8_TWO_BYTE_HI(c);
9251             U8 low = UTF8_TWO_BYTE_LO(c);
9252
9253             while (hardcount < max
9254                     && scan + 1 < loceol
9255                     && UCHARAT(scan) == high
9256                     && UCHARAT(scan + 1) == low)
9257             {
9258                 scan += 2;
9259                 hardcount++;
9260             }
9261         }
9262         break;
9263
9264     case EXACTFAA_NO_TRIE: /* This node only generated for non-utf8 patterns */
9265         assert(! reginfo->is_utf8_pat);
9266         /* FALLTHROUGH */
9267     case EXACTFAA:
9268         utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
9269         goto do_exactf;
9270
9271     case EXACTFL:
9272         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
9273         utf8_flags = FOLDEQ_LOCALE;
9274         goto do_exactf;
9275
9276     case EXACTF:   /* This node only generated for non-utf8 patterns */
9277         assert(! reginfo->is_utf8_pat);
9278         utf8_flags = 0;
9279         goto do_exactf;
9280
9281     case EXACTFLU8:
9282         if (! utf8_target) {
9283             break;
9284         }
9285         utf8_flags =  FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED
9286                                     | FOLDEQ_S2_FOLDS_SANE;
9287         goto do_exactf;
9288
9289     case EXACTFU_SS:
9290     case EXACTFU:
9291         utf8_flags = reginfo->is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
9292
9293       do_exactf: {
9294         int c1, c2;
9295         U8 c1_utf8[UTF8_MAXBYTES+1], c2_utf8[UTF8_MAXBYTES+1];
9296
9297         assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1);
9298
9299         if (S_setup_EXACTISH_ST_c1_c2(aTHX_ p, &c1, c1_utf8, &c2, c2_utf8,
9300                                         reginfo))
9301         {
9302             if (c1 == CHRTEST_VOID) {
9303                 /* Use full Unicode fold matching */
9304                 char *tmpeol = reginfo->strend;
9305                 STRLEN pat_len = reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1;
9306                 while (hardcount < max
9307                         && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target,
9308                                              STRING(p), NULL, pat_len,
9309                                              reginfo->is_utf8_pat, utf8_flags))
9310                 {
9311                     scan = tmpeol;
9312                     tmpeol = reginfo->strend;
9313                     hardcount++;
9314                 }
9315             }
9316             else if (utf8_target) {
9317                 if (c1 == c2) {
9318                     while (scan < loceol
9319                            && hardcount < max
9320                            && memEQ(scan, c1_utf8, UTF8SKIP(scan)))
9321                     {
9322                         scan += UTF8SKIP(scan);
9323                         hardcount++;
9324                     }
9325                 }
9326                 else {
9327                     while (scan < loceol
9328                            && hardcount < max
9329                            && (memEQ(scan, c1_utf8, UTF8SKIP(scan))
9330                                || memEQ(scan, c2_utf8, UTF8SKIP(scan))))
9331                     {
9332                         scan += UTF8SKIP(scan);
9333                         hardcount++;
9334                     }
9335                 }
9336             }
9337             else if (c1 == c2) {
9338                 scan = (char *) find_span_end((U8 *) scan, (U8 *) loceol, (U8) c1);
9339             }
9340             else {
9341                 /* See comments in regmatch() CURLY_B_min_known_fail.  We avoid
9342                  * a conditional each time through the loop if the characters
9343                  * differ only in a single bit, as is the usual situation */
9344                 U8 c1_c2_bits_differing = c1 ^ c2;
9345
9346                 if (isPOWER_OF_2(c1_c2_bits_differing)) {
9347                     U8 c1_c2_mask = ~ c1_c2_bits_differing;
9348
9349                     scan = (char *) find_span_end_mask((U8 *) scan,
9350                                                        (U8 *) loceol,
9351                                                        c1 & c1_c2_mask,
9352                                                        c1_c2_mask);
9353                 }
9354                 else {
9355                     while (    scan < loceol
9356                            && (UCHARAT(scan) == c1 || UCHARAT(scan) == c2))
9357                     {
9358                         scan++;
9359                     }
9360                 }
9361             }
9362         }
9363         break;
9364     }
9365     case ANYOFPOSIXL:
9366     case ANYOFL:
9367         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
9368
9369         if (ANYOFL_UTF8_LOCALE_REQD(FLAGS(p)) && ! IN_UTF8_CTYPE_LOCALE) {
9370             Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), utf8_locale_required);
9371         }
9372         /* FALLTHROUGH */
9373     case ANYOFD:
9374     case ANYOF:
9375         if (utf8_target) {
9376             while (hardcount < max
9377                    && scan < loceol
9378                    && reginclass(prog, p, (U8*)scan, (U8*) loceol, utf8_target))
9379             {
9380                 scan += UTF8SKIP(scan);
9381                 hardcount++;
9382             }
9383         }
9384         else if (ANYOF_FLAGS(p)) {
9385             while (scan < loceol
9386                     && reginclass(prog, p, (U8*)scan, (U8*)scan+1, 0))
9387                 scan++;
9388         }
9389         else {
9390             while (scan < loceol && ANYOF_BITMAP_TEST(p, *((U8*)scan)))
9391                 scan++;
9392         }
9393         break;
9394
9395     case ANYOFM:
9396         if (utf8_target && loceol - scan > max) {
9397
9398             /* We didn't adjust <loceol> at the beginning of this routine
9399              * because is UTF-8, but it is actually ok to do so, since here, to
9400              * match, 1 char == 1 byte. */
9401             loceol = scan + max;
9402         }
9403
9404         scan = (char *) find_span_end_mask((U8 *) scan, (U8 *) loceol, (U8) ARG(p), FLAGS(p));
9405         break;
9406
9407     case NANYOFM:
9408         if (utf8_target) {
9409             while (     hardcount < max
9410                    &&   scan < loceol
9411                    &&  (*scan & FLAGS(p)) != ARG(p))
9412             {
9413                 scan += UTF8SKIP(scan);
9414                 hardcount++;
9415             }
9416         }
9417         else {
9418             scan = (char *) find_next_masked((U8 *) scan, (U8 *) loceol, (U8) ARG(p), FLAGS(p));
9419         }
9420         break;
9421
9422     case ASCII:
9423         if (utf8_target && loceol - scan > max) {
9424             loceol = scan + max;
9425         }
9426
9427         scan = find_next_non_ascii(scan, loceol, utf8_target);
9428         break;
9429
9430     case NASCII:
9431         if (utf8_target) {
9432             while (     hardcount < max
9433                    &&   scan < loceol
9434                    && ! isASCII_utf8_safe(scan, loceol))
9435             {
9436                 scan += UTF8SKIP(scan);
9437                 hardcount++;
9438             }
9439         }
9440         else {
9441             scan = find_next_ascii(scan, loceol, utf8_target);
9442         }
9443         break;
9444
9445     /* The argument (FLAGS) to all the POSIX node types is the class number */
9446
9447     case NPOSIXL:
9448         to_complement = 1;
9449         /* FALLTHROUGH */
9450
9451     case POSIXL:
9452         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
9453         if (! utf8_target) {
9454             while (scan < loceol && to_complement ^ cBOOL(isFOO_lc(FLAGS(p),
9455                                                                    *scan)))
9456             {
9457                 scan++;
9458             }
9459         } else {
9460             while (hardcount < max && scan < loceol
9461                    && to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(p),
9462                                                                   (U8 *) scan,
9463                                                                   (U8 *) loceol)))
9464             {
9465                 scan += UTF8SKIP(scan);
9466                 hardcount++;
9467             }
9468         }
9469         break;
9470
9471     case POSIXD:
9472         if (utf8_target) {
9473             goto utf8_posix;
9474         }
9475         /* FALLTHROUGH */
9476
9477     case POSIXA:
9478         if (utf8_target && loceol - scan > max) {
9479
9480             /* We didn't adjust <loceol> at the beginning of this routine
9481              * because is UTF-8, but it is actually ok to do so, since here, to
9482              * match, 1 char == 1 byte. */
9483             loceol = scan + max;
9484         }
9485         while (scan < loceol && _generic_isCC_A((U8) *scan, FLAGS(p))) {
9486             scan++;
9487         }
9488         break;
9489
9490     case NPOSIXD:
9491         if (utf8_target) {
9492             to_complement = 1;
9493             goto utf8_posix;
9494         }
9495         /* FALLTHROUGH */
9496
9497     case NPOSIXA:
9498         if (! utf8_target) {
9499             while (scan < loceol && ! _generic_isCC_A((U8) *scan, FLAGS(p))) {
9500                 scan++;
9501             }
9502         }
9503         else {
9504
9505             /* The complement of something that matches only ASCII matches all
9506              * non-ASCII, plus everything in ASCII that isn't in the class. */
9507             while (hardcount < max && scan < loceol
9508                    && (   ! isASCII_utf8_safe(scan, reginfo->strend)
9509                        || ! _generic_isCC_A((U8) *scan, FLAGS(p))))
9510             {
9511                 scan += UTF8SKIP(scan);
9512                 hardcount++;
9513             }
9514         }
9515         break;
9516
9517     case NPOSIXU:
9518         to_complement = 1;
9519         /* FALLTHROUGH */
9520
9521     case POSIXU:
9522         if (! utf8_target) {
9523             while (scan < loceol && to_complement
9524                                 ^ cBOOL(_generic_isCC((U8) *scan, FLAGS(p))))
9525             {
9526                 scan++;
9527             }
9528         }
9529         else {
9530           utf8_posix:
9531             classnum = (_char_class_number) FLAGS(p);
9532             switch (classnum) {
9533                 default:
9534                     while (   hardcount < max && scan < loceol
9535                            && to_complement ^ cBOOL(_invlist_contains_cp(
9536                                               PL_XPosix_ptrs[classnum],
9537                                               utf8_to_uvchr_buf((U8 *) scan,
9538                                                                 (U8 *) loceol,
9539                                                                 NULL))))
9540                     {
9541                         scan += UTF8SKIP(scan);
9542                         hardcount++;
9543                     }
9544                     break;
9545
9546                     /* For the classes below, the knowledge of how to handle
9547                      * every code point is compiled in to Perl via a macro.
9548                      * This code is written for making the loops as tight as
9549                      * possible.  It could be refactored to save space instead.
9550                      * */
9551
9552                 case _CC_ENUM_SPACE:
9553                     while (hardcount < max
9554                            && scan < loceol
9555                            && (to_complement
9556                                ^ cBOOL(isSPACE_utf8_safe(scan, loceol))))
9557                     {
9558                         scan += UTF8SKIP(scan);
9559                         hardcount++;
9560                     }
9561                     break;
9562                 case _CC_ENUM_BLANK:
9563                     while (hardcount < max
9564                            && scan < loceol
9565                            && (to_complement
9566                                 ^ cBOOL(isBLANK_utf8_safe(scan, loceol))))
9567                     {
9568                         scan += UTF8SKIP(scan);
9569                         hardcount++;
9570                     }
9571                     break;
9572                 case _CC_ENUM_XDIGIT:
9573                     while (hardcount < max
9574                            && scan < loceol
9575                            && (to_complement
9576                                ^ cBOOL(isXDIGIT_utf8_safe(scan, loceol))))
9577                     {
9578                         scan += UTF8SKIP(scan);
9579                         hardcount++;
9580                     }
9581                     break;
9582                 case _CC_ENUM_VERTSPACE:
9583                     while (hardcount < max
9584                            && scan < loceol
9585                            && (to_complement
9586                                ^ cBOOL(isVERTWS_utf8_safe(scan, loceol))))
9587                     {
9588                         scan += UTF8SKIP(scan);
9589                         hardcount++;
9590                     }
9591                     break;
9592                 case _CC_ENUM_CNTRL:
9593                     while (hardcount < max
9594                            && scan < loceol
9595                            && (to_complement
9596                                ^ cBOOL(isCNTRL_utf8_safe(scan, loceol))))
9597                     {
9598                         scan += UTF8SKIP(scan);
9599                         hardcount++;
9600                     }
9601                     break;
9602             }
9603         }
9604         break;
9605
9606     case LNBREAK:
9607         if (utf8_target) {
9608             while (hardcount < max && scan < loceol &&
9609                     (c=is_LNBREAK_utf8_safe(scan, loceol))) {
9610                 scan += c;
9611                 hardcount++;
9612             }
9613         } else {
9614             /* LNBREAK can match one or two latin chars, which is ok, but we
9615              * have to use hardcount in this situation, and throw away the
9616              * adjustment to <loceol> done before the switch statement */
9617             loceol = reginfo->strend;
9618             while (scan < loceol && (c=is_LNBREAK_latin1_safe(scan, loceol))) {
9619                 scan+=c;
9620                 hardcount++;
9621             }
9622         }
9623         break;
9624
9625     case BOUNDL:
9626     case NBOUNDL:
9627         _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
9628         /* FALLTHROUGH */
9629     case BOUND:
9630     case BOUNDA:
9631     case BOUNDU:
9632     case EOS:
9633     case GPOS:
9634     case KEEPS:
9635     case NBOUND:
9636     case NBOUNDA:
9637     case NBOUNDU:
9638     case OPFAIL:
9639     case SBOL:
9640     case SEOL:
9641         /* These are all 0 width, so match right here or not at all. */
9642         break;
9643
9644     default:
9645         Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]);
9646         NOT_REACHED; /* NOTREACHED */
9647
9648     }
9649
9650     if (hardcount)
9651         c = hardcount;
9652     else
9653         c = scan - *startposp;
9654     *startposp = scan;
9655
9656     DEBUG_r({
9657         GET_RE_DEBUG_FLAGS_DECL;
9658         DEBUG_EXECUTE_r({
9659             SV * const prop = sv_newmortal();
9660             regprop(prog, prop, p, reginfo, NULL);
9661             Perl_re_exec_indentf( aTHX_  "%s can match %" IVdf " times out of %" IVdf "...\n",
9662                         depth, SvPVX_const(prop),(IV)c,(IV)max);
9663         });
9664     });
9665
9666     return(c);
9667 }
9668
9669
9670 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
9671 /*
9672 - regclass_swash - prepare the utf8 swash.  Wraps the shared core version to
9673 create a copy so that changes the caller makes won't change the shared one.
9674 If <altsvp> is non-null, will return NULL in it, for back-compat.
9675  */
9676 SV *
9677 Perl_regclass_swash(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
9678 {
9679     PERL_ARGS_ASSERT_REGCLASS_SWASH;
9680
9681     if (altsvp) {
9682         *altsvp = NULL;
9683     }
9684
9685     return newSVsv(_get_regclass_nonbitmap_data(prog, node, doinit, listsvp, NULL, NULL));
9686 }
9687
9688 #endif /* !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) */
9689
9690 /*
9691  - reginclass - determine if a character falls into a character class
9692  
9693   n is the ANYOF-type regnode
9694   p is the target string
9695   p_end points to one byte beyond the end of the target string
9696   utf8_target tells whether p is in UTF-8.
9697
9698   Returns true if matched; false otherwise.
9699
9700   Note that this can be a synthetic start class, a combination of various
9701   nodes, so things you think might be mutually exclusive, such as locale,
9702   aren't.  It can match both locale and non-locale
9703
9704  */
9705
9706 STATIC bool
9707 S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const p, const U8* const p_end, const bool utf8_target)
9708 {
9709     dVAR;
9710     const char flags = ANYOF_FLAGS(n);
9711     bool match = FALSE;
9712     UV c = *p;
9713
9714     PERL_ARGS_ASSERT_REGINCLASS;
9715
9716     /* If c is not already the code point, get it.  Note that
9717      * UTF8_IS_INVARIANT() works even if not in UTF-8 */
9718     if (! UTF8_IS_INVARIANT(c) && utf8_target) {
9719         STRLEN c_len = 0;
9720         const U32 utf8n_flags = UTF8_ALLOW_DEFAULT;
9721         c = utf8n_to_uvchr(p, p_end - p, &c_len, utf8n_flags | UTF8_CHECK_ONLY);
9722         if (c_len == (STRLEN)-1) {
9723             _force_out_malformed_utf8_message(p, p_end,
9724                                               utf8n_flags,
9725                                               1 /* 1 means die */ );
9726             NOT_REACHED; /* NOTREACHED */
9727         }
9728         if (     c > 255
9729             &&  (OP(n) == ANYOFL || OP(n) == ANYOFPOSIXL)
9730             && ! ANYOFL_UTF8_LOCALE_REQD(flags))
9731         {
9732             _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c);
9733         }
9734     }
9735
9736     /* If this character is potentially in the bitmap, check it */
9737     if (c < NUM_ANYOF_CODE_POINTS) {
9738         if (ANYOF_BITMAP_TEST(n, c))
9739             match = TRUE;
9740         else if ((flags
9741                 & ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER)
9742                   && OP(n) == ANYOFD
9743                   && ! utf8_target
9744                   && ! isASCII(c))
9745         {
9746             match = TRUE;
9747         }
9748         else if (flags & ANYOF_LOCALE_FLAGS) {
9749             if ((flags & ANYOFL_FOLD)
9750                 && c < 256
9751                 && ANYOF_BITMAP_TEST(n, PL_fold_locale[c]))
9752             {
9753                 match = TRUE;
9754             }
9755             else if (ANYOF_POSIXL_TEST_ANY_SET(n)
9756                      && c < 256
9757             ) {
9758
9759                 /* The data structure is arranged so bits 0, 2, 4, ... are set
9760                  * if the class includes the Posix character class given by
9761                  * bit/2; and 1, 3, 5, ... are set if the class includes the
9762                  * complemented Posix class given by int(bit/2).  So we loop
9763                  * through the bits, each time changing whether we complement
9764                  * the result or not.  Suppose for the sake of illustration
9765                  * that bits 0-3 mean respectively, \w, \W, \s, \S.  If bit 0
9766                  * is set, it means there is a match for this ANYOF node if the
9767                  * character is in the class given by the expression (0 / 2 = 0
9768                  * = \w).  If it is in that class, isFOO_lc() will return 1,
9769                  * and since 'to_complement' is 0, the result will stay TRUE,
9770                  * and we exit the loop.  Suppose instead that bit 0 is 0, but
9771                  * bit 1 is 1.  That means there is a match if the character
9772                  * matches \W.  We won't bother to call isFOO_lc() on bit 0,
9773                  * but will on bit 1.  On the second iteration 'to_complement'
9774                  * will be 1, so the exclusive or will reverse things, so we
9775                  * are testing for \W.  On the third iteration, 'to_complement'
9776                  * will be 0, and we would be testing for \s; the fourth
9777                  * iteration would test for \S, etc.
9778                  *
9779                  * Note that this code assumes that all the classes are closed
9780                  * under folding.  For example, if a character matches \w, then
9781                  * its fold does too; and vice versa.  This should be true for
9782                  * any well-behaved locale for all the currently defined Posix
9783                  * classes, except for :lower: and :upper:, which are handled
9784                  * by the pseudo-class :cased: which matches if either of the
9785                  * other two does.  To get rid of this assumption, an outer
9786                  * loop could be used below to iterate over both the source
9787                  * character, and its fold (if different) */
9788
9789                 int count = 0;
9790                 int to_complement = 0;
9791
9792                 while (count < ANYOF_MAX) {
9793                     if (ANYOF_POSIXL_TEST(n, count)
9794                         && to_complement ^ cBOOL(isFOO_lc(count/2, (U8) c)))
9795                     {
9796                         match = TRUE;
9797                         break;
9798                     }
9799                     count++;
9800                     to_complement ^= 1;
9801                 }
9802             }
9803         }
9804     }
9805
9806
9807     /* If the bitmap didn't (or couldn't) match, and something outside the
9808      * bitmap could match, try that. */
9809     if (!match) {
9810         if (c >= NUM_ANYOF_CODE_POINTS
9811             && (flags & ANYOF_MATCHES_ALL_ABOVE_BITMAP))
9812         {
9813             match = TRUE;       /* Everything above the bitmap matches */
9814         }
9815             /* Here doesn't match everything above the bitmap.  If there is
9816              * some information available beyond the bitmap, we may find a
9817              * match in it.  If so, this is most likely because the code point
9818              * is outside the bitmap range.  But rarely, it could be because of
9819              * some other reason.  If so, various flags are set to indicate
9820              * this possibility.  On ANYOFD nodes, there may be matches that
9821              * happen only when the target string is UTF-8; or for other node
9822              * types, because runtime lookup is needed, regardless of the
9823              * UTF-8ness of the target string.  Finally, under /il, there may
9824              * be some matches only possible if the locale is a UTF-8 one. */
9825         else if (    ARG(n) != ANYOF_ONLY_HAS_BITMAP
9826                  && (   c >= NUM_ANYOF_CODE_POINTS
9827                      || (   (flags & ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)
9828                          && (   UNLIKELY(OP(n) != ANYOFD)
9829                              || (utf8_target && ! isASCII_uni(c)
9830 #                               if NUM_ANYOF_CODE_POINTS > 256
9831                                                                  && c < 256
9832 #                               endif
9833                                 )))
9834                      || (   ANYOFL_SOME_FOLDS_ONLY_IN_UTF8_LOCALE(flags)
9835                          && IN_UTF8_CTYPE_LOCALE)))
9836         {
9837             SV* only_utf8_locale = NULL;
9838             SV * const sw = _get_regclass_nonbitmap_data(prog, n, TRUE, 0,
9839                                                        &only_utf8_locale, NULL);
9840             if (sw) {
9841                 U8 utf8_buffer[2];
9842                 U8 * utf8_p;
9843                 if (utf8_target) {
9844                     utf8_p = (U8 *) p;
9845                 } else { /* Convert to utf8 */
9846                     utf8_p = utf8_buffer;
9847                     append_utf8_from_native_byte(*p, &utf8_p);
9848                     utf8_p = utf8_buffer;
9849                 }
9850
9851                 if (swash_fetch(sw, utf8_p, TRUE)) {
9852                     match = TRUE;
9853                 }
9854             }
9855             if (! match && only_utf8_locale && IN_UTF8_CTYPE_LOCALE) {
9856                 match = _invlist_contains_cp(only_utf8_locale, c);
9857             }
9858         }
9859
9860         if (UNICODE_IS_SUPER(c)
9861             && (flags
9862                & ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER)
9863             && OP(n) != ANYOFD
9864             && ckWARN_d(WARN_NON_UNICODE))
9865         {
9866             Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
9867                 "Matched non-Unicode code point 0x%04" UVXf " against Unicode property; may not be portable", c);
9868         }
9869     }
9870
9871 #if ANYOF_INVERT != 1
9872     /* Depending on compiler optimization cBOOL takes time, so if don't have to
9873      * use it, don't */
9874 #   error ANYOF_INVERT needs to be set to 1, or guarded with cBOOL below,
9875 #endif
9876
9877     /* The xor complements the return if to invert: 1^1 = 0, 1^0 = 1 */
9878     return (flags & ANYOF_INVERT) ^ match;
9879 }
9880
9881 STATIC U8 *
9882 S_reghop3(U8 *s, SSize_t off, const U8* lim)
9883 {
9884     /* return the position 'off' UTF-8 characters away from 's', forward if
9885      * 'off' >= 0, backwards if negative.  But don't go outside of position
9886      * 'lim', which better be < s  if off < 0 */
9887
9888     PERL_ARGS_ASSERT_REGHOP3;
9889
9890     if (off >= 0) {
9891         while (off-- && s < lim) {
9892             /* XXX could check well-formedness here */
9893             U8 *new_s = s + UTF8SKIP(s);
9894             if (new_s > lim) /* lim may be in the middle of a long character */
9895                 return s;
9896             s = new_s;
9897         }
9898     }
9899     else {
9900         while (off++ && s > lim) {
9901             s--;
9902             if (UTF8_IS_CONTINUED(*s)) {
9903                 while (s > lim && UTF8_IS_CONTINUATION(*s))
9904                     s--;
9905                 if (! UTF8_IS_START(*s)) {
9906                     Perl_croak_nocontext("Malformed UTF-8 character (fatal)");
9907                 }
9908             }
9909             /* XXX could check well-formedness here */
9910         }
9911     }
9912     return s;
9913 }
9914
9915 STATIC U8 *
9916 S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim)
9917 {
9918     PERL_ARGS_ASSERT_REGHOP4;
9919
9920     if (off >= 0) {
9921         while (off-- && s < rlim) {
9922             /* XXX could check well-formedness here */
9923             s += UTF8SKIP(s);
9924         }
9925     }
9926     else {
9927         while (off++ && s > llim) {
9928             s--;
9929             if (UTF8_IS_CONTINUED(*s)) {
9930                 while (s > llim && UTF8_IS_CONTINUATION(*s))
9931                     s--;
9932                 if (! UTF8_IS_START(*s)) {
9933                     Perl_croak_nocontext("Malformed UTF-8 character (fatal)");
9934                 }
9935             }
9936             /* XXX could check well-formedness here */
9937         }
9938     }
9939     return s;
9940 }
9941
9942 /* like reghop3, but returns NULL on overrun, rather than returning last
9943  * char pos */
9944
9945 STATIC U8 *
9946 S_reghopmaybe3(U8* s, SSize_t off, const U8* const lim)
9947 {
9948     PERL_ARGS_ASSERT_REGHOPMAYBE3;
9949
9950     if (off >= 0) {
9951         while (off-- && s < lim) {
9952             /* XXX could check well-formedness here */
9953             s += UTF8SKIP(s);
9954         }
9955         if (off >= 0)
9956             return NULL;
9957     }
9958     else {
9959         while (off++ && s > lim) {
9960             s--;
9961             if (UTF8_IS_CONTINUED(*s)) {
9962                 while (s > lim && UTF8_IS_CONTINUATION(*s))
9963                     s--;
9964                 if (! UTF8_IS_START(*s)) {
9965                     Perl_croak_nocontext("Malformed UTF-8 character (fatal)");
9966                 }
9967             }
9968             /* XXX could check well-formedness here */
9969         }
9970         if (off <= 0)
9971             return NULL;
9972     }
9973     return s;
9974 }
9975
9976
9977 /* when executing a regex that may have (?{}), extra stuff needs setting
9978    up that will be visible to the called code, even before the current
9979    match has finished. In particular:
9980
9981    * $_ is localised to the SV currently being matched;
9982    * pos($_) is created if necessary, ready to be updated on each call-out
9983      to code;
9984    * a fake PMOP is created that can be set to PL_curpm (normally PL_curpm
9985      isn't set until the current pattern is successfully finished), so that
9986      $1 etc of the match-so-far can be seen;
9987    * save the old values of subbeg etc of the current regex, and  set then
9988      to the current string (again, this is normally only done at the end
9989      of execution)
9990 */
9991
9992 static void
9993 S_setup_eval_state(pTHX_ regmatch_info *const reginfo)
9994 {
9995     MAGIC *mg;
9996     regexp *const rex = ReANY(reginfo->prog);
9997     regmatch_info_aux_eval *eval_state = reginfo->info_aux_eval;
9998
9999     eval_state->rex = rex;
10000
10001     if (reginfo->sv) {
10002         /* Make $_ available to executed code. */
10003         if (reginfo->sv != DEFSV) {
10004             SAVE_DEFSV;
10005             DEFSV_set(reginfo->sv);
10006         }
10007
10008         if (!(mg = mg_find_mglob(reginfo->sv))) {
10009             /* prepare for quick setting of pos */
10010             mg = sv_magicext_mglob(reginfo->sv);
10011             mg->mg_len = -1;
10012         }
10013         eval_state->pos_magic = mg;
10014         eval_state->pos       = mg->mg_len;
10015         eval_state->pos_flags = mg->mg_flags;
10016     }
10017     else
10018         eval_state->pos_magic = NULL;
10019
10020     if (!PL_reg_curpm) {
10021         /* PL_reg_curpm is a fake PMOP that we can attach the current
10022          * regex to and point PL_curpm at, so that $1 et al are visible
10023          * within a /(?{})/. It's just allocated once per interpreter the
10024          * first time its needed */
10025         Newxz(PL_reg_curpm, 1, PMOP);
10026 #ifdef USE_ITHREADS
10027         {
10028             SV* const repointer = &PL_sv_undef;
10029             /* this regexp is also owned by the new PL_reg_curpm, which
10030                will try to free it.  */
10031             av_push(PL_regex_padav, repointer);
10032             PL_reg_curpm->op_pmoffset = av_tindex(PL_regex_padav);
10033             PL_regex_pad = AvARRAY(PL_regex_padav);
10034         }
10035 #endif
10036     }
10037     SET_reg_curpm(reginfo->prog);
10038     eval_state->curpm = PL_curpm;
10039     PL_curpm_under = PL_curpm;
10040     PL_curpm = PL_reg_curpm;
10041     if (RXp_MATCH_COPIED(rex)) {
10042         /*  Here is a serious problem: we cannot rewrite subbeg,
10043             since it may be needed if this match fails.  Thus
10044             $` inside (?{}) could fail... */
10045         eval_state->subbeg     = rex->subbeg;
10046         eval_state->sublen     = rex->sublen;
10047         eval_state->suboffset  = rex->suboffset;
10048         eval_state->subcoffset = rex->subcoffset;
10049 #ifdef PERL_ANY_COW
10050         eval_state->saved_copy = rex->saved_copy;
10051 #endif
10052         RXp_MATCH_COPIED_off(rex);
10053     }
10054     else
10055         eval_state->subbeg = NULL;
10056     rex->subbeg = (char *)reginfo->strbeg;
10057     rex->suboffset = 0;
10058     rex->subcoffset = 0;
10059     rex->sublen = reginfo->strend - reginfo->strbeg;
10060 }
10061
10062
10063 /* destructor to clear up regmatch_info_aux and regmatch_info_aux_eval */
10064
10065 static void
10066 S_cleanup_regmatch_info_aux(pTHX_ void *arg)
10067 {
10068     regmatch_info_aux *aux = (regmatch_info_aux *) arg;
10069     regmatch_info_aux_eval *eval_state =  aux->info_aux_eval;
10070     regmatch_slab *s;
10071
10072     Safefree(aux->poscache);
10073
10074     if (eval_state) {
10075
10076         /* undo the effects of S_setup_eval_state() */
10077
10078         if (eval_state->subbeg) {
10079             regexp * const rex = eval_state->rex;
10080             rex->subbeg     = eval_state->subbeg;
10081             rex->sublen     = eval_state->sublen;
10082             rex->suboffset  = eval_state->suboffset;
10083             rex->subcoffset = eval_state->subcoffset;
10084 #ifdef PERL_ANY_COW
10085             rex->saved_copy = eval_state->saved_copy;
10086 #endif
10087             RXp_MATCH_COPIED_on(rex);
10088         }
10089         if (eval_state->pos_magic)
10090         {
10091             eval_state->pos_magic->mg_len = eval_state->pos;
10092             eval_state->pos_magic->mg_flags =
10093                  (eval_state->pos_magic->mg_flags & ~MGf_BYTES)
10094                | (eval_state->pos_flags & MGf_BYTES);
10095         }
10096
10097         PL_curpm = eval_state->curpm;
10098     }
10099
10100     PL_regmatch_state = aux->old_regmatch_state;
10101     PL_regmatch_slab  = aux->old_regmatch_slab;
10102
10103     /* free all slabs above current one - this must be the last action
10104      * of this function, as aux and eval_state are allocated within
10105      * slabs and may be freed here */
10106
10107     s = PL_regmatch_slab->next;
10108     if (s) {
10109         PL_regmatch_slab->next = NULL;
10110         while (s) {
10111             regmatch_slab * const osl = s;
10112             s = s->next;
10113             Safefree(osl);
10114         }
10115     }
10116 }
10117
10118
10119 STATIC void
10120 S_to_utf8_substr(pTHX_ regexp *prog)
10121 {
10122     /* Converts substr fields in prog from bytes to UTF-8, calling fbm_compile
10123      * on the converted value */
10124
10125     int i = 1;
10126
10127     PERL_ARGS_ASSERT_TO_UTF8_SUBSTR;
10128
10129     do {
10130         if (prog->substrs->data[i].substr
10131             && !prog->substrs->data[i].utf8_substr) {
10132             SV* const sv = newSVsv(prog->substrs->data[i].substr);
10133             prog->substrs->data[i].utf8_substr = sv;
10134             sv_utf8_upgrade(sv);
10135             if (SvVALID(prog->substrs->data[i].substr)) {
10136                 if (SvTAIL(prog->substrs->data[i].substr)) {
10137                     /* Trim the trailing \n that fbm_compile added last
10138                        time.  */
10139                     SvCUR_set(sv, SvCUR(sv) - 1);
10140                     /* Whilst this makes the SV technically "invalid" (as its
10141                        buffer is no longer followed by "\0") when fbm_compile()
10142                        adds the "\n" back, a "\0" is restored.  */
10143                     fbm_compile(sv, FBMcf_TAIL);
10144                 } else
10145                     fbm_compile(sv, 0);
10146             }
10147             if (prog->substrs->data[i].substr == prog->check_substr)
10148                 prog->check_utf8 = sv;
10149         }
10150     } while (i--);
10151 }
10152
10153 STATIC bool
10154 S_to_byte_substr(pTHX_ regexp *prog)
10155 {
10156     /* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile
10157      * on the converted value; returns FALSE if can't be converted. */
10158
10159     int i = 1;
10160
10161     PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
10162
10163     do {
10164         if (prog->substrs->data[i].utf8_substr
10165             && !prog->substrs->data[i].substr) {
10166             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
10167             if (! sv_utf8_downgrade(sv, TRUE)) {
10168                 return FALSE;
10169             }
10170             if (SvVALID(prog->substrs->data[i].utf8_substr)) {
10171                 if (SvTAIL(prog->substrs->data[i].utf8_substr)) {
10172                     /* Trim the trailing \n that fbm_compile added last
10173                         time.  */
10174                     SvCUR_set(sv, SvCUR(sv) - 1);
10175                     fbm_compile(sv, FBMcf_TAIL);
10176                 } else
10177                     fbm_compile(sv, 0);
10178             }
10179             prog->substrs->data[i].substr = sv;
10180             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
10181                 prog->check_substr = sv;
10182         }
10183     } while (i--);
10184
10185     return TRUE;
10186 }
10187
10188 #ifndef PERL_IN_XSUB_RE
10189
10190 bool
10191 Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp)
10192 {
10193     /* Temporary helper function for toke.c.  Verify that the code point 'cp'
10194      * is a stand-alone grapheme.  The UTF-8 for 'cp' begins at position 's' in
10195      * the larger string bounded by 'strbeg' and 'strend'.
10196      *
10197      * 'cp' needs to be assigned (if not a future version of the Unicode
10198      * Standard could make it something that combines with adjacent characters,
10199      * so code using it would then break), and there has to be a GCB break
10200      * before and after the character. */
10201
10202     GCB_enum cp_gcb_val, prev_cp_gcb_val, next_cp_gcb_val;
10203     const U8 * prev_cp_start;
10204
10205     PERL_ARGS_ASSERT__IS_GRAPHEME;
10206
10207     if (   UNLIKELY(UNICODE_IS_SUPER(cp))
10208         || UNLIKELY(UNICODE_IS_NONCHAR(cp)))
10209     {
10210         /* These are considered graphemes */
10211         return TRUE;
10212     }
10213
10214     /* Otherwise, unassigned code points are forbidden */
10215     if (UNLIKELY(! ELEMENT_RANGE_MATCHES_INVLIST(
10216                                     _invlist_search(PL_Assigned_invlist, cp))))
10217     {
10218         return FALSE;
10219     }
10220
10221     cp_gcb_val = getGCB_VAL_CP(cp);
10222
10223     /* Find the GCB value of the previous code point in the input */
10224     prev_cp_start = utf8_hop_back(s, -1, strbeg);
10225     if (UNLIKELY(prev_cp_start == s)) {
10226         prev_cp_gcb_val = GCB_EDGE;
10227     }
10228     else {
10229         prev_cp_gcb_val = getGCB_VAL_UTF8(prev_cp_start, strend);
10230     }
10231
10232     /* And check that is a grapheme boundary */
10233     if (! isGCB(prev_cp_gcb_val, cp_gcb_val, strbeg, s,
10234                 TRUE /* is UTF-8 encoded */ ))
10235     {
10236         return FALSE;
10237     }
10238
10239     /* Similarly verify there is a break between the current character and the
10240      * following one */
10241     s += UTF8SKIP(s);
10242     if (s >= strend) {
10243         next_cp_gcb_val = GCB_EDGE;
10244     }
10245     else {
10246         next_cp_gcb_val = getGCB_VAL_UTF8(s, strend);
10247     }
10248
10249     return isGCB(cp_gcb_val, next_cp_gcb_val, strbeg, s, TRUE);
10250 }
10251
10252 /*
10253 =head1 Unicode Support
10254
10255 =for apidoc isSCRIPT_RUN
10256
10257 Returns a bool as to whether or not the sequence of bytes from C<s> up to but
10258 not including C<send> form a "script run".  C<utf8_target> is TRUE iff the
10259 sequence starting at C<s> is to be treated as UTF-8.  To be precise, except for
10260 two degenerate cases given below, this function returns TRUE iff all code
10261 points in it come from any combination of three "scripts" given by the Unicode
10262 "Script Extensions" property: Common, Inherited, and possibly one other.
10263 Additionally all decimal digits must come from the same consecutive sequence of
10264 10.
10265
10266 For example, if all the characters in the sequence are Greek, or Common, or
10267 Inherited, this function will return TRUE, provided any decimal digits in it
10268 are the ASCII digits "0".."9".  For scripts (unlike Greek) that have their own
10269 digits defined this will accept either digits from that set or from 0..9, but
10270 not a combination of the two.  Some scripts, such as Arabic, have more than one
10271 set of digits.  All digits must come from the same set for this function to
10272 return TRUE.
10273
10274 C<*ret_script>, if C<ret_script> is not NULL, will on return of TRUE
10275 contain the script found, using the C<SCX_enum> typedef.  Its value will be
10276 C<SCX_INVALID> if the function returns FALSE.
10277
10278 If the sequence is empty, TRUE is returned, but C<*ret_script> (if asked for)
10279 will be C<SCX_INVALID>.
10280
10281 If the sequence contains a single code point which is unassigned to a character
10282 in the version of Unicode being used, the function will return TRUE, and the
10283 script will be C<SCX_Unknown>.  Any other combination of unassigned code points
10284 in the input sequence will result in the function treating the input as not
10285 being a script run.
10286
10287 The returned script will be C<SCX_Inherited> iff all the code points in it are
10288 from the Inherited script.
10289
10290 Otherwise, the returned script will be C<SCX_Common> iff all the code points in
10291 it are from the Inherited or Common scripts.
10292
10293 =cut
10294
10295 */
10296
10297 bool
10298 Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target)
10299 {
10300     /* Basically, it looks at each character in the sequence to see if the
10301      * above conditions are met; if not it fails.  It uses an inversion map to
10302      * find the enum corresponding to the script of each character.  But this
10303      * is complicated by the fact that a few code points can be in any of
10304      * several scripts.  The data has been constructed so that there are
10305      * additional enum values (all negative) for these situations.  The
10306      * absolute value of those is an index into another table which contains
10307      * pointers to auxiliary tables for each such situation.  Each aux array
10308      * lists all the scripts for the given situation.  There is another,
10309      * parallel, table that gives the number of entries in each aux table.
10310      * These are all defined in charclass_invlists.h */
10311
10312     /* XXX Here are the additional things UTS 39 says could be done:
10313      *
10314      * Forbid sequences of the same nonspacing mark
10315      *
10316      * Check to see that all the characters are in the sets of exemplar
10317      * characters for at least one language in the Unicode Common Locale Data
10318      * Repository [CLDR]. */
10319
10320
10321     /* Things that match /\d/u */
10322     SV * decimals_invlist = PL_XPosix_ptrs[_CC_DIGIT];
10323     UV * decimals_array = invlist_array(decimals_invlist);
10324
10325     /* What code point is the digit '0' of the script run? (0 meaning FALSE if
10326      * not currently known) */
10327     UV zero_of_run = 0;
10328
10329     SCX_enum script_of_run  = SCX_INVALID;   /* Illegal value */
10330     SCX_enum script_of_char = SCX_INVALID;
10331
10332     /* If the script remains not fully determined from iteration to iteration,
10333      * this is the current intersection of the possiblities.  */
10334     SCX_enum * intersection = NULL;
10335     PERL_UINT_FAST8_T intersection_len = 0;
10336
10337     bool retval = TRUE;
10338     SCX_enum * ret_script = NULL;
10339
10340     assert(send >= s);
10341
10342     PERL_ARGS_ASSERT_ISSCRIPT_RUN;
10343
10344     /* All code points in 0..255 are either Common or Latin, so must be a
10345      * script run.  We can return immediately unless we need to know which
10346      * script it is. */
10347     if (! utf8_target && LIKELY(send > s)) {
10348         if (ret_script == NULL) {
10349             return TRUE;
10350         }
10351
10352         /* If any character is Latin, the run is Latin */
10353         while (s < send) {
10354             if (isALPHA_L1(*s) && LIKELY(*s != MICRO_SIGN_NATIVE)) {
10355                 *ret_script = SCX_Latin;
10356                 return TRUE;
10357             }
10358         }
10359
10360         /* Here, all are Common */
10361         *ret_script = SCX_Common;
10362         return TRUE;
10363     }
10364
10365     /* Look at each character in the sequence */
10366     while (s < send) {
10367         /* If the current character being examined is a digit, this is the code
10368          * point of the zero for its sequence of 10 */
10369         UV zero_of_char;
10370
10371         UV cp;
10372
10373         /* The code allows all scripts to use the ASCII digits.  This is
10374          * because they are used in commerce even in scripts that have their
10375          * own set.  Hence any ASCII ones found are ok, unless and until a
10376          * digit from another set has already been encountered.  (The other
10377          * digit ranges in Common are not similarly blessed) */
10378         if (UNLIKELY(isDIGIT(*s))) {
10379             if (UNLIKELY(script_of_run == SCX_Unknown)) {
10380                 retval = FALSE;
10381                 break;
10382             }
10383             if (zero_of_run) {
10384                 if (zero_of_run != '0') {
10385                     retval = FALSE;
10386                     break;
10387                 }
10388             }
10389             else {
10390                 zero_of_run = '0';
10391             }
10392             s++;
10393             continue;
10394         }
10395
10396         /* Here, isn't an ASCII digit.  Find the code point of the character */
10397         if (! UTF8_IS_INVARIANT(*s)) {
10398             Size_t len;
10399             cp = valid_utf8_to_uvchr((U8 *) s, &len);
10400             s += len;
10401         }
10402         else {
10403             cp = *(s++);
10404         }
10405
10406         /* If is within the range [+0 .. +9] of the script's zero, it also is a
10407          * digit in that script.  We can skip the rest of this code for this
10408          * character. */
10409         if (UNLIKELY(   zero_of_run
10410                      && cp >= zero_of_run
10411                      && cp - zero_of_run <= 9))
10412         {
10413             continue;
10414         }
10415
10416         /* Find the character's script.  The correct values are hard-coded here
10417          * for small-enough code points. */
10418         if (cp < 0x2B9) {   /* From inspection of Unicode db; extremely
10419                                unlikely to change */
10420             if (       cp > 255
10421                 || (   isALPHA_L1(cp)
10422                     && LIKELY(cp != MICRO_SIGN_NATIVE)))
10423             {
10424                 script_of_char = SCX_Latin;
10425             }
10426             else {
10427                 script_of_char = SCX_Common;
10428             }
10429         }
10430         else {
10431             script_of_char = _Perl_SCX_invmap[
10432                                        _invlist_search(PL_SCX_invlist, cp)];
10433         }
10434
10435         /* We arbitrarily accept a single unassigned character, but not in
10436          * combination with anything else, and not a run of them. */
10437         if (   UNLIKELY(script_of_run == SCX_Unknown)
10438             || UNLIKELY(   script_of_run != SCX_INVALID
10439                         && script_of_char == SCX_Unknown))
10440         {
10441             retval = FALSE;
10442             break;
10443         }
10444
10445         /* For the first character, or the run is inherited, the run's script
10446          * is set to the char's */
10447         if (   UNLIKELY(script_of_run == SCX_INVALID)
10448             || UNLIKELY(script_of_run == SCX_Inherited))
10449         {
10450             script_of_run = script_of_char;
10451         }
10452
10453         /* For the character's script to be Unknown, it must be the first
10454          * character in the sequence (for otherwise a test above would have
10455          * prevented us from reaching here), and we have set the run's script
10456          * to it.  Nothing further to be done for this character */
10457         if (UNLIKELY(script_of_char == SCX_Unknown)) {
10458             continue;
10459         }
10460
10461         /* We accept 'inherited' script characters currently even at the
10462          * beginning.  (We know that no characters in Inherited are digits, or
10463          * we'd have to check for that) */
10464         if (UNLIKELY(script_of_char == SCX_Inherited)) {
10465             continue;
10466         }
10467
10468         /* If the run so far is Common, and the new character isn't, change the
10469          * run's script to that of this character */
10470         if (script_of_run == SCX_Common && script_of_char != SCX_Common) {
10471
10472             /* But Common contains several sets of digits.  Only the '0' set
10473              * can be part of another script. */
10474             if (zero_of_run && zero_of_run != '0') {
10475                 retval = FALSE;
10476                 break;
10477             }
10478
10479             script_of_run = script_of_char;
10480         }
10481
10482         /* Now we can see if the script of the character is the same as that of
10483          * the run */
10484         if (LIKELY(script_of_char == script_of_run)) {
10485             /* By far the most common case */
10486             goto scripts_match;
10487         }
10488
10489         /* Here, the script of the run isn't Common.  But characters in Common
10490          * match any script */
10491         if (script_of_char == SCX_Common) {
10492             goto scripts_match;
10493         }
10494
10495 #ifndef HAS_SCX_AUX_TABLES
10496
10497         /* Too early a Unicode version to have a code point belonging to more
10498          * than one script, so, if the scripts don't exactly match, fail */
10499         PERL_UNUSED_VAR(intersection_len);
10500         retval = FALSE;
10501         break;
10502
10503 #else
10504
10505         /* Here there is no exact match between the character's script and the
10506          * run's.  And we've handled the special cases of scripts Unknown,
10507          * Inherited, and Common.
10508          *
10509          * Negative script numbers signify that the value may be any of several
10510          * scripts, and we need to look at auxiliary information to make our
10511          * deterimination.  But if both are non-negative, we can fail now */
10512         if (LIKELY(script_of_char >= 0)) {
10513             const SCX_enum * search_in;
10514             PERL_UINT_FAST8_T search_in_len;
10515             PERL_UINT_FAST8_T i;
10516
10517             if (LIKELY(script_of_run >= 0)) {
10518                 retval = FALSE;
10519                 break;
10520             }
10521
10522             /* Use the previously constructed set of possible scripts, if any.
10523              * */
10524             if (intersection) {
10525                 search_in = intersection;
10526                 search_in_len = intersection_len;
10527             }
10528             else {
10529                 search_in = SCX_AUX_TABLE_ptrs[-script_of_run];
10530                 search_in_len = SCX_AUX_TABLE_lengths[-script_of_run];
10531             }
10532
10533             for (i = 0; i < search_in_len; i++) {
10534                 if (search_in[i] == script_of_char) {
10535                     script_of_run = script_of_char;
10536                     goto scripts_match;
10537                 }
10538             }
10539
10540             retval = FALSE;
10541             break;
10542         }
10543         else if (LIKELY(script_of_run >= 0)) {
10544             /* script of character could be one of several, but run is a single
10545              * script */
10546             const SCX_enum * search_in = SCX_AUX_TABLE_ptrs[-script_of_char];
10547             const PERL_UINT_FAST8_T search_in_len
10548                                      = SCX_AUX_TABLE_lengths[-script_of_char];
10549             PERL_UINT_FAST8_T i;
10550
10551             for (i = 0; i < search_in_len; i++) {
10552                 if (search_in[i] == script_of_run) {
10553                     script_of_char = script_of_run;
10554                     goto scripts_match;
10555                 }
10556             }
10557
10558             retval = FALSE;
10559             break;
10560         }
10561         else {
10562             /* Both run and char could be in one of several scripts.  If the
10563              * intersection is empty, then this character isn't in this script
10564              * run.  Otherwise, we need to calculate the intersection to use
10565              * for future iterations of the loop, unless we are already at the
10566              * final character */
10567             const SCX_enum * search_char = SCX_AUX_TABLE_ptrs[-script_of_char];
10568             const PERL_UINT_FAST8_T char_len
10569                                       = SCX_AUX_TABLE_lengths[-script_of_char];
10570             const SCX_enum * search_run;
10571             PERL_UINT_FAST8_T run_len;
10572
10573             SCX_enum * new_overlap = NULL;
10574             PERL_UINT_FAST8_T i, j;
10575
10576             if (intersection) {
10577                 search_run = intersection;
10578                 run_len = intersection_len;
10579             }
10580             else {
10581                 search_run = SCX_AUX_TABLE_ptrs[-script_of_run];
10582                 run_len = SCX_AUX_TABLE_lengths[-script_of_run];
10583             }
10584
10585             intersection_len = 0;
10586
10587             for (i = 0; i < run_len; i++) {
10588                 for (j = 0; j < char_len; j++) {
10589                     if (search_run[i] == search_char[j]) {
10590
10591                         /* Here, the script at i,j matches.  That means this
10592                          * character is in the run.  But continue on to find
10593                          * the complete intersection, for the next loop
10594                          * iteration, and for the digit check after it.
10595                          *
10596                          * On the first found common script, we malloc space
10597                          * for the intersection list for the worst case of the
10598                          * intersection, which is the minimum of the number of
10599                          * scripts remaining in each set. */
10600                         if (intersection_len == 0) {
10601                             Newx(new_overlap,
10602                                  MIN(run_len - i, char_len - j),
10603                                  SCX_enum);
10604                         }
10605                         new_overlap[intersection_len++] = search_run[i];
10606                     }
10607                 }
10608             }
10609
10610             /* Here we've looked through everything.  If they have no scripts
10611              * in common, not a run */
10612             if (intersection_len == 0) {
10613                 retval = FALSE;
10614                 break;
10615             }
10616
10617             /* If there is only a single script in common, set to that.
10618              * Otherwise, use the intersection going forward */
10619             Safefree(intersection);
10620             intersection = NULL;
10621             if (intersection_len == 1) {
10622                 script_of_run = script_of_char = new_overlap[0];
10623                 Safefree(new_overlap);
10624                 new_overlap = NULL;
10625             }
10626             else {
10627                 intersection = new_overlap;
10628             }
10629         }
10630
10631 #endif
10632
10633   scripts_match:
10634
10635         /* Here, the script of the character is compatible with that of the
10636          * run.  That means that in most cases, it continues the script run.
10637          * Either it and the run match exactly, or one or both can be in any of
10638          * several scripts, and the intersection is not empty.  However, if the
10639          * character is a decimal digit, it could still mean failure if it is
10640          * from the wrong sequence of 10.  So, we need to look at if it's a
10641          * digit.  We've already handled the 10 decimal digits, and the next
10642          * lowest one is this one: */
10643         if (cp < FIRST_NON_ASCII_DECIMAL_DIGIT) {
10644             continue;   /* Not a digit; this character is part of the run */
10645         }
10646
10647         /* If we have a definitive '0' for the script of this character, we
10648          * know that for this to be a digit, it must be in the range of +0..+9
10649          * of that zero. */
10650         if (   script_of_char >= 0
10651             && (zero_of_char = script_zeros[script_of_char]))
10652         {
10653             if (   cp < zero_of_char
10654                 || cp > zero_of_char + 9)
10655             {
10656                 continue;   /* Not a digit; this character is part of the run
10657                              */
10658             }
10659
10660         }
10661         else {  /* Need to look up if this character is a digit or not */
10662             SSize_t index_of_zero_of_char;
10663             index_of_zero_of_char = _invlist_search(decimals_invlist, cp);
10664             if (     UNLIKELY(index_of_zero_of_char < 0)
10665                 || ! ELEMENT_RANGE_MATCHES_INVLIST(index_of_zero_of_char))
10666             {
10667                 continue;   /* Not a digit; this character is part of the run.
10668                              */
10669             }
10670
10671             zero_of_char = decimals_array[index_of_zero_of_char];
10672         }
10673
10674         /* Here, the character is a decimal digit, and the zero of its sequence
10675          * of 10 is in 'zero_of_char'.  If we already have a zero for this run,
10676          * they better be the same. */
10677         if (zero_of_run) {
10678             if (zero_of_run != zero_of_char) {
10679                 retval = FALSE;
10680                 break;
10681             }
10682         }
10683         else if (script_of_char == SCX_Common && script_of_run != SCX_Common) {
10684
10685             /* Here, the script run isn't Common, but the current digit is in
10686              * Common, and isn't '0'-'9' (those were handled earlier).   Only
10687              * '0'-'9' are acceptable in non-Common scripts. */
10688             retval = FALSE;
10689             break;
10690         }
10691         else {  /* Otherwise we now have a zero for this run */
10692             zero_of_run = zero_of_char;
10693         }
10694     } /* end of looping through CLOSESR text */
10695
10696     Safefree(intersection);
10697
10698     if (ret_script != NULL) {
10699         if (retval) {
10700             *ret_script = script_of_run;
10701         }
10702         else {
10703             *ret_script = SCX_INVALID;
10704         }
10705     }
10706
10707     return retval;
10708 }
10709
10710 #endif /* ifndef PERL_IN_XSUB_RE */
10711
10712 /*
10713  * ex: set ts=8 sts=4 sw=4 et:
10714  */