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