This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7d03f09344fa7ac1336e0a86ab3ad1fd21a69465
[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 /* At least one required character in the target string is expressible only in
41  * UTF-8. */
42 static const char* const non_utf8_target_but_utf8_required
43                 = "Can't match, because target string needs to be in UTF-8\n";
44
45 #define NON_UTF8_TARGET_BUT_UTF8_REQUIRED(target) STMT_START { \
46     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s", non_utf8_target_but_utf8_required));\
47     goto target; \
48 } STMT_END
49
50 /*
51  * pregcomp and pregexec -- regsub and regerror are not used in perl
52  *
53  *      Copyright (c) 1986 by University of Toronto.
54  *      Written by Henry Spencer.  Not derived from licensed software.
55  *
56  *      Permission is granted to anyone to use this software for any
57  *      purpose on any computer system, and to redistribute it freely,
58  *      subject to the following restrictions:
59  *
60  *      1. The author is not responsible for the consequences of use of
61  *              this software, no matter how awful, even if they arise
62  *              from defects in it.
63  *
64  *      2. The origin of this software must not be misrepresented, either
65  *              by explicit claim or by omission.
66  *
67  *      3. Altered versions must be plainly marked as such, and must not
68  *              be misrepresented as being the original software.
69  *
70  ****    Alterations to Henry's code are...
71  ****
72  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
73  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
74  ****    by Larry Wall and others
75  ****
76  ****    You may distribute under the terms of either the GNU General Public
77  ****    License or the Artistic License, as specified in the README file.
78  *
79  * Beware that some of this code is subtly aware of the way operator
80  * precedence is structured in regular expressions.  Serious changes in
81  * regular-expression syntax might require a total rethink.
82  */
83 #include "EXTERN.h"
84 #define PERL_IN_REGEXEC_C
85 #include "perl.h"
86
87 #ifdef PERL_IN_XSUB_RE
88 #  include "re_comp.h"
89 #else
90 #  include "regcomp.h"
91 #endif
92
93 #include "inline_invlist.c"
94 #include "unicode_constants.h"
95
96 #define RF_tainted      1       /* tainted information used? e.g. locale */
97 #define RF_warned       2               /* warned about big count? */
98
99 #define RF_utf8         8               /* Pattern contains multibyte chars? */
100
101 #define UTF_PATTERN ((PL_reg_flags & RF_utf8) != 0)
102
103 #define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
104
105 #ifndef STATIC
106 #define STATIC  static
107 #endif
108
109 /* Valid for non-utf8 strings: avoids the reginclass
110  * call if there are no complications: i.e., if everything matchable is
111  * straight forward in the bitmap */
112 #define REGINCLASS(prog,p,c)  (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0)   \
113                                               : ANYOF_BITMAP_TEST(p,*(c)))
114
115 /*
116  * Forwards.
117  */
118
119 #define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv))
120 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
121
122 #define HOPc(pos,off) \
123         (char *)(PL_reg_match_utf8 \
124             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
125             : (U8*)(pos + off))
126 #define HOPBACKc(pos, off) \
127         (char*)(PL_reg_match_utf8\
128             ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
129             : (pos - off >= PL_bostr)           \
130                 ? (U8*)pos - off                \
131                 : NULL)
132
133 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
134 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
135
136
137 #define NEXTCHR_EOS -10 /* nextchr has fallen off the end */
138 #define NEXTCHR_IS_EOS (nextchr < 0)
139
140 #define SET_nextchr \
141     nextchr = ((locinput < PL_regeol) ? UCHARAT(locinput) : NEXTCHR_EOS)
142
143 #define SET_locinput(p) \
144     locinput = (p);  \
145     SET_nextchr
146
147
148 /* these are unrolled below in the CCC_TRY_XXX defined */
149 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
150     if (!CAT2(PL_utf8_,class)) { \
151         bool ok; \
152         ENTER; save_re_context(); \
153         ok=CAT2(is_utf8_,class)((const U8*)str); \
154         PERL_UNUSED_VAR(ok); \
155         assert(ok); assert(CAT2(PL_utf8_,class)); LEAVE; } } STMT_END
156 /* Doesn't do an assert to verify that is correct */
157 #define LOAD_UTF8_CHARCLASS_NO_CHECK(class) STMT_START { \
158     if (!CAT2(PL_utf8_,class)) { \
159         bool throw_away; \
160         PERL_UNUSED_VAR(throw_away); \
161         ENTER; save_re_context(); \
162         throw_away = CAT2(is_utf8_,class)((const U8*)" "); \
163         PERL_UNUSED_VAR(throw_away); \
164         LEAVE; } } STMT_END
165
166 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
167 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
168
169 #define LOAD_UTF8_CHARCLASS_GCB()  /* Grapheme cluster boundaries */        \
170         /* No asserts are done for some of these, in case called on a   */  \
171         /* Unicode version in which they map to nothing */                  \
172         LOAD_UTF8_CHARCLASS(X_regular_begin, HYPHEN_UTF8);                  \
173         LOAD_UTF8_CHARCLASS(X_extend, COMBINING_GRAVE_ACCENT_UTF8);         \
174
175 #define PLACEHOLDER     /* Something for the preprocessor to grab onto */
176
177 /* The actual code for CCC_TRY, which uses several variables from the routine
178  * it's callable from.  It is designed to be the bulk of a case statement.
179  * FUNC is the macro or function to call on non-utf8 targets that indicate if
180  *      nextchr matches the class.
181  * UTF8_TEST is the whole test string to use for utf8 targets
182  * LOAD is what to use to test, and if not present to load in the swash for the
183  *      class
184  * POS_OR_NEG is either empty or ! to complement the results of FUNC or
185  *      UTF8_TEST test.
186  * The logic is: Fail if we're at the end-of-string; otherwise if the target is
187  * utf8 and a variant, load the swash if necessary and test using the utf8
188  * test.  Advance to the next character if test is ok, otherwise fail; If not
189  * utf8 or an invariant under utf8, use the non-utf8 test, and fail if it
190  * fails, or advance to the next character */
191
192 #define _CCC_TRY_CODE(POS_OR_NEG, FUNC, UTF8_TEST, CLASS, STR)                \
193     if (NEXTCHR_IS_EOS) {                                                     \
194         sayNO;                                                                \
195     }                                                                         \
196     if (utf8_target && UTF8_IS_CONTINUED(nextchr)) {                          \
197         LOAD_UTF8_CHARCLASS(CLASS, STR);                                      \
198         if (POS_OR_NEG (UTF8_TEST)) {                                         \
199             sayNO;                                                            \
200         }                                                                     \
201     }                                                                         \
202     else if (POS_OR_NEG (FUNC(nextchr))) {                                    \
203             sayNO;                                                            \
204     }                                                                         \
205     goto increment_locinput;
206
207 /* Handle the non-locale cases for a character class and its complement.  It
208  * calls _CCC_TRY_CODE with a ! to complement the test for the character class.
209  * This is because that code fails when the test succeeds, so we want to have
210  * the test fail so that the code succeeds.  The swash is stored in a
211  * predictable PL_ place */
212 #define _CCC_TRY_NONLOCALE(NAME,  NNAME,  FUNC,                               \
213                            CLASS, STR)                                        \
214     case NAME:                                                                \
215         _CCC_TRY_CODE( !, FUNC,                                               \
216                           cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS),             \
217                                             (U8*)locinput, TRUE)),            \
218                           CLASS, STR)                                         \
219     case NNAME:                                                               \
220         _CCC_TRY_CODE(  PLACEHOLDER , FUNC,                                   \
221                           cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS),             \
222                                             (U8*)locinput, TRUE)),            \
223                           CLASS, STR)
224 /* Generate the case statements for both locale and non-locale character
225  * classes in regmatch for classes that don't have special unicode semantics.
226  * Locales don't use an immediate swash, but an intermediary special locale
227  * function that is called on the pointer to the current place in the input
228  * string.  That function will resolve to needing the same swash.  One might
229  * think that because we don't know what the locale will match, we shouldn't
230  * check with the swash loading function that it loaded properly; ie, that we
231  * should use LOAD_UTF8_CHARCLASS_NO_CHECK for those, but what is passed to the
232  * regular LOAD_UTF8_CHARCLASS is in non-locale terms, and so locale is
233  * irrelevant here */
234 #define CCC_TRY(NAME,  NNAME,  FUNC,                                          \
235                 NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                           \
236                 NAMEA, NNAMEA, FUNCA,                                         \
237                 CLASS, STR)                                                   \
238     case NAMEL:                                                               \
239         PL_reg_flags |= RF_tainted;                                           \
240         _CCC_TRY_CODE( !, LCFUNC, LCFUNC_utf8((U8*)locinput), CLASS, STR)     \
241     case NNAMEL:                                                              \
242         PL_reg_flags |= RF_tainted;                                           \
243         _CCC_TRY_CODE( PLACEHOLDER, LCFUNC, LCFUNC_utf8((U8*)locinput),       \
244                        CLASS, STR)                                            \
245     case NAMEA:                                                               \
246         if (NEXTCHR_IS_EOS || ! FUNCA(nextchr)) {                      \
247             sayNO;                                                            \
248         }                                                                     \
249         /* Matched a utf8-invariant, so don't have to worry about utf8 */     \
250         locinput++;                                        \
251         break;                                                                \
252     case NNAMEA:                                                              \
253         if (NEXTCHR_IS_EOS || FUNCA(nextchr)) {                        \
254             sayNO;                                                            \
255         }                                                                     \
256         goto increment_locinput;                                              \
257     /* Generate the non-locale cases */                                       \
258     _CCC_TRY_NONLOCALE(NAME, NNAME, FUNC, CLASS, STR)
259
260 /* This is like CCC_TRY, but has an extra set of parameters for generating case
261  * statements to handle separate Unicode semantics nodes */
262 #define CCC_TRY_U(NAME,  NNAME,  FUNC,                                         \
263                   NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                          \
264                   NAMEU, NNAMEU, FUNCU,                                        \
265                   NAMEA, NNAMEA, FUNCA,                                        \
266                   CLASS, STR)                                                  \
267     CCC_TRY(NAME, NNAME, FUNC,                                                 \
268             NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                                \
269             NAMEA, NNAMEA, FUNCA,                                              \
270             CLASS, STR)                                                        \
271     _CCC_TRY_NONLOCALE(NAMEU, NNAMEU, FUNCU, CLASS, STR)
272
273 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
274
275 /* for use after a quantifier and before an EXACT-like node -- japhy */
276 /* it would be nice to rework regcomp.sym to generate this stuff. sigh
277  *
278  * NOTE that *nothing* that affects backtracking should be in here, specifically
279  * VERBS must NOT be included. JUMPABLE is used to determine  if we can ignore a
280  * node that is in between two EXACT like nodes when ascertaining what the required
281  * "follow" character is. This should probably be moved to regex compile time
282  * although it may be done at run time beause of the REF possibility - more
283  * investigation required. -- demerphq
284 */
285 #define JUMPABLE(rn) (      \
286     OP(rn) == OPEN ||       \
287     (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
288     OP(rn) == EVAL ||   \
289     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
290     OP(rn) == PLUS || OP(rn) == MINMOD || \
291     OP(rn) == KEEPS || \
292     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
293 )
294 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
295
296 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
297
298 #if 0 
299 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
300    we don't need this definition. */
301 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
302 #define IS_TEXTF(rn)  ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFU_TRICKYFOLD || OP(rn)==EXACTFA || OP(rn)==EXACTF || OP(rn)==REFF  || OP(rn)==NREFF )
303 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
304
305 #else
306 /* ... so we use this as its faster. */
307 #define IS_TEXT(rn)   ( OP(rn)==EXACT   )
308 #define IS_TEXTFU(rn)  ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFU_TRICKYFOLD || OP(rn) == EXACTFA)
309 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
310 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
311
312 #endif
313
314 /*
315   Search for mandatory following text node; for lookahead, the text must
316   follow but for lookbehind (rn->flags != 0) we skip to the next step.
317 */
318 #define FIND_NEXT_IMPT(rn) STMT_START { \
319     while (JUMPABLE(rn)) { \
320         const OPCODE type = OP(rn); \
321         if (type == SUSPEND || PL_regkind[type] == CURLY) \
322             rn = NEXTOPER(NEXTOPER(rn)); \
323         else if (type == PLUS) \
324             rn = NEXTOPER(rn); \
325         else if (type == IFMATCH) \
326             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
327         else rn += NEXT_OFF(rn); \
328     } \
329 } STMT_END 
330
331 /* These constants are for finding GCB=LV and GCB=LVT in the CLUMP regnode.
332  * These are for the pre-composed Hangul syllables, which are all in a
333  * contiguous block and arranged there in such a way so as to facilitate
334  * alorithmic determination of their characteristics.  As such, they don't need
335  * a swash, but can be determined by simple arithmetic.  Almost all are
336  * GCB=LVT, but every 28th one is a GCB=LV */
337 #define SBASE 0xAC00    /* Start of block */
338 #define SCount 11172    /* Length of block */
339 #define TCount 28
340
341 static void restore_pos(pTHX_ void *arg);
342
343 #define REGCP_PAREN_ELEMS 3
344 #define REGCP_OTHER_ELEMS 3
345 #define REGCP_FRAME_ELEMS 1
346 /* REGCP_FRAME_ELEMS are not part of the REGCP_OTHER_ELEMS and
347  * are needed for the regexp context stack bookkeeping. */
348
349 STATIC CHECKPOINT
350 S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
351 {
352     dVAR;
353     const int retval = PL_savestack_ix;
354     const int paren_elems_to_push =
355                 (maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
356     const UV total_elems = paren_elems_to_push + REGCP_OTHER_ELEMS;
357     const UV elems_shifted = total_elems << SAVE_TIGHT_SHIFT;
358     I32 p;
359     GET_RE_DEBUG_FLAGS_DECL;
360
361     PERL_ARGS_ASSERT_REGCPPUSH;
362
363     if (paren_elems_to_push < 0)
364         Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0",
365                    paren_elems_to_push);
366
367     if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
368         Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
369                    " out of range (%lu-%ld)",
370                    total_elems,
371                    (unsigned long)maxopenparen,
372                    (long)parenfloor);
373
374     SSGROW(total_elems + REGCP_FRAME_ELEMS);
375     
376     DEBUG_BUFFERS_r(
377         if ((int)maxopenparen > (int)parenfloor)
378             PerlIO_printf(Perl_debug_log,
379                 "rex=0x%"UVxf" offs=0x%"UVxf": saving capture indices:\n",
380                 PTR2UV(rex),
381                 PTR2UV(rex->offs)
382             );
383     );
384     for (p = parenfloor+1; p <= (I32)maxopenparen;  p++) {
385 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
386         SSPUSHINT(rex->offs[p].end);
387         SSPUSHINT(rex->offs[p].start);
388         SSPUSHINT(rex->offs[p].start_tmp);
389         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
390             "    \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"\n",
391             (UV)p,
392             (IV)rex->offs[p].start,
393             (IV)rex->offs[p].start_tmp,
394             (IV)rex->offs[p].end
395         ));
396     }
397 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
398     SSPUSHINT(maxopenparen);
399     SSPUSHINT(rex->lastparen);
400     SSPUSHINT(rex->lastcloseparen);
401     SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
402
403     return retval;
404 }
405
406 /* These are needed since we do not localize EVAL nodes: */
407 #define REGCP_SET(cp)                                           \
408     DEBUG_STATE_r(                                              \
409             PerlIO_printf(Perl_debug_log,                       \
410                 "  Setting an EVAL scope, savestack=%"IVdf"\n", \
411                 (IV)PL_savestack_ix));                          \
412     cp = PL_savestack_ix
413
414 #define REGCP_UNWIND(cp)                                        \
415     DEBUG_STATE_r(                                              \
416         if (cp != PL_savestack_ix)                              \
417             PerlIO_printf(Perl_debug_log,                       \
418                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
419                 (IV)(cp), (IV)PL_savestack_ix));                \
420     regcpblow(cp)
421
422 #define UNWIND_PAREN(lp, lcp)               \
423     for (n = rex->lastparen; n > lp; n--)   \
424         rex->offs[n].end = -1;              \
425     rex->lastparen = n;                     \
426     rex->lastcloseparen = lcp;
427
428
429 STATIC void
430 S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
431 {
432     dVAR;
433     UV i;
434     U32 paren;
435     GET_RE_DEBUG_FLAGS_DECL;
436
437     PERL_ARGS_ASSERT_REGCPPOP;
438
439     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
440     i = SSPOPUV;
441     assert((i & SAVE_MASK) == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
442     i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
443     rex->lastcloseparen = SSPOPINT;
444     rex->lastparen = SSPOPINT;
445     *maxopenparen_p = SSPOPINT;
446
447     i -= REGCP_OTHER_ELEMS;
448     /* Now restore the parentheses context. */
449     DEBUG_BUFFERS_r(
450         if (i || rex->lastparen + 1 <= rex->nparens)
451             PerlIO_printf(Perl_debug_log,
452                 "rex=0x%"UVxf" offs=0x%"UVxf": restoring capture indices to:\n",
453                 PTR2UV(rex),
454                 PTR2UV(rex->offs)
455             );
456     );
457     paren = *maxopenparen_p;
458     for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
459         I32 tmps;
460         rex->offs[paren].start_tmp = SSPOPINT;
461         rex->offs[paren].start = SSPOPINT;
462         tmps = SSPOPINT;
463         if (paren <= rex->lastparen)
464             rex->offs[paren].end = tmps;
465         DEBUG_BUFFERS_r( PerlIO_printf(Perl_debug_log,
466             "    \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"%s\n",
467             (UV)paren,
468             (IV)rex->offs[paren].start,
469             (IV)rex->offs[paren].start_tmp,
470             (IV)rex->offs[paren].end,
471             (paren > rex->lastparen ? "(skipped)" : ""));
472         );
473         paren--;
474     }
475 #if 1
476     /* It would seem that the similar code in regtry()
477      * already takes care of this, and in fact it is in
478      * a better location to since this code can #if 0-ed out
479      * but the code in regtry() is needed or otherwise tests
480      * requiring null fields (pat.t#187 and split.t#{13,14}
481      * (as of patchlevel 7877)  will fail.  Then again,
482      * this code seems to be necessary or otherwise
483      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
484      * --jhi updated by dapm */
485     for (i = rex->lastparen + 1; i <= rex->nparens; i++) {
486         if (i > *maxopenparen_p)
487             rex->offs[i].start = -1;
488         rex->offs[i].end = -1;
489         DEBUG_BUFFERS_r( PerlIO_printf(Perl_debug_log,
490             "    \\%"UVuf": %s   ..-1 undeffing\n",
491             (UV)i,
492             (i > *maxopenparen_p) ? "-1" : "  "
493         ));
494     }
495 #endif
496 }
497
498 /* restore the parens and associated vars at savestack position ix,
499  * but without popping the stack */
500
501 STATIC void
502 S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p)
503 {
504     I32 tmpix = PL_savestack_ix;
505     PL_savestack_ix = ix;
506     regcppop(rex, maxopenparen_p);
507     PL_savestack_ix = tmpix;
508 }
509
510 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
511
512 STATIC bool
513 S_isFOO_lc(pTHX_ const U8 classnum, const U8 character)
514 {
515     /* Returns a boolean as to whether or not 'character' is a member of the
516      * Posix character class given by 'classnum' that should be equivalent to a
517      * value in the typedef '_char_class_number'.
518      *
519      * Ideally this could be replaced by a just an array of function pointers
520      * to the C library functions that implement the macros this calls.
521      * However, to compile, the precise function signatures are required, and
522      * these may vary from platform to to platform.  To avoid having to figure
523      * out what those all are on each platform, I (khw) am using this method,
524      * which adds an extra layer of function call overhead (unless the C
525      * optimizer strips it away).  But we don't particularly care about
526      * performance with locales anyway. */
527
528     switch ((_char_class_number) classnum) {
529         case _CC_ENUM_ALPHANUMERIC: return isALPHANUMERIC_LC(character);
530         case _CC_ENUM_ALPHA:     return isALPHA_LC(character);
531         case _CC_ENUM_DIGIT:     return isDIGIT_LC(character);
532         case _CC_ENUM_GRAPH:     return isGRAPH_LC(character);
533         case _CC_ENUM_LOWER:     return isLOWER_LC(character);
534         case _CC_ENUM_PRINT:     return isPRINT_LC(character);
535         case _CC_ENUM_PUNCT:     return isPUNCT_LC(character);
536         case _CC_ENUM_UPPER:     return isUPPER_LC(character);
537         case _CC_ENUM_WORDCHAR:  return isWORDCHAR_LC(character);
538         case _CC_ENUM_SPACE:     return isSPACE_LC(character);
539         case _CC_ENUM_BLANK:     return isBLANK_LC(character);
540         case _CC_ENUM_XDIGIT:    return isXDIGIT_LC(character);
541         case _CC_ENUM_CNTRL:     return isCNTRL_LC(character);
542         case _CC_ENUM_PSXSPC:    return isPSXSPC_LC(character);
543         case _CC_ENUM_ASCII:     return isASCII_LC(character);
544         default:    /* VERTSPACE should never occur in locales */
545             Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum);
546     }
547
548     assert(0); /* NOTREACHED */
549     return FALSE;
550 }
551
552 /*
553  * pregexec and friends
554  */
555
556 #ifndef PERL_IN_XSUB_RE
557 /*
558  - pregexec - match a regexp against a string
559  */
560 I32
561 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
562          char *strbeg, I32 minend, SV *screamer, U32 nosave)
563 /* stringarg: the point in the string at which to begin matching */
564 /* strend:    pointer to null at end of string */
565 /* strbeg:    real beginning of string */
566 /* minend:    end of match must be >= minend bytes after stringarg. */
567 /* screamer:  SV being matched: only used for utf8 flag, pos() etc; string
568  *            itself is accessed via the pointers above */
569 /* nosave:    For optimizations. */
570 {
571     PERL_ARGS_ASSERT_PREGEXEC;
572
573     return
574         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
575                       nosave ? 0 : REXEC_COPY_STR);
576 }
577 #endif
578
579 /*
580  * Need to implement the following flags for reg_anch:
581  *
582  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
583  * USE_INTUIT_ML
584  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
585  * INTUIT_AUTORITATIVE_ML
586  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
587  * INTUIT_ONCE_ML
588  *
589  * Another flag for this function: SECOND_TIME (so that float substrs
590  * with giant delta may be not rechecked).
591  */
592
593 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
594
595 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
596    Otherwise, only SvCUR(sv) is used to get strbeg. */
597
598 /* XXXX We assume that strpos is strbeg unless sv. */
599
600 /* XXXX Some places assume that there is a fixed substring.
601         An update may be needed if optimizer marks as "INTUITable"
602         RExen without fixed substrings.  Similarly, it is assumed that
603         lengths of all the strings are no more than minlen, thus they
604         cannot come from lookahead.
605         (Or minlen should take into account lookahead.) 
606   NOTE: Some of this comment is not correct. minlen does now take account
607   of lookahead/behind. Further research is required. -- demerphq
608
609 */
610
611 /* A failure to find a constant substring means that there is no need to make
612    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
613    finding a substring too deep into the string means that less calls to
614    regtry() should be needed.
615
616    REx compiler's optimizer found 4 possible hints:
617         a) Anchored substring;
618         b) Fixed substring;
619         c) Whether we are anchored (beginning-of-line or \G);
620         d) First node (of those at offset 0) which may distinguish positions;
621    We use a)b)d) and multiline-part of c), and try to find a position in the
622    string which does not contradict any of them.
623  */
624
625 /* Most of decisions we do here should have been done at compile time.
626    The nodes of the REx which we used for the search should have been
627    deleted from the finite automaton. */
628
629 char *
630 Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
631                      char *strend, const U32 flags, re_scream_pos_data *data)
632 {
633     dVAR;
634     struct regexp *const prog = ReANY(rx);
635     I32 start_shift = 0;
636     /* Should be nonnegative! */
637     I32 end_shift   = 0;
638     char *s;
639     SV *check;
640     char *strbeg;
641     char *t;
642     const bool utf8_target = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
643     I32 ml_anch;
644     char *other_last = NULL;    /* other substr checked before this */
645     char *check_at = NULL;              /* check substr found at this pos */
646     char *checked_upto = NULL;          /* how far into the string we have already checked using find_byclass*/
647     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
648     RXi_GET_DECL(prog,progi);
649 #ifdef DEBUGGING
650     const char * const i_strpos = strpos;
651 #endif
652     GET_RE_DEBUG_FLAGS_DECL;
653
654     PERL_ARGS_ASSERT_RE_INTUIT_START;
655     PERL_UNUSED_ARG(flags);
656     PERL_UNUSED_ARG(data);
657
658     RX_MATCH_UTF8_set(rx,utf8_target);
659
660     if (RX_UTF8(rx)) {
661         PL_reg_flags |= RF_utf8;
662     }
663     DEBUG_EXECUTE_r( 
664         debug_start_match(rx, utf8_target, strpos, strend,
665             sv ? "Guessing start of match in sv for"
666                : "Guessing start of match in string for");
667               );
668
669     /* CHR_DIST() would be more correct here but it makes things slow. */
670     if (prog->minlen > strend - strpos) {
671         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
672                               "String too short... [re_intuit_start]\n"));
673         goto fail;
674     }
675                 
676     /* XXX we need to pass strbeg as a separate arg: the following is
677      * guesswork and can be wrong... */
678     if (sv && SvPOK(sv)) {
679         char * p   = SvPVX(sv);
680         STRLEN cur = SvCUR(sv); 
681         if (p <= strpos && strpos < p + cur) {
682             strbeg = p;
683             assert(p <= strend && strend <= p + cur);
684         }
685         else
686             strbeg = strend - cur;
687     }
688     else 
689         strbeg = strpos;
690
691     PL_regeol = strend;
692     if (utf8_target) {
693         if (!prog->check_utf8 && prog->check_substr)
694             to_utf8_substr(prog);
695         check = prog->check_utf8;
696     } else {
697         if (!prog->check_substr && prog->check_utf8) {
698             if (! to_byte_substr(prog)) {
699                 NON_UTF8_TARGET_BUT_UTF8_REQUIRED(fail);
700             }
701         }
702         check = prog->check_substr;
703     }
704     if (prog->extflags & RXf_ANCH) {    /* Match at beg-of-str or after \n */
705         ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
706                      || ( (prog->extflags & RXf_ANCH_BOL)
707                           && !multiline ) );    /* Check after \n? */
708
709         if (!ml_anch) {
710           if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
711                 && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
712                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
713                && sv && !SvROK(sv)
714                && (strpos != strbeg)) {
715               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
716               goto fail;
717           }
718           if (prog->check_offset_min == prog->check_offset_max
719               && !(prog->extflags & RXf_CANY_SEEN)
720               && ! multiline)   /* /m can cause \n's to match that aren't
721                                    accounted for in the string max length.
722                                    See [perl #115242] */
723           {
724             /* Substring at constant offset from beg-of-str... */
725             I32 slen;
726
727             s = HOP3c(strpos, prog->check_offset_min, strend);
728             
729             if (SvTAIL(check)) {
730                 slen = SvCUR(check);    /* >= 1 */
731
732                 if ( strend - s > slen || strend - s < slen - 1
733                      || (strend - s == slen && strend[-1] != '\n')) {
734                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
735                     goto fail_finish;
736                 }
737                 /* Now should match s[0..slen-2] */
738                 slen--;
739                 if (slen && (*SvPVX_const(check) != *s
740                              || (slen > 1
741                                  && memNE(SvPVX_const(check), s, slen)))) {
742                   report_neq:
743                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
744                     goto fail_finish;
745                 }
746             }
747             else if (*SvPVX_const(check) != *s
748                      || ((slen = SvCUR(check)) > 1
749                          && memNE(SvPVX_const(check), s, slen)))
750                 goto report_neq;
751             check_at = s;
752             goto success_at_start;
753           }
754         }
755         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
756         s = strpos;
757         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
758         end_shift = prog->check_end_shift;
759         
760         if (!ml_anch) {
761             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
762                                          - (SvTAIL(check) != 0);
763             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
764
765             if (end_shift < eshift)
766                 end_shift = eshift;
767         }
768     }
769     else {                              /* Can match at random position */
770         ml_anch = 0;
771         s = strpos;
772         start_shift = prog->check_offset_min;  /* okay to underestimate on CC */
773         end_shift = prog->check_end_shift;
774         
775         /* end shift should be non negative here */
776     }
777
778 #ifdef QDEBUGGING       /* 7/99: reports of failure (with the older version) */
779     if (end_shift < 0)
780         Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
781                    (IV)end_shift, RX_PRECOMP(prog));
782 #endif
783
784   restart:
785     /* Find a possible match in the region s..strend by looking for
786        the "check" substring in the region corrected by start/end_shift. */
787     
788     {
789         I32 srch_start_shift = start_shift;
790         I32 srch_end_shift = end_shift;
791         U8* start_point;
792         U8* end_point;
793         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
794             srch_end_shift -= ((strbeg - s) - srch_start_shift); 
795             srch_start_shift = strbeg - s;
796         }
797     DEBUG_OPTIMISE_MORE_r({
798         PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
799             (IV)prog->check_offset_min,
800             (IV)srch_start_shift,
801             (IV)srch_end_shift, 
802             (IV)prog->check_end_shift);
803     });       
804         
805         if (prog->extflags & RXf_CANY_SEEN) {
806             start_point= (U8*)(s + srch_start_shift);
807             end_point= (U8*)(strend - srch_end_shift);
808         } else {
809             start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
810             end_point= HOP3(strend, -srch_end_shift, strbeg);
811         }
812         DEBUG_OPTIMISE_MORE_r({
813             PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n", 
814                 (int)(end_point - start_point),
815                 (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point), 
816                 start_point);
817         });
818
819         s = fbm_instr( start_point, end_point,
820                       check, multiline ? FBMrf_MULTILINE : 0);
821     }
822     /* Update the count-of-usability, remove useless subpatterns,
823         unshift s.  */
824
825     DEBUG_EXECUTE_r({
826         RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
827             SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
828         PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
829                           (s ? "Found" : "Did not find"),
830             (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
831                 ? "anchored" : "floating"),
832             quoted,
833             RE_SV_TAIL(check),
834             (s ? " at offset " : "...\n") ); 
835     });
836
837     if (!s)
838         goto fail_finish;
839     /* Finish the diagnostic message */
840     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
841
842     /* XXX dmq: first branch is for positive lookbehind...
843        Our check string is offset from the beginning of the pattern.
844        So we need to do any stclass tests offset forward from that 
845        point. I think. :-(
846      */
847     
848         
849     
850     check_at=s;
851      
852
853     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
854        Start with the other substr.
855        XXXX no SCREAM optimization yet - and a very coarse implementation
856        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
857                 *always* match.  Probably should be marked during compile...
858        Probably it is right to do no SCREAM here...
859      */
860
861     if (utf8_target ? (prog->float_utf8 && prog->anchored_utf8)
862                 : (prog->float_substr && prog->anchored_substr)) 
863     {
864         /* Take into account the "other" substring. */
865         /* XXXX May be hopelessly wrong for UTF... */
866         if (!other_last)
867             other_last = strpos;
868         if (check == (utf8_target ? prog->float_utf8 : prog->float_substr)) {
869           do_other_anchored:
870             {
871                 char * const last = HOP3c(s, -start_shift, strbeg);
872                 char *last1, *last2;
873                 char * const saved_s = s;
874                 SV* must;
875
876                 t = s - prog->check_offset_max;
877                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
878                     && (!utf8_target
879                         || ((t = (char*)reghopmaybe3((U8*)s, -(prog->check_offset_max), (U8*)strpos))
880                             && t > strpos)))
881                     NOOP;
882                 else
883                     t = strpos;
884                 t = HOP3c(t, prog->anchored_offset, strend);
885                 if (t < other_last)     /* These positions already checked */
886                     t = other_last;
887                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
888                 if (last < last1)
889                     last1 = last;
890                 /* XXXX It is not documented what units *_offsets are in.  
891                    We assume bytes, but this is clearly wrong. 
892                    Meaning this code needs to be carefully reviewed for errors.
893                    dmq.
894                   */
895  
896                 /* On end-of-str: see comment below. */
897                 must = utf8_target ? prog->anchored_utf8 : prog->anchored_substr;
898                 if (must == &PL_sv_undef) {
899                     s = (char*)NULL;
900                     DEBUG_r(must = prog->anchored_utf8);        /* for debug */
901                 }
902                 else
903                     s = fbm_instr(
904                         (unsigned char*)t,
905                         HOP3(HOP3(last1, prog->anchored_offset, strend)
906                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
907                         must,
908                         multiline ? FBMrf_MULTILINE : 0
909                     );
910                 DEBUG_EXECUTE_r({
911                     RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
912                         SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
913                     PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
914                         (s ? "Found" : "Contradicts"),
915                         quoted, RE_SV_TAIL(must));
916                 });                 
917                 
918                             
919                 if (!s) {
920                     if (last1 >= last2) {
921                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
922                                                 ", giving up...\n"));
923                         goto fail_finish;
924                     }
925                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
926                         ", trying floating at offset %ld...\n",
927                         (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
928                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
929                     s = HOP3c(last, 1, strend);
930                     goto restart;
931                 }
932                 else {
933                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
934                           (long)(s - i_strpos)));
935                     t = HOP3c(s, -prog->anchored_offset, strbeg);
936                     other_last = HOP3c(s, 1, strend);
937                     s = saved_s;
938                     if (t == strpos)
939                         goto try_at_start;
940                     goto try_at_offset;
941                 }
942             }
943         }
944         else {          /* Take into account the floating substring. */
945             char *last, *last1;
946             char * const saved_s = s;
947             SV* must;
948
949             t = HOP3c(s, -start_shift, strbeg);
950             last1 = last =
951                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
952             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
953                 last = HOP3c(t, prog->float_max_offset, strend);
954             s = HOP3c(t, prog->float_min_offset, strend);
955             if (s < other_last)
956                 s = other_last;
957  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
958             must = utf8_target ? prog->float_utf8 : prog->float_substr;
959             /* fbm_instr() takes into account exact value of end-of-str
960                if the check is SvTAIL(ed).  Since false positives are OK,
961                and end-of-str is not later than strend we are OK. */
962             if (must == &PL_sv_undef) {
963                 s = (char*)NULL;
964                 DEBUG_r(must = prog->float_utf8);       /* for debug message */
965             }
966             else
967                 s = fbm_instr((unsigned char*)s,
968                               (unsigned char*)last + SvCUR(must)
969                                   - (SvTAIL(must)!=0),
970                               must, multiline ? FBMrf_MULTILINE : 0);
971             DEBUG_EXECUTE_r({
972                 RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
973                     SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
974                 PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
975                     (s ? "Found" : "Contradicts"),
976                     quoted, RE_SV_TAIL(must));
977             });
978             if (!s) {
979                 if (last1 == last) {
980                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
981                                             ", giving up...\n"));
982                     goto fail_finish;
983                 }
984                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
985                     ", trying anchored starting at offset %ld...\n",
986                     (long)(saved_s + 1 - i_strpos)));
987                 other_last = last;
988                 s = HOP3c(t, 1, strend);
989                 goto restart;
990             }
991             else {
992                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
993                       (long)(s - i_strpos)));
994                 other_last = s; /* Fix this later. --Hugo */
995                 s = saved_s;
996                 if (t == strpos)
997                     goto try_at_start;
998                 goto try_at_offset;
999             }
1000         }
1001     }
1002
1003     
1004     t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
1005         
1006     DEBUG_OPTIMISE_MORE_r(
1007         PerlIO_printf(Perl_debug_log, 
1008             "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
1009             (IV)prog->check_offset_min,
1010             (IV)prog->check_offset_max,
1011             (IV)(s-strpos),
1012             (IV)(t-strpos),
1013             (IV)(t-s),
1014             (IV)(strend-strpos)
1015         )
1016     );
1017
1018     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
1019         && (!utf8_target
1020             || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
1021                  && t > strpos))) 
1022     {
1023         /* Fixed substring is found far enough so that the match
1024            cannot start at strpos. */
1025       try_at_offset:
1026         if (ml_anch && t[-1] != '\n') {
1027             /* Eventually fbm_*() should handle this, but often
1028                anchored_offset is not 0, so this check will not be wasted. */
1029             /* XXXX In the code below we prefer to look for "^" even in
1030                presence of anchored substrings.  And we search even
1031                beyond the found float position.  These pessimizations
1032                are historical artefacts only.  */
1033           find_anchor:
1034             while (t < strend - prog->minlen) {
1035                 if (*t == '\n') {
1036                     if (t < check_at - prog->check_offset_min) {
1037                         if (utf8_target ? prog->anchored_utf8 : prog->anchored_substr) {
1038                             /* Since we moved from the found position,
1039                                we definitely contradict the found anchored
1040                                substr.  Due to the above check we do not
1041                                contradict "check" substr.
1042                                Thus we can arrive here only if check substr
1043                                is float.  Redo checking for "other"=="fixed".
1044                              */
1045                             strpos = t + 1;                     
1046                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
1047                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
1048                             goto do_other_anchored;
1049                         }
1050                         /* We don't contradict the found floating substring. */
1051                         /* XXXX Why not check for STCLASS? */
1052                         s = t + 1;
1053                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
1054                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
1055                         goto set_useful;
1056                     }
1057                     /* Position contradicts check-string */
1058                     /* XXXX probably better to look for check-string
1059                        than for "\n", so one should lower the limit for t? */
1060                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
1061                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
1062                     other_last = strpos = s = t + 1;
1063                     goto restart;
1064                 }
1065                 t++;
1066             }
1067             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
1068                         PL_colors[0], PL_colors[1]));
1069             goto fail_finish;
1070         }
1071         else {
1072             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
1073                         PL_colors[0], PL_colors[1]));
1074         }
1075         s = t;
1076       set_useful:
1077         ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr);        /* hooray/5 */
1078     }
1079     else {
1080         /* The found string does not prohibit matching at strpos,
1081            - no optimization of calling REx engine can be performed,
1082            unless it was an MBOL and we are not after MBOL,
1083            or a future STCLASS check will fail this. */
1084       try_at_start:
1085         /* Even in this situation we may use MBOL flag if strpos is offset
1086            wrt the start of the string. */
1087         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
1088             && (strpos != strbeg) && strpos[-1] != '\n'
1089             /* May be due to an implicit anchor of m{.*foo}  */
1090             && !(prog->intflags & PREGf_IMPLICIT))
1091         {
1092             t = strpos;
1093             goto find_anchor;
1094         }
1095         DEBUG_EXECUTE_r( if (ml_anch)
1096             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
1097                           (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
1098         );
1099       success_at_start:
1100         if (!(prog->intflags & PREGf_NAUGHTY)   /* XXXX If strpos moved? */
1101             && (utf8_target ? (
1102                 prog->check_utf8                /* Could be deleted already */
1103                 && --BmUSEFUL(prog->check_utf8) < 0
1104                 && (prog->check_utf8 == prog->float_utf8)
1105             ) : (
1106                 prog->check_substr              /* Could be deleted already */
1107                 && --BmUSEFUL(prog->check_substr) < 0
1108                 && (prog->check_substr == prog->float_substr)
1109             )))
1110         {
1111             /* If flags & SOMETHING - do not do it many times on the same match */
1112             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
1113             /* XXX Does the destruction order has to change with utf8_target? */
1114             SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
1115             SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
1116             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
1117             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
1118             check = NULL;                       /* abort */
1119             s = strpos;
1120             /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag
1121                     see http://bugs.activestate.com/show_bug.cgi?id=87173 */
1122             if (prog->intflags & PREGf_IMPLICIT)
1123                 prog->extflags &= ~RXf_ANCH_MBOL;
1124             /* XXXX This is a remnant of the old implementation.  It
1125                     looks wasteful, since now INTUIT can use many
1126                     other heuristics. */
1127             prog->extflags &= ~RXf_USE_INTUIT;
1128             /* XXXX What other flags might need to be cleared in this branch? */
1129         }
1130         else
1131             s = strpos;
1132     }
1133
1134     /* Last resort... */
1135     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
1136     /* trie stclasses are too expensive to use here, we are better off to
1137        leave it to regmatch itself */
1138     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
1139         /* minlen == 0 is possible if regstclass is \b or \B,
1140            and the fixed substr is ''$.
1141            Since minlen is already taken into account, s+1 is before strend;
1142            accidentally, minlen >= 1 guaranties no false positives at s + 1
1143            even for \b or \B.  But (minlen? 1 : 0) below assumes that
1144            regstclass does not come from lookahead...  */
1145         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
1146            This leaves EXACTF-ish only, which are dealt with in find_byclass().  */
1147         const U8* const str = (U8*)STRING(progi->regstclass);
1148         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
1149                     ? CHR_DIST(str+STR_LEN(progi->regstclass), str)
1150                     : 1);
1151         char * endpos;
1152         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
1153             endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
1154         else if (prog->float_substr || prog->float_utf8)
1155             endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
1156         else 
1157             endpos= strend;
1158                     
1159         if (checked_upto < s)
1160            checked_upto = s;
1161         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" s: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n",
1162                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg), (IV)(checked_upto- strbeg)));
1163
1164         t = s;
1165         s = find_byclass(prog, progi->regstclass, checked_upto, endpos, NULL);
1166         if (s) {
1167             checked_upto = s;
1168         } else {
1169 #ifdef DEBUGGING
1170             const char *what = NULL;
1171 #endif
1172             if (endpos == strend) {
1173                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1174                                 "Could not match STCLASS...\n") );
1175                 goto fail;
1176             }
1177             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1178                                    "This position contradicts STCLASS...\n") );
1179             if ((prog->extflags & RXf_ANCH) && !ml_anch)
1180                 goto fail;
1181             checked_upto = HOPBACKc(endpos, start_shift);
1182             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n",
1183                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(endpos - strbeg), (IV)(checked_upto- strbeg)));
1184             /* Contradict one of substrings */
1185             if (prog->anchored_substr || prog->anchored_utf8) {
1186                 if ((utf8_target ? prog->anchored_utf8 : prog->anchored_substr) == check) {
1187                     DEBUG_EXECUTE_r( what = "anchored" );
1188                   hop_and_restart:
1189                     s = HOP3c(t, 1, strend);
1190                     if (s + start_shift + end_shift > strend) {
1191                         /* XXXX Should be taken into account earlier? */
1192                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1193                                                "Could not match STCLASS...\n") );
1194                         goto fail;
1195                     }
1196                     if (!check)
1197                         goto giveup;
1198                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1199                                 "Looking for %s substr starting at offset %ld...\n",
1200                                  what, (long)(s + start_shift - i_strpos)) );
1201                     goto restart;
1202                 }
1203                 /* Have both, check_string is floating */
1204                 if (t + start_shift >= check_at) /* Contradicts floating=check */
1205                     goto retry_floating_check;
1206                 /* Recheck anchored substring, but not floating... */
1207                 s = check_at;
1208                 if (!check)
1209                     goto giveup;
1210                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1211                           "Looking for anchored substr starting at offset %ld...\n",
1212                           (long)(other_last - i_strpos)) );
1213                 goto do_other_anchored;
1214             }
1215             /* Another way we could have checked stclass at the
1216                current position only: */
1217             if (ml_anch) {
1218                 s = t = t + 1;
1219                 if (!check)
1220                     goto giveup;
1221                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1222                           "Looking for /%s^%s/m starting at offset %ld...\n",
1223                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
1224                 goto try_at_offset;
1225             }
1226             if (!(utf8_target ? prog->float_utf8 : prog->float_substr)) /* Could have been deleted */
1227                 goto fail;
1228             /* Check is floating substring. */
1229           retry_floating_check:
1230             t = check_at - start_shift;
1231             DEBUG_EXECUTE_r( what = "floating" );
1232             goto hop_and_restart;
1233         }
1234         if (t != s) {
1235             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1236                         "By STCLASS: moving %ld --> %ld\n",
1237                                   (long)(t - i_strpos), (long)(s - i_strpos))
1238                    );
1239         }
1240         else {
1241             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1242                                   "Does not contradict STCLASS...\n"); 
1243                    );
1244         }
1245     }
1246   giveup:
1247     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
1248                           PL_colors[4], (check ? "Guessed" : "Giving up"),
1249                           PL_colors[5], (long)(s - i_strpos)) );
1250     return s;
1251
1252   fail_finish:                          /* Substring not found */
1253     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
1254         BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
1255   fail:
1256     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
1257                           PL_colors[4], PL_colors[5]));
1258     return NULL;
1259 }
1260
1261 #define DECL_TRIE_TYPE(scan) \
1262     const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold } \
1263                     trie_type = ((scan->flags == EXACT) \
1264                               ? (utf8_target ? trie_utf8 : trie_plain) \
1265                               : (utf8_target ? trie_utf8_fold : trie_latin_utf8_fold))
1266
1267 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,          \
1268 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                               \
1269     STRLEN skiplen;                                                                 \
1270     switch (trie_type) {                                                            \
1271     case trie_utf8_fold:                                                            \
1272         if ( foldlen>0 ) {                                                          \
1273             uvc = utf8n_to_uvuni( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
1274             foldlen -= len;                                                         \
1275             uscan += len;                                                           \
1276             len=0;                                                                  \
1277         } else {                                                                    \
1278             uvc = to_utf8_fold( (const U8*) uc, foldbuf, &foldlen );                \
1279             len = UTF8SKIP(uc);                                                     \
1280             skiplen = UNISKIP( uvc );                                               \
1281             foldlen -= skiplen;                                                     \
1282             uscan = foldbuf + skiplen;                                              \
1283         }                                                                           \
1284         break;                                                                      \
1285     case trie_latin_utf8_fold:                                                      \
1286         if ( foldlen>0 ) {                                                          \
1287             uvc = utf8n_to_uvuni( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
1288             foldlen -= len;                                                         \
1289             uscan += len;                                                           \
1290             len=0;                                                                  \
1291         } else {                                                                    \
1292             len = 1;                                                                \
1293             uvc = _to_fold_latin1( (U8) *uc, foldbuf, &foldlen, 1);                 \
1294             skiplen = UNISKIP( uvc );                                               \
1295             foldlen -= skiplen;                                                     \
1296             uscan = foldbuf + skiplen;                                              \
1297         }                                                                           \
1298         break;                                                                      \
1299     case trie_utf8:                                                                 \
1300         uvc = utf8n_to_uvuni( (const U8*) uc, UTF8_MAXLEN, &len, uniflags );        \
1301         break;                                                                      \
1302     case trie_plain:                                                                \
1303         uvc = (UV)*uc;                                                              \
1304         len = 1;                                                                    \
1305     }                                                                               \
1306     if (uvc < 256) {                                                                \
1307         charid = trie->charmap[ uvc ];                                              \
1308     }                                                                               \
1309     else {                                                                          \
1310         charid = 0;                                                                 \
1311         if (widecharmap) {                                                          \
1312             SV** const svpp = hv_fetch(widecharmap,                                 \
1313                         (char*)&uvc, sizeof(UV), 0);                                \
1314             if (svpp)                                                               \
1315                 charid = (U16)SvIV(*svpp);                                          \
1316         }                                                                           \
1317     }                                                                               \
1318 } STMT_END
1319
1320 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
1321 STMT_START {                                              \
1322     while (s <= e) {                                      \
1323         if ( (CoNd)                                       \
1324              && (ln == 1 || folder(s, pat_string, ln))    \
1325              && (!reginfo || regtry(reginfo, &s)) )       \
1326             goto got_it;                                  \
1327         s++;                                              \
1328     }                                                     \
1329 } STMT_END
1330
1331 #define REXEC_FBC_UTF8_SCAN(CoDe)                     \
1332 STMT_START {                                          \
1333     while (s < strend) {                              \
1334         CoDe                                          \
1335         s += UTF8SKIP(s);                             \
1336     }                                                 \
1337 } STMT_END
1338
1339 #define REXEC_FBC_SCAN(CoDe)                          \
1340 STMT_START {                                          \
1341     while (s < strend) {                              \
1342         CoDe                                          \
1343         s++;                                          \
1344     }                                                 \
1345 } STMT_END
1346
1347 #define REXEC_FBC_UTF8_CLASS_SCAN(CoNd)               \
1348 REXEC_FBC_UTF8_SCAN(                                  \
1349     if (CoNd) {                                       \
1350         if (tmp && (!reginfo || regtry(reginfo, &s))) \
1351             goto got_it;                              \
1352         else                                          \
1353             tmp = doevery;                            \
1354     }                                                 \
1355     else                                              \
1356         tmp = 1;                                      \
1357 )
1358
1359 #define REXEC_FBC_CLASS_SCAN(CoNd)                    \
1360 REXEC_FBC_SCAN(                                       \
1361     if (CoNd) {                                       \
1362         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1363             goto got_it;                              \
1364         else                                          \
1365             tmp = doevery;                            \
1366     }                                                 \
1367     else                                              \
1368         tmp = 1;                                      \
1369 )
1370
1371 #define REXEC_FBC_TRYIT               \
1372 if ((!reginfo || regtry(reginfo, &s))) \
1373     goto got_it
1374
1375 #define REXEC_FBC_CSCAN(CoNdUtF8,CoNd)                         \
1376     if (utf8_target) {                                             \
1377         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1378     }                                                          \
1379     else {                                                     \
1380         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1381     }
1382     
1383 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
1384     if (utf8_target) {                                             \
1385         UtFpReLoAd;                                            \
1386         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1387     }                                                          \
1388     else {                                                     \
1389         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1390     }
1391
1392 #define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd)                   \
1393     PL_reg_flags |= RF_tainted;                                \
1394     if (utf8_target) {                                             \
1395         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1396     }                                                          \
1397     else {                                                     \
1398         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1399     }
1400
1401 #define DUMP_EXEC_POS(li,s,doutf8) \
1402     dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
1403
1404
1405 #define UTF8_NOLOAD(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
1406         tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';                         \
1407         tmp = TEST_NON_UTF8(tmp);                                              \
1408         REXEC_FBC_UTF8_SCAN(                                                   \
1409             if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
1410                 tmp = !tmp;                                                    \
1411                 IF_SUCCESS;                                                    \
1412             }                                                                  \
1413             else {                                                             \
1414                 IF_FAIL;                                                       \
1415             }                                                                  \
1416         );                                                                     \
1417
1418 #define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \
1419         if (s == PL_bostr) {                                                   \
1420             tmp = '\n';                                                        \
1421         }                                                                      \
1422         else {                                                                 \
1423             U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);                 \
1424             tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);       \
1425         }                                                                      \
1426         tmp = TeSt1_UtF8;                                                      \
1427         LOAD_UTF8_CHARCLASS_ALNUM();                                                                \
1428         REXEC_FBC_UTF8_SCAN(                                                   \
1429             if (tmp == ! (TeSt2_UtF8)) { \
1430                 tmp = !tmp;                                                    \
1431                 IF_SUCCESS;                                                    \
1432             }                                                                  \
1433             else {                                                             \
1434                 IF_FAIL;                                                       \
1435             }                                                                  \
1436         );                                                                     \
1437
1438 /* The only difference between the BOUND and NBOUND cases is that
1439  * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in
1440  * NBOUND.  This is accomplished by passing it in either the if or else clause,
1441  * with the other one being empty */
1442 #define FBC_BOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1443     FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
1444
1445 #define FBC_BOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1446     FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
1447
1448 #define FBC_NBOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1449     FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
1450
1451 #define FBC_NBOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1452     FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
1453
1454
1455 /* Common to the BOUND and NBOUND cases.  Unfortunately the UTF8 tests need to
1456  * be passed in completely with the variable name being tested, which isn't
1457  * such a clean interface, but this is easier to read than it was before.  We
1458  * are looking for the boundary (or non-boundary between a word and non-word
1459  * character.  The utf8 and non-utf8 cases have the same logic, but the details
1460  * must be different.  Find the "wordness" of the character just prior to this
1461  * one, and compare it with the wordness of this one.  If they differ, we have
1462  * a boundary.  At the beginning of the string, pretend that the previous
1463  * character was a new-line */
1464 #define FBC_BOUND_COMMON(UTF8_CODE, TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
1465     if (utf8_target) {                                                         \
1466                 UTF8_CODE \
1467     }                                                                          \
1468     else {  /* Not utf8 */                                                     \
1469         tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';                         \
1470         tmp = TEST_NON_UTF8(tmp);                                              \
1471         REXEC_FBC_SCAN(                                                        \
1472             if (tmp == ! TEST_NON_UTF8((U8) *s)) {                             \
1473                 tmp = !tmp;                                                    \
1474                 IF_SUCCESS;                                                    \
1475             }                                                                  \
1476             else {                                                             \
1477                 IF_FAIL;                                                       \
1478             }                                                                  \
1479         );                                                                     \
1480     }                                                                          \
1481     if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s)))           \
1482         goto got_it;
1483
1484 /* We know what class REx starts with.  Try to find this position... */
1485 /* if reginfo is NULL, its a dryrun */
1486 /* annoyingly all the vars in this routine have different names from their counterparts
1487    in regmatch. /grrr */
1488
1489 STATIC char *
1490 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, 
1491     const char *strend, regmatch_info *reginfo)
1492 {
1493     dVAR;
1494     const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
1495     char *pat_string;   /* The pattern's exactish string */
1496     char *pat_end;          /* ptr to end char of pat_string */
1497     re_fold_t folder;   /* Function for computing non-utf8 folds */
1498     const U8 *fold_array;   /* array for folding ords < 256 */
1499     STRLEN ln;
1500     STRLEN lnc;
1501     STRLEN uskip;
1502     U8 c1;
1503     U8 c2;
1504     char *e;
1505     I32 tmp = 1;        /* Scratch variable? */
1506     const bool utf8_target = PL_reg_match_utf8;
1507     UV utf8_fold_flags = 0;
1508     RXi_GET_DECL(prog,progi);
1509
1510     PERL_ARGS_ASSERT_FIND_BYCLASS;
1511
1512     /* We know what class it must start with. */
1513     switch (OP(c)) {
1514     case ANYOF:
1515         if (utf8_target) {
1516             REXEC_FBC_UTF8_CLASS_SCAN(
1517                       reginclass(prog, c, (U8*)s, utf8_target));
1518         }
1519         else {
1520             REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s));
1521         }
1522         break;
1523     case CANY:
1524         REXEC_FBC_SCAN(
1525             if (tmp && (!reginfo || regtry(reginfo, &s)))
1526                 goto got_it;
1527             else
1528                 tmp = doevery;
1529         );
1530         break;
1531
1532     case EXACTFA:
1533         if (UTF_PATTERN || utf8_target) {
1534             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
1535             goto do_exactf_utf8;
1536         }
1537         fold_array = PL_fold_latin1;    /* Latin1 folds are not affected by */
1538         folder = foldEQ_latin1;         /* /a, except the sharp s one which */
1539         goto do_exactf_non_utf8;        /* isn't dealt with by these */
1540
1541     case EXACTF:
1542         if (utf8_target) {
1543
1544             /* regcomp.c already folded this if pattern is in UTF-8 */
1545             utf8_fold_flags = 0;
1546             goto do_exactf_utf8;
1547         }
1548         fold_array = PL_fold;
1549         folder = foldEQ;
1550         goto do_exactf_non_utf8;
1551
1552     case EXACTFL:
1553         if (UTF_PATTERN || utf8_target) {
1554             utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
1555             goto do_exactf_utf8;
1556         }
1557         fold_array = PL_fold_locale;
1558         folder = foldEQ_locale;
1559         goto do_exactf_non_utf8;
1560
1561     case EXACTFU_SS:
1562         if (UTF_PATTERN) {
1563             utf8_fold_flags = FOLDEQ_S2_ALREADY_FOLDED;
1564         }
1565         goto do_exactf_utf8;
1566
1567     case EXACTFU_TRICKYFOLD:
1568     case EXACTFU:
1569         if (UTF_PATTERN || utf8_target) {
1570             utf8_fold_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
1571             goto do_exactf_utf8;
1572         }
1573
1574         /* Any 'ss' in the pattern should have been replaced by regcomp,
1575          * so we don't have to worry here about this single special case
1576          * in the Latin1 range */
1577         fold_array = PL_fold_latin1;
1578         folder = foldEQ_latin1;
1579
1580         /* FALL THROUGH */
1581
1582     do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
1583                            are no glitches with fold-length differences
1584                            between the target string and pattern */
1585
1586         /* The idea in the non-utf8 EXACTF* cases is to first find the
1587          * first character of the EXACTF* node and then, if necessary,
1588          * case-insensitively compare the full text of the node.  c1 is the
1589          * first character.  c2 is its fold.  This logic will not work for
1590          * Unicode semantics and the german sharp ss, which hence should
1591          * not be compiled into a node that gets here. */
1592         pat_string = STRING(c);
1593         ln  = STR_LEN(c);       /* length to match in octets/bytes */
1594
1595         /* We know that we have to match at least 'ln' bytes (which is the
1596          * same as characters, since not utf8).  If we have to match 3
1597          * characters, and there are only 2 availabe, we know without
1598          * trying that it will fail; so don't start a match past the
1599          * required minimum number from the far end */
1600         e = HOP3c(strend, -((I32)ln), s);
1601
1602         if (!reginfo && e < s) {
1603             e = s;                      /* Due to minlen logic of intuit() */
1604         }
1605
1606         c1 = *pat_string;
1607         c2 = fold_array[c1];
1608         if (c1 == c2) { /* If char and fold are the same */
1609             REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
1610         }
1611         else {
1612             REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
1613         }
1614         break;
1615
1616     do_exactf_utf8:
1617     {
1618         unsigned expansion;
1619
1620         /* If one of the operands is in utf8, we can't use the simpler folding
1621          * above, due to the fact that many different characters can have the
1622          * same fold, or portion of a fold, or different- length fold */
1623         pat_string = STRING(c);
1624         ln  = STR_LEN(c);       /* length to match in octets/bytes */
1625         pat_end = pat_string + ln;
1626         lnc = (UTF_PATTERN)     /* length to match in characters */
1627                 ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
1628                 : ln;
1629
1630         /* We have 'lnc' characters to match in the pattern, but because of
1631          * multi-character folding, each character in the target can match
1632          * up to 3 characters (Unicode guarantees it will never exceed
1633          * this) if it is utf8-encoded; and up to 2 if not (based on the
1634          * fact that the Latin 1 folds are already determined, and the
1635          * only multi-char fold in that range is the sharp-s folding to
1636          * 'ss'.  Thus, a pattern character can match as little as 1/3 of a
1637          * string character.  Adjust lnc accordingly, rounding up, so that
1638          * if we need to match at least 4+1/3 chars, that really is 5. */
1639         expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
1640         lnc = (lnc + expansion - 1) / expansion;
1641
1642         /* As in the non-UTF8 case, if we have to match 3 characters, and
1643          * only 2 are left, it's guaranteed to fail, so don't start a
1644          * match that would require us to go beyond the end of the string
1645          */
1646         e = HOP3c(strend, -((I32)lnc), s);
1647
1648         if (!reginfo && e < s) {
1649             e = s;                      /* Due to minlen logic of intuit() */
1650         }
1651
1652         /* XXX Note that we could recalculate e to stop the loop earlier,
1653          * as the worst case expansion above will rarely be met, and as we
1654          * go along we would usually find that e moves further to the left.
1655          * This would happen only after we reached the point in the loop
1656          * where if there were no expansion we should fail.  Unclear if
1657          * worth the expense */
1658
1659         while (s <= e) {
1660             char *my_strend= (char *)strend;
1661             if (foldEQ_utf8_flags(s, &my_strend, 0,  utf8_target,
1662                   pat_string, NULL, ln, cBOOL(UTF_PATTERN), utf8_fold_flags)
1663                 && (!reginfo || regtry(reginfo, &s)) )
1664             {
1665                 goto got_it;
1666             }
1667             s += (utf8_target) ? UTF8SKIP(s) : 1;
1668         }
1669         break;
1670     }
1671     case BOUNDL:
1672         PL_reg_flags |= RF_tainted;
1673         FBC_BOUND(isALNUM_LC,
1674                   isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
1675                   isALNUM_LC_utf8((U8*)s));
1676         break;
1677     case NBOUNDL:
1678         PL_reg_flags |= RF_tainted;
1679         FBC_NBOUND(isALNUM_LC,
1680                    isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
1681                    isALNUM_LC_utf8((U8*)s));
1682         break;
1683     case BOUND:
1684         FBC_BOUND(isWORDCHAR,
1685                   isALNUM_uni(tmp),
1686                   cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1687         break;
1688     case BOUNDA:
1689         FBC_BOUND_NOLOAD(isWORDCHAR_A,
1690                          isWORDCHAR_A(tmp),
1691                          isWORDCHAR_A((U8*)s));
1692         break;
1693     case NBOUND:
1694         FBC_NBOUND(isWORDCHAR,
1695                    isALNUM_uni(tmp),
1696                    cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1697         break;
1698     case NBOUNDA:
1699         FBC_NBOUND_NOLOAD(isWORDCHAR_A,
1700                           isWORDCHAR_A(tmp),
1701                           isWORDCHAR_A((U8*)s));
1702         break;
1703     case BOUNDU:
1704         FBC_BOUND(isWORDCHAR_L1,
1705                   isALNUM_uni(tmp),
1706                   cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1707         break;
1708     case NBOUNDU:
1709         FBC_NBOUND(isWORDCHAR_L1,
1710                    isALNUM_uni(tmp),
1711                    cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1712         break;
1713     case ALNUML:
1714         REXEC_FBC_CSCAN_TAINT(
1715             isALNUM_LC_utf8((U8*)s),
1716             isALNUM_LC(*s)
1717         );
1718         break;
1719     case ALNUMU:
1720         REXEC_FBC_CSCAN_PRELOAD(
1721             LOAD_UTF8_CHARCLASS_ALNUM(),
1722             swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1723             isWORDCHAR_L1((U8) *s)
1724         );
1725         break;
1726     case ALNUM:
1727         REXEC_FBC_CSCAN_PRELOAD(
1728             LOAD_UTF8_CHARCLASS_ALNUM(),
1729             swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1730             isWORDCHAR((U8) *s)
1731         );
1732         break;
1733     case ALNUMA:
1734         /* Don't need to worry about utf8, as it can match only a single
1735          * byte invariant character */
1736         REXEC_FBC_CLASS_SCAN( isWORDCHAR_A(*s));
1737         break;
1738     case NALNUMU:
1739         REXEC_FBC_CSCAN_PRELOAD(
1740             LOAD_UTF8_CHARCLASS_ALNUM(),
1741             !swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1742             ! isWORDCHAR_L1((U8) *s)
1743         );
1744         break;
1745     case NALNUM:
1746         REXEC_FBC_CSCAN_PRELOAD(
1747             LOAD_UTF8_CHARCLASS_ALNUM(),
1748             !swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target),
1749             ! isALNUM(*s)
1750         );
1751         break;
1752     case NALNUMA:
1753         REXEC_FBC_CSCAN(
1754             !isWORDCHAR_A(*s),
1755             !isWORDCHAR_A(*s)
1756         );
1757         break;
1758     case NALNUML:
1759         REXEC_FBC_CSCAN_TAINT(
1760             !isALNUM_LC_utf8((U8*)s),
1761             !isALNUM_LC(*s)
1762         );
1763         break;
1764     case SPACEU:
1765         REXEC_FBC_CSCAN(
1766             is_XPERLSPACE_utf8(s),
1767             isSPACE_L1((U8) *s)
1768         );
1769         break;
1770     case SPACE:
1771         REXEC_FBC_CSCAN(
1772             is_XPERLSPACE_utf8(s),
1773             isSPACE((U8) *s)
1774         );
1775         break;
1776     case SPACEA:
1777         /* Don't need to worry about utf8, as it can match only a single
1778          * byte invariant character */
1779         REXEC_FBC_CLASS_SCAN( isSPACE_A(*s));
1780         break;
1781     case SPACEL:
1782         REXEC_FBC_CSCAN_TAINT(
1783             isSPACE_LC_utf8((U8*)s),
1784             isSPACE_LC(*s)
1785         );
1786         break;
1787     case NSPACEU:
1788         REXEC_FBC_CSCAN(
1789             ! is_XPERLSPACE_utf8(s),
1790             ! isSPACE_L1((U8) *s)
1791         );
1792         break;
1793     case NSPACE:
1794         REXEC_FBC_CSCAN(
1795             ! is_XPERLSPACE_utf8(s),
1796             ! isSPACE((U8) *s)
1797         );
1798         break;
1799     case NSPACEA:
1800         REXEC_FBC_CSCAN(
1801             !isSPACE_A(*s),
1802             !isSPACE_A(*s)
1803         );
1804         break;
1805     case NSPACEL:
1806         REXEC_FBC_CSCAN_TAINT(
1807             !isSPACE_LC_utf8((U8*)s),
1808             !isSPACE_LC(*s)
1809         );
1810         break;
1811     case DIGIT:
1812         REXEC_FBC_CSCAN_PRELOAD(
1813             LOAD_UTF8_CHARCLASS_DIGIT(),
1814             swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
1815             isDIGIT(*s)
1816         );
1817         break;
1818     case DIGITA:
1819         /* Don't need to worry about utf8, as it can match only a single
1820          * byte invariant character */
1821         REXEC_FBC_CLASS_SCAN( isDIGIT_A(*s));
1822         break;
1823     case DIGITL:
1824         REXEC_FBC_CSCAN_TAINT(
1825             isDIGIT_LC_utf8((U8*)s),
1826             isDIGIT_LC(*s)
1827         );
1828         break;
1829     case NDIGIT:
1830         REXEC_FBC_CSCAN_PRELOAD(
1831             LOAD_UTF8_CHARCLASS_DIGIT(),
1832             !swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
1833             !isDIGIT(*s)
1834         );
1835         break;
1836     case NDIGITA:
1837         REXEC_FBC_CSCAN(
1838             !isDIGIT_A(*s),
1839             !isDIGIT_A(*s)
1840         );
1841         break;
1842     case NDIGITL:
1843         REXEC_FBC_CSCAN_TAINT(
1844             !isDIGIT_LC_utf8((U8*)s),
1845             !isDIGIT_LC(*s)
1846         );
1847         break;
1848     case LNBREAK:
1849         REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend),
1850                         is_LNBREAK_latin1_safe(s, strend)
1851         );
1852         break;
1853     case VERTWS:
1854         REXEC_FBC_CSCAN(
1855             is_VERTWS_utf8_safe(s, strend),
1856             is_VERTWS_latin1_safe(s, strend)
1857         );
1858         break;
1859     case NVERTWS:
1860         REXEC_FBC_CSCAN(
1861             !is_VERTWS_utf8_safe(s, strend),
1862             !is_VERTWS_latin1_safe(s, strend)
1863         );
1864         break;
1865     case HORIZWS:
1866         REXEC_FBC_CSCAN(
1867             is_HORIZWS_utf8_safe(s, strend),
1868             is_HORIZWS_latin1_safe(s, strend)
1869         );
1870         break;
1871     case NHORIZWS:
1872         REXEC_FBC_CSCAN(
1873             !is_HORIZWS_utf8_safe(s, strend),
1874             !is_HORIZWS_latin1_safe(s, strend)
1875         );
1876         break;
1877     case POSIXA:
1878         /* Don't need to worry about utf8, as it can match only a single
1879         * byte invariant character.  The flag in this node type is the
1880         * class number to pass to _generic_isCC() to build a mask for
1881         * searching in PL_charclass[] */
1882         REXEC_FBC_CLASS_SCAN( _generic_isCC_A(*s, FLAGS(c)));
1883         break;
1884     case NPOSIXA:
1885         REXEC_FBC_CSCAN(
1886             !_generic_isCC_A(*s, FLAGS(c)),
1887             !_generic_isCC_A(*s, FLAGS(c))
1888         );
1889         break;
1890
1891     case AHOCORASICKC:
1892     case AHOCORASICK:
1893         {
1894             DECL_TRIE_TYPE(c);
1895             /* what trie are we using right now */
1896             reg_ac_data *aho = (reg_ac_data*)progi->data->data[ ARG( c ) ];
1897             reg_trie_data *trie = (reg_trie_data*)progi->data->data[ aho->trie ];
1898             HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
1899
1900             const char *last_start = strend - trie->minlen;
1901 #ifdef DEBUGGING
1902             const char *real_start = s;
1903 #endif
1904             STRLEN maxlen = trie->maxlen;
1905             SV *sv_points;
1906             U8 **points; /* map of where we were in the input string
1907                             when reading a given char. For ASCII this
1908                             is unnecessary overhead as the relationship
1909                             is always 1:1, but for Unicode, especially
1910                             case folded Unicode this is not true. */
1911             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1912             U8 *bitmap=NULL;
1913
1914
1915             GET_RE_DEBUG_FLAGS_DECL;
1916
1917             /* We can't just allocate points here. We need to wrap it in
1918              * an SV so it gets freed properly if there is a croak while
1919              * running the match */
1920             ENTER;
1921             SAVETMPS;
1922             sv_points=newSV(maxlen * sizeof(U8 *));
1923             SvCUR_set(sv_points,
1924                 maxlen * sizeof(U8 *));
1925             SvPOK_on(sv_points);
1926             sv_2mortal(sv_points);
1927             points=(U8**)SvPV_nolen(sv_points );
1928             if ( trie_type != trie_utf8_fold
1929                  && (trie->bitmap || OP(c)==AHOCORASICKC) )
1930             {
1931                 if (trie->bitmap)
1932                     bitmap=(U8*)trie->bitmap;
1933                 else
1934                     bitmap=(U8*)ANYOF_BITMAP(c);
1935             }
1936             /* this is the Aho-Corasick algorithm modified a touch
1937                to include special handling for long "unknown char" sequences.
1938                The basic idea being that we use AC as long as we are dealing
1939                with a possible matching char, when we encounter an unknown char
1940                (and we have not encountered an accepting state) we scan forward
1941                until we find a legal starting char.
1942                AC matching is basically that of trie matching, except that when
1943                we encounter a failing transition, we fall back to the current
1944                states "fail state", and try the current char again, a process
1945                we repeat until we reach the root state, state 1, or a legal
1946                transition. If we fail on the root state then we can either
1947                terminate if we have reached an accepting state previously, or
1948                restart the entire process from the beginning if we have not.
1949
1950              */
1951             while (s <= last_start) {
1952                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1953                 U8 *uc = (U8*)s;
1954                 U16 charid = 0;
1955                 U32 base = 1;
1956                 U32 state = 1;
1957                 UV uvc = 0;
1958                 STRLEN len = 0;
1959                 STRLEN foldlen = 0;
1960                 U8 *uscan = (U8*)NULL;
1961                 U8 *leftmost = NULL;
1962 #ifdef DEBUGGING
1963                 U32 accepted_word= 0;
1964 #endif
1965                 U32 pointpos = 0;
1966
1967                 while ( state && uc <= (U8*)strend ) {
1968                     int failed=0;
1969                     U32 word = aho->states[ state ].wordnum;
1970
1971                     if( state==1 ) {
1972                         if ( bitmap ) {
1973                             DEBUG_TRIE_EXECUTE_r(
1974                                 if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1975                                     dump_exec_pos( (char *)uc, c, strend, real_start,
1976                                         (char *)uc, utf8_target );
1977                                     PerlIO_printf( Perl_debug_log,
1978                                         " Scanning for legal start char...\n");
1979                                 }
1980                             );
1981                             if (utf8_target) {
1982                                 while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1983                                     uc += UTF8SKIP(uc);
1984                                 }
1985                             } else {
1986                                 while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
1987                                     uc++;
1988                                 }
1989                             }
1990                             s= (char *)uc;
1991                         }
1992                         if (uc >(U8*)last_start) break;
1993                     }
1994
1995                     if ( word ) {
1996                         U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
1997                         if (!leftmost || lpos < leftmost) {
1998                             DEBUG_r(accepted_word=word);
1999                             leftmost= lpos;
2000                         }
2001                         if (base==0) break;
2002
2003                     }
2004                     points[pointpos++ % maxlen]= uc;
2005                     if (foldlen || uc < (U8*)strend) {
2006                         REXEC_TRIE_READ_CHAR(trie_type, trie,
2007                                          widecharmap, uc,
2008                                          uscan, len, uvc, charid, foldlen,
2009                                          foldbuf, uniflags);
2010                         DEBUG_TRIE_EXECUTE_r({
2011                             dump_exec_pos( (char *)uc, c, strend,
2012                                         real_start, s, utf8_target);
2013                             PerlIO_printf(Perl_debug_log,
2014                                 " Charid:%3u CP:%4"UVxf" ",
2015                                  charid, uvc);
2016                         });
2017                     }
2018                     else {
2019                         len = 0;
2020                         charid = 0;
2021                     }
2022
2023
2024                     do {
2025 #ifdef DEBUGGING
2026                         word = aho->states[ state ].wordnum;
2027 #endif
2028                         base = aho->states[ state ].trans.base;
2029
2030                         DEBUG_TRIE_EXECUTE_r({
2031                             if (failed)
2032                                 dump_exec_pos( (char *)uc, c, strend, real_start,
2033                                     s,   utf8_target );
2034                             PerlIO_printf( Perl_debug_log,
2035                                 "%sState: %4"UVxf", word=%"UVxf,
2036                                 failed ? " Fail transition to " : "",
2037                                 (UV)state, (UV)word);
2038                         });
2039                         if ( base ) {
2040                             U32 tmp;
2041                             I32 offset;
2042                             if (charid &&
2043                                  ( ((offset = base + charid
2044                                     - 1 - trie->uniquecharcount)) >= 0)
2045                                  && ((U32)offset < trie->lasttrans)
2046                                  && trie->trans[offset].check == state
2047                                  && (tmp=trie->trans[offset].next))
2048                             {
2049                                 DEBUG_TRIE_EXECUTE_r(
2050                                     PerlIO_printf( Perl_debug_log," - legal\n"));
2051                                 state = tmp;
2052                                 break;
2053                             }
2054                             else {
2055                                 DEBUG_TRIE_EXECUTE_r(
2056                                     PerlIO_printf( Perl_debug_log," - fail\n"));
2057                                 failed = 1;
2058                                 state = aho->fail[state];
2059                             }
2060                         }
2061                         else {
2062                             /* we must be accepting here */
2063                             DEBUG_TRIE_EXECUTE_r(
2064                                     PerlIO_printf( Perl_debug_log," - accepting\n"));
2065                             failed = 1;
2066                             break;
2067                         }
2068                     } while(state);
2069                     uc += len;
2070                     if (failed) {
2071                         if (leftmost)
2072                             break;
2073                         if (!state) state = 1;
2074                     }
2075                 }
2076                 if ( aho->states[ state ].wordnum ) {
2077                     U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
2078                     if (!leftmost || lpos < leftmost) {
2079                         DEBUG_r(accepted_word=aho->states[ state ].wordnum);
2080                         leftmost = lpos;
2081                     }
2082                 }
2083                 if (leftmost) {
2084                     s = (char*)leftmost;
2085                     DEBUG_TRIE_EXECUTE_r({
2086                         PerlIO_printf(
2087                             Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
2088                             (UV)accepted_word, (IV)(s - real_start)
2089                         );
2090                     });
2091                     if (!reginfo || regtry(reginfo, &s)) {
2092                         FREETMPS;
2093                         LEAVE;
2094                         goto got_it;
2095                     }
2096                     s = HOPc(s,1);
2097                     DEBUG_TRIE_EXECUTE_r({
2098                         PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
2099                     });
2100                 } else {
2101                     DEBUG_TRIE_EXECUTE_r(
2102                         PerlIO_printf( Perl_debug_log,"No match.\n"));
2103                     break;
2104                 }
2105             }
2106             FREETMPS;
2107             LEAVE;
2108         }
2109         break;
2110     default:
2111         Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
2112         break;
2113     }
2114     return 0;
2115   got_it:
2116     return s;
2117 }
2118
2119
2120 /*
2121  - regexec_flags - match a regexp against a string
2122  */
2123 I32
2124 Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
2125               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
2126 /* stringarg: the point in the string at which to begin matching */
2127 /* strend:    pointer to null at end of string */
2128 /* strbeg:    real beginning of string */
2129 /* minend:    end of match must be >= minend bytes after stringarg. */
2130 /* sv:        SV being matched: only used for utf8 flag, pos() etc; string
2131  *            itself is accessed via the pointers above */
2132 /* data:      May be used for some additional optimizations.
2133               Currently its only used, with a U32 cast, for transmitting
2134               the ganch offset when doing a /g match. This will change */
2135 /* nosave:    For optimizations. */
2136
2137 {
2138     dVAR;
2139     struct regexp *const prog = ReANY(rx);
2140     char *s;
2141     regnode *c;
2142     char *startpos = stringarg;
2143     I32 minlen;         /* must match at least this many chars */
2144     I32 dontbother = 0; /* how many characters not to try at end */
2145     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
2146     I32 scream_pos = -1;                /* Internal iterator of scream. */
2147     char *scream_olds = NULL;
2148     const bool utf8_target = cBOOL(DO_UTF8(sv));
2149     I32 multiline;
2150     RXi_GET_DECL(prog,progi);
2151     regmatch_info reginfo;  /* create some info to pass to regtry etc */
2152     regexp_paren_pair *swap = NULL;
2153     GET_RE_DEBUG_FLAGS_DECL;
2154
2155     PERL_ARGS_ASSERT_REGEXEC_FLAGS;
2156     PERL_UNUSED_ARG(data);
2157
2158     /* Be paranoid... */
2159     if (prog == NULL || startpos == NULL) {
2160         Perl_croak(aTHX_ "NULL regexp parameter");
2161         return 0;
2162     }
2163
2164     multiline = prog->extflags & RXf_PMf_MULTILINE;
2165     reginfo.prog = rx;   /* Yes, sorry that this is confusing.  */
2166
2167     RX_MATCH_UTF8_set(rx, utf8_target);
2168     DEBUG_EXECUTE_r( 
2169         debug_start_match(rx, utf8_target, startpos, strend,
2170         "Matching");
2171     );
2172
2173     minlen = prog->minlen;
2174     
2175     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
2176         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
2177                               "String too short [regexec_flags]...\n"));
2178         goto phooey;
2179     }
2180
2181     
2182     /* Check validity of program. */
2183     if (UCHARAT(progi->program) != REG_MAGIC) {
2184         Perl_croak(aTHX_ "corrupted regexp program");
2185     }
2186
2187     PL_reg_flags = 0;
2188     PL_reg_state.re_state_eval_setup_done = FALSE;
2189     PL_reg_maxiter = 0;
2190
2191     if (RX_UTF8(rx))
2192         PL_reg_flags |= RF_utf8;
2193
2194     /* Mark beginning of line for ^ and lookbehind. */
2195     reginfo.bol = startpos; /* XXX not used ??? */
2196     PL_bostr  = strbeg;
2197     reginfo.sv = sv;
2198
2199     /* Mark end of line for $ (and such) */
2200     PL_regeol = strend;
2201
2202     /* see how far we have to get to not match where we matched before */
2203     reginfo.till = startpos+minend;
2204
2205     /* If there is a "must appear" string, look for it. */
2206     s = startpos;
2207
2208     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
2209         MAGIC *mg;
2210         if (flags & REXEC_IGNOREPOS){   /* Means: check only at start */
2211             reginfo.ganch = startpos + prog->gofs;
2212             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2213               "GPOS IGNOREPOS: reginfo.ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
2214         } else if (sv && SvTYPE(sv) >= SVt_PVMG
2215                   && SvMAGIC(sv)
2216                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
2217                   && mg->mg_len >= 0) {
2218             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
2219             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2220                 "GPOS MAGIC: reginfo.ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
2221
2222             if (prog->extflags & RXf_ANCH_GPOS) {
2223                 if (s > reginfo.ganch)
2224                     goto phooey;
2225                 s = reginfo.ganch - prog->gofs;
2226                 DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2227                      "GPOS ANCH_GPOS: s = ganch - %"UVxf"\n",(UV)prog->gofs));
2228                 if (s < strbeg)
2229                     goto phooey;
2230             }
2231         }
2232         else if (data) {
2233             reginfo.ganch = strbeg + PTR2UV(data);
2234             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2235                  "GPOS DATA: reginfo.ganch= strbeg + %"UVxf"\n",PTR2UV(data)));
2236
2237         } else {                                /* pos() not defined */
2238             reginfo.ganch = strbeg;
2239             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2240                  "GPOS: reginfo.ganch = strbeg\n"));
2241         }
2242     }
2243     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
2244         /* We have to be careful. If the previous successful match
2245            was from this regex we don't want a subsequent partially
2246            successful match to clobber the old results.
2247            So when we detect this possibility we add a swap buffer
2248            to the re, and switch the buffer each match. If we fail
2249            we switch it back, otherwise we leave it swapped.
2250         */
2251         swap = prog->offs;
2252         /* do we need a save destructor here for eval dies? */
2253         Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
2254         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
2255             "rex=0x%"UVxf" saving  offs: orig=0x%"UVxf" new=0x%"UVxf"\n",
2256             PTR2UV(prog),
2257             PTR2UV(swap),
2258             PTR2UV(prog->offs)
2259         ));
2260     }
2261     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
2262         re_scream_pos_data d;
2263
2264         d.scream_olds = &scream_olds;
2265         d.scream_pos = &scream_pos;
2266         s = re_intuit_start(rx, sv, s, strend, flags, &d);
2267         if (!s) {
2268             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
2269             goto phooey;        /* not present */
2270         }
2271     }
2272
2273
2274
2275     /* Simplest case:  anchored match need be tried only once. */
2276     /*  [unless only anchor is BOL and multiline is set] */
2277     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
2278         if (s == startpos && regtry(&reginfo, &startpos))
2279             goto got_it;
2280         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
2281                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
2282         {
2283             char *end;
2284
2285             if (minlen)
2286                 dontbother = minlen - 1;
2287             end = HOP3c(strend, -dontbother, strbeg) - 1;
2288             /* for multiline we only have to try after newlines */
2289             if (prog->check_substr || prog->check_utf8) {
2290                 /* because of the goto we can not easily reuse the macros for bifurcating the
2291                    unicode/non-unicode match modes here like we do elsewhere - demerphq */
2292                 if (utf8_target) {
2293                     if (s == startpos)
2294                         goto after_try_utf8;
2295                     while (1) {
2296                         if (regtry(&reginfo, &s)) {
2297                             goto got_it;
2298                         }
2299                       after_try_utf8:
2300                         if (s > end) {
2301                             goto phooey;
2302                         }
2303                         if (prog->extflags & RXf_USE_INTUIT) {
2304                             s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL);
2305                             if (!s) {
2306                                 goto phooey;
2307                             }
2308                         }
2309                         else {
2310                             s += UTF8SKIP(s);
2311                         }
2312                     }
2313                 } /* end search for check string in unicode */
2314                 else {
2315                     if (s == startpos) {
2316                         goto after_try_latin;
2317                     }
2318                     while (1) {
2319                         if (regtry(&reginfo, &s)) {
2320                             goto got_it;
2321                         }
2322                       after_try_latin:
2323                         if (s > end) {
2324                             goto phooey;
2325                         }
2326                         if (prog->extflags & RXf_USE_INTUIT) {
2327                             s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
2328                             if (!s) {
2329                                 goto phooey;
2330                             }
2331                         }
2332                         else {
2333                             s++;
2334                         }
2335                     }
2336                 } /* end search for check string in latin*/
2337             } /* end search for check string */
2338             else { /* search for newline */
2339                 if (s > startpos) {
2340                     /*XXX: The s-- is almost definitely wrong here under unicode - demeprhq*/
2341                     s--;
2342                 }
2343                 /* We can use a more efficient search as newlines are the same in unicode as they are in latin */
2344                 while (s <= end) { /* note it could be possible to match at the end of the string */
2345                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
2346                         if (regtry(&reginfo, &s))
2347                             goto got_it;
2348                     }
2349                 }
2350             } /* end search for newline */
2351         } /* end anchored/multiline check string search */
2352         goto phooey;
2353     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK)) 
2354     {
2355         /* the warning about reginfo.ganch being used without initialization
2356            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN 
2357            and we only enter this block when the same bit is set. */
2358         char *tmp_s = reginfo.ganch - prog->gofs;
2359
2360         if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
2361             goto got_it;
2362         goto phooey;
2363     }
2364
2365     /* Messy cases:  unanchored match. */
2366     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
2367         /* we have /x+whatever/ */
2368         /* it must be a one character string (XXXX Except UTF_PATTERN?) */
2369         char ch;
2370 #ifdef DEBUGGING
2371         int did_match = 0;
2372 #endif
2373         if (utf8_target) {
2374             if (! prog->anchored_utf8) {
2375                 to_utf8_substr(prog);
2376             }
2377             ch = SvPVX_const(prog->anchored_utf8)[0];
2378             REXEC_FBC_SCAN(
2379                 if (*s == ch) {
2380                     DEBUG_EXECUTE_r( did_match = 1 );
2381                     if (regtry(&reginfo, &s)) goto got_it;
2382                     s += UTF8SKIP(s);
2383                     while (s < strend && *s == ch)
2384                         s += UTF8SKIP(s);
2385                 }
2386             );
2387
2388         }
2389         else {
2390             if (! prog->anchored_substr) {
2391                 if (! to_byte_substr(prog)) {
2392                     NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
2393                 }
2394             }
2395             ch = SvPVX_const(prog->anchored_substr)[0];
2396             REXEC_FBC_SCAN(
2397                 if (*s == ch) {
2398                     DEBUG_EXECUTE_r( did_match = 1 );
2399                     if (regtry(&reginfo, &s)) goto got_it;
2400                     s++;
2401                     while (s < strend && *s == ch)
2402                         s++;
2403                 }
2404             );
2405         }
2406         DEBUG_EXECUTE_r(if (!did_match)
2407                 PerlIO_printf(Perl_debug_log,
2408                                   "Did not find anchored character...\n")
2409                );
2410     }
2411     else if (prog->anchored_substr != NULL
2412               || prog->anchored_utf8 != NULL
2413               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
2414                   && prog->float_max_offset < strend - s)) {
2415         SV *must;
2416         I32 back_max;
2417         I32 back_min;
2418         char *last;
2419         char *last1;            /* Last position checked before */
2420 #ifdef DEBUGGING
2421         int did_match = 0;
2422 #endif
2423         if (prog->anchored_substr || prog->anchored_utf8) {
2424             if (utf8_target) {
2425                 if (! prog->anchored_utf8) {
2426                     to_utf8_substr(prog);
2427                 }
2428                 must = prog->anchored_utf8;
2429             }
2430             else {
2431                 if (! prog->anchored_substr) {
2432                     if (! to_byte_substr(prog)) {
2433                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
2434                     }
2435                 }
2436                 must = prog->anchored_substr;
2437             }
2438             back_max = back_min = prog->anchored_offset;
2439         } else {
2440             if (utf8_target) {
2441                 if (! prog->float_utf8) {
2442                     to_utf8_substr(prog);
2443                 }
2444                 must = prog->float_utf8;
2445             }
2446             else {
2447                 if (! prog->float_substr) {
2448                     if (! to_byte_substr(prog)) {
2449                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
2450                     }
2451                 }
2452                 must = prog->float_substr;
2453             }
2454             back_max = prog->float_max_offset;
2455             back_min = prog->float_min_offset;
2456         }
2457             
2458         if (back_min<0) {
2459             last = strend;
2460         } else {
2461             last = HOP3c(strend,        /* Cannot start after this */
2462                   -(I32)(CHR_SVLEN(must)
2463                          - (SvTAIL(must) != 0) + back_min), strbeg);
2464         }
2465         if (s > PL_bostr)
2466             last1 = HOPc(s, -1);
2467         else
2468             last1 = s - 1;      /* bogus */
2469
2470         /* XXXX check_substr already used to find "s", can optimize if
2471            check_substr==must. */
2472         scream_pos = -1;
2473         dontbother = end_shift;
2474         strend = HOPc(strend, -dontbother);
2475         while ( (s <= last) &&
2476                 (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
2477                                   (unsigned char*)strend, must,
2478                                   multiline ? FBMrf_MULTILINE : 0)) ) {
2479             DEBUG_EXECUTE_r( did_match = 1 );
2480             if (HOPc(s, -back_max) > last1) {
2481                 last1 = HOPc(s, -back_min);
2482                 s = HOPc(s, -back_max);
2483             }
2484             else {
2485                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
2486
2487                 last1 = HOPc(s, -back_min);
2488                 s = t;
2489             }
2490             if (utf8_target) {
2491                 while (s <= last1) {
2492                     if (regtry(&reginfo, &s))
2493                         goto got_it;
2494                     if (s >= last1) {
2495                         s++; /* to break out of outer loop */
2496                         break;
2497                     }
2498                     s += UTF8SKIP(s);
2499                 }
2500             }
2501             else {
2502                 while (s <= last1) {
2503                     if (regtry(&reginfo, &s))
2504                         goto got_it;
2505                     s++;
2506                 }
2507             }
2508         }
2509         DEBUG_EXECUTE_r(if (!did_match) {
2510             RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
2511                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
2512             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
2513                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
2514                                ? "anchored" : "floating"),
2515                 quoted, RE_SV_TAIL(must));
2516         });                 
2517         goto phooey;
2518     }
2519     else if ( (c = progi->regstclass) ) {
2520         if (minlen) {
2521             const OPCODE op = OP(progi->regstclass);
2522             /* don't bother with what can't match */
2523             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
2524                 strend = HOPc(strend, -(minlen - 1));
2525         }
2526         DEBUG_EXECUTE_r({
2527             SV * const prop = sv_newmortal();
2528             regprop(prog, prop, c);
2529             {
2530                 RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
2531                     s,strend-s,60);
2532                 PerlIO_printf(Perl_debug_log,
2533                     "Matching stclass %.*s against %s (%d bytes)\n",
2534                     (int)SvCUR(prop), SvPVX_const(prop),
2535                      quoted, (int)(strend - s));
2536             }
2537         });
2538         if (find_byclass(prog, c, s, strend, &reginfo))
2539             goto got_it;
2540         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
2541     }
2542     else {
2543         dontbother = 0;
2544         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2545             /* Trim the end. */
2546             char *last= NULL;
2547             SV* float_real;
2548             STRLEN len;
2549             const char *little;
2550
2551             if (utf8_target) {
2552                 if (! prog->float_utf8) {
2553                     to_utf8_substr(prog);
2554                 }
2555                 float_real = prog->float_utf8;
2556             }
2557             else {
2558                 if (! prog->float_substr) {
2559                     if (! to_byte_substr(prog)) {
2560                         NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
2561                     }
2562                 }
2563                 float_real = prog->float_substr;
2564             }
2565
2566             little = SvPV_const(float_real, len);
2567             if (SvTAIL(float_real)) {
2568                     /* This means that float_real contains an artificial \n on
2569                      * the end due to the presence of something like this:
2570                      * /foo$/ where we can match both "foo" and "foo\n" at the
2571                      * end of the string.  So we have to compare the end of the
2572                      * string first against the float_real without the \n and
2573                      * then against the full float_real with the string.  We
2574                      * have to watch out for cases where the string might be
2575                      * smaller than the float_real or the float_real without
2576                      * the \n. */
2577                     char *checkpos= strend - len;
2578                     DEBUG_OPTIMISE_r(
2579                         PerlIO_printf(Perl_debug_log,
2580                             "%sChecking for float_real.%s\n",
2581                             PL_colors[4], PL_colors[5]));
2582                     if (checkpos + 1 < strbeg) {
2583                         /* can't match, even if we remove the trailing \n
2584                          * string is too short to match */
2585                         DEBUG_EXECUTE_r(
2586                             PerlIO_printf(Perl_debug_log,
2587                                 "%sString shorter than required trailing substring, cannot match.%s\n",
2588                                 PL_colors[4], PL_colors[5]));
2589                         goto phooey;
2590                     } else if (memEQ(checkpos + 1, little, len - 1)) {
2591                         /* can match, the end of the string matches without the
2592                          * "\n" */
2593                         last = checkpos + 1;
2594                     } else if (checkpos < strbeg) {
2595                         /* cant match, string is too short when the "\n" is
2596                          * included */
2597                         DEBUG_EXECUTE_r(
2598                             PerlIO_printf(Perl_debug_log,
2599                                 "%sString does not contain required trailing substring, cannot match.%s\n",
2600                                 PL_colors[4], PL_colors[5]));
2601                         goto phooey;
2602                     } else if (!multiline) {
2603                         /* non multiline match, so compare with the "\n" at the
2604                          * end of the string */
2605                         if (memEQ(checkpos, little, len)) {
2606                             last= checkpos;
2607                         } else {
2608                             DEBUG_EXECUTE_r(
2609                                 PerlIO_printf(Perl_debug_log,
2610                                     "%sString does not contain required trailing substring, cannot match.%s\n",
2611                                     PL_colors[4], PL_colors[5]));
2612                             goto phooey;
2613                         }
2614                     } else {
2615                         /* multiline match, so we have to search for a place
2616                          * where the full string is located */
2617                         goto find_last;
2618                     }
2619             } else {
2620                   find_last:
2621                     if (len)
2622                         last = rninstr(s, strend, little, little + len);
2623                     else
2624                         last = strend;  /* matching "$" */
2625             }
2626             if (!last) {
2627                 /* at one point this block contained a comment which was
2628                  * probably incorrect, which said that this was a "should not
2629                  * happen" case.  Even if it was true when it was written I am
2630                  * pretty sure it is not anymore, so I have removed the comment
2631                  * and replaced it with this one. Yves */
2632                 DEBUG_EXECUTE_r(
2633                     PerlIO_printf(Perl_debug_log,
2634                         "String does not contain required substring, cannot match.\n"
2635                     ));
2636                 goto phooey;
2637             }
2638             dontbother = strend - last + prog->float_min_offset;
2639         }
2640         if (minlen && (dontbother < minlen))
2641             dontbother = minlen - 1;
2642         strend -= dontbother;              /* this one's always in bytes! */
2643         /* We don't know much -- general case. */
2644         if (utf8_target) {
2645             for (;;) {
2646                 if (regtry(&reginfo, &s))
2647                     goto got_it;
2648                 if (s >= strend)
2649                     break;
2650                 s += UTF8SKIP(s);
2651             };
2652         }
2653         else {
2654             do {
2655                 if (regtry(&reginfo, &s))
2656                     goto got_it;
2657             } while (s++ < strend);
2658         }
2659     }
2660
2661     /* Failure. */
2662     goto phooey;
2663
2664 got_it:
2665     DEBUG_BUFFERS_r(
2666         if (swap)
2667             PerlIO_printf(Perl_debug_log,
2668                 "rex=0x%"UVxf" freeing offs: 0x%"UVxf"\n",
2669                 PTR2UV(prog),
2670                 PTR2UV(swap)
2671             );
2672     );
2673     Safefree(swap);
2674     RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
2675
2676     if (PL_reg_state.re_state_eval_setup_done)
2677         restore_pos(aTHX_ prog);
2678     if (RXp_PAREN_NAMES(prog)) 
2679         (void)hv_iterinit(RXp_PAREN_NAMES(prog));
2680
2681     /* make sure $`, $&, $', and $digit will work later */
2682     if ( !(flags & REXEC_NOT_FIRST) ) {
2683         if (flags & REXEC_COPY_STR) {
2684 #ifdef PERL_ANY_COW
2685             if (SvCANCOW(sv)) {
2686                 if (DEBUG_C_TEST) {
2687                     PerlIO_printf(Perl_debug_log,
2688                                   "Copy on write: regexp capture, type %d\n",
2689                                   (int) SvTYPE(sv));
2690                 }
2691                 RX_MATCH_COPY_FREE(rx);
2692                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2693                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2694                 assert (SvPOKp(prog->saved_copy));
2695                 prog->sublen  = PL_regeol - strbeg;
2696                 prog->suboffset = 0;
2697                 prog->subcoffset = 0;
2698             } else
2699 #endif
2700             {
2701                 I32 min = 0;
2702                 I32 max = PL_regeol - strbeg;
2703                 I32 sublen;
2704
2705                 if (    (flags & REXEC_COPY_SKIP_POST)
2706                     && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */
2707                     && !(PL_sawampersand & SAWAMPERSAND_RIGHT)
2708                 ) { /* don't copy $' part of string */
2709                     U32 n = 0;
2710                     max = -1;
2711                     /* calculate the right-most part of the string covered
2712                      * by a capture. Due to look-ahead, this may be to
2713                      * the right of $&, so we have to scan all captures */
2714                     while (n <= prog->lastparen) {
2715                         if (prog->offs[n].end > max)
2716                             max = prog->offs[n].end;
2717                         n++;
2718                     }
2719                     if (max == -1)
2720                         max = (PL_sawampersand & SAWAMPERSAND_LEFT)
2721                                 ? prog->offs[0].start
2722                                 : 0;
2723                     assert(max >= 0 && max <= PL_regeol - strbeg);
2724                 }
2725
2726                 if (    (flags & REXEC_COPY_SKIP_PRE)
2727                     && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */
2728                     && !(PL_sawampersand & SAWAMPERSAND_LEFT)
2729                 ) { /* don't copy $` part of string */
2730                     U32 n = 0;
2731                     min = max;
2732                     /* calculate the left-most part of the string covered
2733                      * by a capture. Due to look-behind, this may be to
2734                      * the left of $&, so we have to scan all captures */
2735                     while (min && n <= prog->lastparen) {
2736                         if (   prog->offs[n].start != -1
2737                             && prog->offs[n].start < min)
2738                         {
2739                             min = prog->offs[n].start;
2740                         }
2741                         n++;
2742                     }
2743                     if ((PL_sawampersand & SAWAMPERSAND_RIGHT)
2744                         && min >  prog->offs[0].end
2745                     )
2746                         min = prog->offs[0].end;
2747
2748                 }
2749
2750                 assert(min >= 0 && min <= max && min <= PL_regeol - strbeg);
2751                 sublen = max - min;
2752
2753                 if (RX_MATCH_COPIED(rx)) {
2754                     if (sublen > prog->sublen)
2755                         prog->subbeg =
2756                                 (char*)saferealloc(prog->subbeg, sublen+1);
2757                 }
2758                 else
2759                     prog->subbeg = (char*)safemalloc(sublen+1);
2760                 Copy(strbeg + min, prog->subbeg, sublen, char);
2761                 prog->subbeg[sublen] = '\0';
2762                 prog->suboffset = min;
2763                 prog->sublen = sublen;
2764                 RX_MATCH_COPIED_on(rx);
2765             }
2766             prog->subcoffset = prog->suboffset;
2767             if (prog->suboffset && utf8_target) {
2768                 /* Convert byte offset to chars.
2769                  * XXX ideally should only compute this if @-/@+
2770                  * has been seen, a la PL_sawampersand ??? */
2771
2772                 /* If there's a direct correspondence between the
2773                  * string which we're matching and the original SV,
2774                  * then we can use the utf8 len cache associated with
2775                  * the SV. In particular, it means that under //g,
2776                  * sv_pos_b2u() will use the previously cached
2777                  * position to speed up working out the new length of
2778                  * subcoffset, rather than counting from the start of
2779                  * the string each time. This stops
2780                  *   $x = "\x{100}" x 1E6; 1 while $x =~ /(.)/g;
2781                  * from going quadratic */
2782                 if (SvPOKp(sv) && SvPVX(sv) == strbeg)
2783                     sv_pos_b2u(sv, &(prog->subcoffset));
2784                 else
2785                     prog->subcoffset = utf8_length((U8*)strbeg,
2786                                         (U8*)(strbeg+prog->suboffset));
2787             }
2788         }
2789         else {
2790             RX_MATCH_COPY_FREE(rx);
2791             prog->subbeg = strbeg;
2792             prog->suboffset = 0;
2793             prog->subcoffset = 0;
2794             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2795         }
2796     }
2797
2798     return 1;
2799
2800 phooey:
2801     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2802                           PL_colors[4], PL_colors[5]));
2803     if (PL_reg_state.re_state_eval_setup_done)
2804         restore_pos(aTHX_ prog);
2805     if (swap) {
2806         /* we failed :-( roll it back */
2807         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
2808             "rex=0x%"UVxf" rolling back offs: freeing=0x%"UVxf" restoring=0x%"UVxf"\n",
2809             PTR2UV(prog),
2810             PTR2UV(prog->offs),
2811             PTR2UV(swap)
2812         ));
2813         Safefree(prog->offs);
2814         prog->offs = swap;
2815     }
2816     return 0;
2817 }
2818
2819
2820 /* Set which rex is pointed to by PL_reg_state, handling ref counting.
2821  * Do inc before dec, in case old and new rex are the same */
2822 #define SET_reg_curpm(Re2) \
2823     if (PL_reg_state.re_state_eval_setup_done) {    \
2824         (void)ReREFCNT_inc(Re2);                    \
2825         ReREFCNT_dec(PM_GETRE(PL_reg_curpm));       \
2826         PM_SETRE((PL_reg_curpm), (Re2));            \
2827     }
2828
2829
2830 /*
2831  - regtry - try match at specific point
2832  */
2833 STATIC I32                      /* 0 failure, 1 success */
2834 S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
2835 {
2836     dVAR;
2837     CHECKPOINT lastcp;
2838     REGEXP *const rx = reginfo->prog;
2839     regexp *const prog = ReANY(rx);
2840     I32 result;
2841     RXi_GET_DECL(prog,progi);
2842     GET_RE_DEBUG_FLAGS_DECL;
2843
2844     PERL_ARGS_ASSERT_REGTRY;
2845
2846     reginfo->cutpoint=NULL;
2847
2848     if ((prog->extflags & RXf_EVAL_SEEN)
2849         && !PL_reg_state.re_state_eval_setup_done)
2850     {
2851         MAGIC *mg;
2852
2853         PL_reg_state.re_state_eval_setup_done = TRUE;
2854         if (reginfo->sv) {
2855             /* Make $_ available to executed code. */
2856             if (reginfo->sv != DEFSV) {
2857                 SAVE_DEFSV;
2858                 DEFSV_set(reginfo->sv);
2859             }
2860         
2861             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2862                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2863                 /* prepare for quick setting of pos */
2864 #ifdef PERL_OLD_COPY_ON_WRITE
2865                 if (SvIsCOW(reginfo->sv))
2866                     sv_force_normal_flags(reginfo->sv, 0);
2867 #endif
2868                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2869                                  &PL_vtbl_mglob, NULL, 0);
2870                 mg->mg_len = -1;
2871             }
2872             PL_reg_magic    = mg;
2873             PL_reg_oldpos   = mg->mg_len;
2874             SAVEDESTRUCTOR_X(restore_pos, prog);
2875         }
2876         if (!PL_reg_curpm) {
2877             Newxz(PL_reg_curpm, 1, PMOP);
2878 #ifdef USE_ITHREADS
2879             {
2880                 SV* const repointer = &PL_sv_undef;
2881                 /* this regexp is also owned by the new PL_reg_curpm, which
2882                    will try to free it.  */
2883                 av_push(PL_regex_padav, repointer);
2884                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2885                 PL_regex_pad = AvARRAY(PL_regex_padav);
2886             }
2887 #endif      
2888         }
2889         SET_reg_curpm(rx);
2890         PL_reg_oldcurpm = PL_curpm;
2891         PL_curpm = PL_reg_curpm;
2892         if (RXp_MATCH_COPIED(prog)) {
2893             /*  Here is a serious problem: we cannot rewrite subbeg,
2894                 since it may be needed if this match fails.  Thus
2895                 $` inside (?{}) could fail... */
2896             PL_reg_oldsaved = prog->subbeg;
2897             PL_reg_oldsavedlen = prog->sublen;
2898             PL_reg_oldsavedoffset = prog->suboffset;
2899             PL_reg_oldsavedcoffset = prog->suboffset;
2900 #ifdef PERL_ANY_COW
2901             PL_nrs = prog->saved_copy;
2902 #endif
2903             RXp_MATCH_COPIED_off(prog);
2904         }
2905         else
2906             PL_reg_oldsaved = NULL;
2907         prog->subbeg = PL_bostr;
2908         prog->suboffset = 0;
2909         prog->subcoffset = 0;
2910         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2911     }
2912 #ifdef DEBUGGING
2913     PL_reg_starttry = *startposp;
2914 #endif
2915     prog->offs[0].start = *startposp - PL_bostr;
2916     prog->lastparen = 0;
2917     prog->lastcloseparen = 0;
2918
2919     /* XXXX What this code is doing here?!!!  There should be no need
2920        to do this again and again, prog->lastparen should take care of
2921        this!  --ilya*/
2922
2923     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2924      * Actually, the code in regcppop() (which Ilya may be meaning by
2925      * prog->lastparen), is not needed at all by the test suite
2926      * (op/regexp, op/pat, op/split), but that code is needed otherwise
2927      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
2928      * Meanwhile, this code *is* needed for the
2929      * above-mentioned test suite tests to succeed.  The common theme
2930      * on those tests seems to be returning null fields from matches.
2931      * --jhi updated by dapm */
2932 #if 1
2933     if (prog->nparens) {
2934         regexp_paren_pair *pp = prog->offs;
2935         I32 i;
2936         for (i = prog->nparens; i > (I32)prog->lastparen; i--) {
2937             ++pp;
2938             pp->start = -1;
2939             pp->end = -1;
2940         }
2941     }
2942 #endif
2943     REGCP_SET(lastcp);
2944     result = regmatch(reginfo, *startposp, progi->program + 1);
2945     if (result != -1) {
2946         prog->offs[0].end = result;
2947         return 1;
2948     }
2949     if (reginfo->cutpoint)
2950         *startposp= reginfo->cutpoint;
2951     REGCP_UNWIND(lastcp);
2952     return 0;
2953 }
2954
2955
2956 #define sayYES goto yes
2957 #define sayNO goto no
2958 #define sayNO_SILENT goto no_silent
2959
2960 /* we dont use STMT_START/END here because it leads to 
2961    "unreachable code" warnings, which are bogus, but distracting. */
2962 #define CACHEsayNO \
2963     if (ST.cache_mask) \
2964        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2965     sayNO
2966
2967 /* this is used to determine how far from the left messages like
2968    'failed...' are printed. It should be set such that messages 
2969    are inline with the regop output that created them.
2970 */
2971 #define REPORT_CODE_OFF 32
2972
2973
2974 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2975 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2976 #define CHRTEST_NOT_A_CP_1 -999
2977 #define CHRTEST_NOT_A_CP_2 -998
2978
2979 #define SLAB_FIRST(s) (&(s)->states[0])
2980 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2981
2982 /* grab a new slab and return the first slot in it */
2983
2984 STATIC regmatch_state *
2985 S_push_slab(pTHX)
2986 {
2987 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2988     dMY_CXT;
2989 #endif
2990     regmatch_slab *s = PL_regmatch_slab->next;
2991     if (!s) {
2992         Newx(s, 1, regmatch_slab);
2993         s->prev = PL_regmatch_slab;
2994         s->next = NULL;
2995         PL_regmatch_slab->next = s;
2996     }
2997     PL_regmatch_slab = s;
2998     return SLAB_FIRST(s);
2999 }
3000
3001
3002 /* push a new state then goto it */
3003
3004 #define PUSH_STATE_GOTO(state, node, input) \
3005     pushinput = input; \
3006     scan = node; \
3007     st->resume_state = state; \
3008     goto push_state;
3009
3010 /* push a new state with success backtracking, then goto it */
3011
3012 #define PUSH_YES_STATE_GOTO(state, node, input) \
3013     pushinput = input; \
3014     scan = node; \
3015     st->resume_state = state; \
3016     goto push_yes_state;
3017
3018
3019
3020
3021 /*
3022
3023 regmatch() - main matching routine
3024
3025 This is basically one big switch statement in a loop. We execute an op,
3026 set 'next' to point the next op, and continue. If we come to a point which
3027 we may need to backtrack to on failure such as (A|B|C), we push a
3028 backtrack state onto the backtrack stack. On failure, we pop the top
3029 state, and re-enter the loop at the state indicated. If there are no more
3030 states to pop, we return failure.
3031
3032 Sometimes we also need to backtrack on success; for example /A+/, where
3033 after successfully matching one A, we need to go back and try to
3034 match another one; similarly for lookahead assertions: if the assertion
3035 completes successfully, we backtrack to the state just before the assertion
3036 and then carry on.  In these cases, the pushed state is marked as
3037 'backtrack on success too'. This marking is in fact done by a chain of
3038 pointers, each pointing to the previous 'yes' state. On success, we pop to
3039 the nearest yes state, discarding any intermediate failure-only states.
3040 Sometimes a yes state is pushed just to force some cleanup code to be
3041 called at the end of a successful match or submatch; e.g. (??{$re}) uses
3042 it to free the inner regex.
3043
3044 Note that failure backtracking rewinds the cursor position, while
3045 success backtracking leaves it alone.
3046
3047 A pattern is complete when the END op is executed, while a subpattern
3048 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
3049 ops trigger the "pop to last yes state if any, otherwise return true"
3050 behaviour.
3051
3052 A common convention in this function is to use A and B to refer to the two
3053 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
3054 the subpattern to be matched possibly multiple times, while B is the entire
3055 rest of the pattern. Variable and state names reflect this convention.
3056
3057 The states in the main switch are the union of ops and failure/success of
3058 substates associated with with that op.  For example, IFMATCH is the op
3059 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
3060 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
3061 successfully matched A and IFMATCH_A_fail is a state saying that we have
3062 just failed to match A. Resume states always come in pairs. The backtrack
3063 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
3064 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
3065 on success or failure.
3066
3067 The struct that holds a backtracking state is actually a big union, with
3068 one variant for each major type of op. The variable st points to the
3069 top-most backtrack struct. To make the code clearer, within each
3070 block of code we #define ST to alias the relevant union.
3071
3072 Here's a concrete example of a (vastly oversimplified) IFMATCH
3073 implementation:
3074
3075     switch (state) {
3076     ....
3077
3078 #define ST st->u.ifmatch
3079
3080     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
3081         ST.foo = ...; // some state we wish to save
3082         ...
3083         // push a yes backtrack state with a resume value of
3084         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
3085         // first node of A:
3086         PUSH_YES_STATE_GOTO(IFMATCH_A, A, newinput);
3087         // NOTREACHED
3088
3089     case IFMATCH_A: // we have successfully executed A; now continue with B
3090         next = B;
3091         bar = ST.foo; // do something with the preserved value
3092         break;
3093
3094     case IFMATCH_A_fail: // A failed, so the assertion failed
3095         ...;   // do some housekeeping, then ...
3096         sayNO; // propagate the failure
3097
3098 #undef ST
3099
3100     ...
3101     }
3102
3103 For any old-timers reading this who are familiar with the old recursive
3104 approach, the code above is equivalent to:
3105
3106     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
3107     {
3108         int foo = ...
3109         ...
3110         if (regmatch(A)) {
3111             next = B;
3112             bar = foo;
3113             break;
3114         }
3115         ...;   // do some housekeeping, then ...
3116         sayNO; // propagate the failure
3117     }
3118
3119 The topmost backtrack state, pointed to by st, is usually free. If you
3120 want to claim it, populate any ST.foo fields in it with values you wish to
3121 save, then do one of
3122
3123         PUSH_STATE_GOTO(resume_state, node, newinput);
3124         PUSH_YES_STATE_GOTO(resume_state, node, newinput);
3125
3126 which sets that backtrack state's resume value to 'resume_state', pushes a
3127 new free entry to the top of the backtrack stack, then goes to 'node'.
3128 On backtracking, the free slot is popped, and the saved state becomes the
3129 new free state. An ST.foo field in this new top state can be temporarily
3130 accessed to retrieve values, but once the main loop is re-entered, it
3131 becomes available for reuse.
3132
3133 Note that the depth of the backtrack stack constantly increases during the
3134 left-to-right execution of the pattern, rather than going up and down with
3135 the pattern nesting. For example the stack is at its maximum at Z at the
3136 end of the pattern, rather than at X in the following:
3137
3138     /(((X)+)+)+....(Y)+....Z/
3139
3140 The only exceptions to this are lookahead/behind assertions and the cut,
3141 (?>A), which pop all the backtrack states associated with A before
3142 continuing.
3143  
3144 Backtrack state structs are allocated in slabs of about 4K in size.
3145 PL_regmatch_state and st always point to the currently active state,
3146 and PL_regmatch_slab points to the slab currently containing
3147 PL_regmatch_state.  The first time regmatch() is called, the first slab is
3148 allocated, and is never freed until interpreter destruction. When the slab
3149 is full, a new one is allocated and chained to the end. At exit from
3150 regmatch(), slabs allocated since entry are freed.
3151
3152 */
3153  
3154
3155 #define DEBUG_STATE_pp(pp)                                  \
3156     DEBUG_STATE_r({                                         \
3157         DUMP_EXEC_POS(locinput, scan, utf8_target);                 \
3158         PerlIO_printf(Perl_debug_log,                       \
3159             "    %*s"pp" %s%s%s%s%s\n",                     \
3160             depth*2, "",                                    \
3161             PL_reg_name[st->resume_state],                     \
3162             ((st==yes_state||st==mark_state) ? "[" : ""),   \
3163             ((st==yes_state) ? "Y" : ""),                   \
3164             ((st==mark_state) ? "M" : ""),                  \
3165             ((st==yes_state||st==mark_state) ? "]" : "")    \
3166         );                                                  \
3167     });
3168
3169
3170 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
3171
3172 #ifdef DEBUGGING
3173
3174 STATIC void
3175 S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target,
3176     const char *start, const char *end, const char *blurb)
3177 {
3178     const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
3179
3180     PERL_ARGS_ASSERT_DEBUG_START_MATCH;
3181
3182     if (!PL_colorset)   
3183             reginitcolors();    
3184     {
3185         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
3186             RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);   
3187         
3188         RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1),
3189             start, end - start, 60); 
3190         
3191         PerlIO_printf(Perl_debug_log, 
3192             "%s%s REx%s %s against %s\n", 
3193                        PL_colors[4], blurb, PL_colors[5], s0, s1); 
3194         
3195         if (utf8_target||utf8_pat)
3196             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
3197                 utf8_pat ? "pattern" : "",
3198                 utf8_pat && utf8_target ? " and " : "",
3199                 utf8_target ? "string" : ""
3200             ); 
3201     }
3202 }
3203
3204 STATIC void
3205 S_dump_exec_pos(pTHX_ const char *locinput, 
3206                       const regnode *scan, 
3207                       const char *loc_regeol, 
3208                       const char *loc_bostr, 
3209                       const char *loc_reg_starttry,
3210                       const bool utf8_target)
3211 {
3212     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
3213     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
3214     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
3215     /* The part of the string before starttry has one color
3216        (pref0_len chars), between starttry and current
3217        position another one (pref_len - pref0_len chars),
3218        after the current position the third one.
3219        We assume that pref0_len <= pref_len, otherwise we
3220        decrease pref0_len.  */
3221     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
3222         ? (5 + taill) - l : locinput - loc_bostr;
3223     int pref0_len;
3224
3225     PERL_ARGS_ASSERT_DUMP_EXEC_POS;
3226
3227     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
3228         pref_len++;
3229     pref0_len = pref_len  - (locinput - loc_reg_starttry);
3230     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
3231         l = ( loc_regeol - locinput > (5 + taill) - pref_len
3232               ? (5 + taill) - pref_len : loc_regeol - locinput);
3233     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
3234         l--;
3235     if (pref0_len < 0)
3236         pref0_len = 0;
3237     if (pref0_len > pref_len)
3238         pref0_len = pref_len;
3239     {
3240         const int is_uni = (utf8_target && OP(scan) != CANY) ? 1 : 0;
3241
3242         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
3243             (locinput - pref_len),pref0_len, 60, 4, 5);
3244         
3245         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
3246                     (locinput - pref_len + pref0_len),
3247                     pref_len - pref0_len, 60, 2, 3);
3248         
3249         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
3250                     locinput, loc_regeol - locinput, 10, 0, 1);
3251
3252         const STRLEN tlen=len0+len1+len2;
3253         PerlIO_printf(Perl_debug_log,
3254                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
3255                     (IV)(locinput - loc_bostr),
3256                     len0, s0,
3257                     len1, s1,
3258                     (docolor ? "" : "> <"),
3259                     len2, s2,
3260                     (int)(tlen > 19 ? 0 :  19 - tlen),
3261                     "");
3262     }
3263 }
3264
3265 #endif
3266
3267 /* reg_check_named_buff_matched()
3268  * Checks to see if a named buffer has matched. The data array of 
3269  * buffer numbers corresponding to the buffer is expected to reside
3270  * in the regexp->data->data array in the slot stored in the ARG() of
3271  * node involved. Note that this routine doesn't actually care about the
3272  * name, that information is not preserved from compilation to execution.
3273  * Returns the index of the leftmost defined buffer with the given name
3274  * or 0 if non of the buffers matched.
3275  */
3276 STATIC I32
3277 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
3278 {
3279     I32 n;
3280     RXi_GET_DECL(rex,rexi);
3281     SV *sv_dat= MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
3282     I32 *nums=(I32*)SvPVX(sv_dat);
3283
3284     PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED;
3285
3286     for ( n=0; n<SvIVX(sv_dat); n++ ) {
3287         if ((I32)rex->lastparen >= nums[n] &&
3288             rex->offs[nums[n]].end != -1)
3289         {
3290             return nums[n];
3291         }
3292     }
3293     return 0;
3294 }
3295
3296
3297 /* free all slabs above current one  - called during LEAVE_SCOPE */
3298
3299 STATIC void
3300 S_clear_backtrack_stack(pTHX_ void *p)
3301 {
3302     regmatch_slab *s = PL_regmatch_slab->next;
3303     PERL_UNUSED_ARG(p);
3304
3305     if (!s)
3306         return;
3307     PL_regmatch_slab->next = NULL;
3308     while (s) {
3309         regmatch_slab * const osl = s;
3310         s = s->next;
3311         Safefree(osl);
3312     }
3313 }
3314 static bool
3315 S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, U8* c1_utf8, int *c2p, U8* c2_utf8)
3316 {
3317     /* This function determines if there are one or two characters that match
3318      * the first character of the passed-in EXACTish node <text_node>, and if
3319      * so, returns them in the passed-in pointers.
3320      *
3321      * If it determines that no possible character in the target string can
3322      * match, it returns FALSE; otherwise TRUE.  (The FALSE situation occurs if
3323      * the first character in <text_node> requires UTF-8 to represent, and the
3324      * target string isn't in UTF-8.)
3325      *
3326      * If there are more than two characters that could match the beginning of
3327      * <text_node>, or if more context is required to determine a match or not,
3328      * it sets both *<c1p> and *<c2p> to CHRTEST_VOID.
3329      *
3330      * The motiviation behind this function is to allow the caller to set up
3331      * tight loops for matching.  If <text_node> is of type EXACT, there is
3332      * only one possible character that can match its first character, and so
3333      * the situation is quite simple.  But things get much more complicated if
3334      * folding is involved.  It may be that the first character of an EXACTFish
3335      * node doesn't participate in any possible fold, e.g., punctuation, so it
3336      * can be matched only by itself.  The vast majority of characters that are
3337      * in folds match just two things, their lower and upper-case equivalents.
3338      * But not all are like that; some have multiple possible matches, or match
3339      * sequences of more than one character.  This function sorts all that out.
3340      *
3341      * Consider the patterns A*B or A*?B where A and B are arbitrary.  In a
3342      * loop of trying to match A*, we know we can't exit where the thing
3343      * following it isn't a B.  And something can't be a B unless it is the
3344      * beginning of B.  By putting a quick test for that beginning in a tight
3345      * loop, we can rule out things that can't possibly be B without having to
3346      * break out of the loop, thus avoiding work.  Similarly, if A is a single
3347      * character, we can make a tight loop matching A*, using the outputs of
3348      * this function.
3349      *
3350      * If the target string to match isn't in UTF-8, and there aren't
3351      * complications which require CHRTEST_VOID, *<c1p> and *<c2p> are set to
3352      * the one or two possible octets (which are characters in this situation)
3353      * that can match.  In all cases, if there is only one character that can
3354      * match, *<c1p> and *<c2p> will be identical.
3355      *
3356      * If the target string is in UTF-8, the buffers pointed to by <c1_utf8>
3357      * and <c2_utf8> will contain the one or two UTF-8 sequences of bytes that
3358      * can match the beginning of <text_node>.  They should be declared with at
3359      * least length UTF8_MAXBYTES+1.  (If the target string isn't in UTF-8, it is
3360      * undefined what these contain.)  If one or both of the buffers are
3361      * invariant under UTF-8, *<c1p>, and *<c2p> will also be set to the
3362      * corresponding invariant.  If variant, the corresponding *<c1p> and/or
3363      * *<c2p> will be set to a negative number(s) that shouldn't match any code
3364      * point (unless inappropriately coerced to unsigned).   *<c1p> will equal
3365      * *<c2p> if and only if <c1_utf8> and <c2_utf8> are the same. */
3366
3367     const bool utf8_target = PL_reg_match_utf8;
3368
3369     UV c1 = CHRTEST_NOT_A_CP_1;
3370     UV c2 = CHRTEST_NOT_A_CP_2;
3371     bool use_chrtest_void = FALSE;
3372
3373     /* Used when we have both utf8 input and utf8 output, to avoid converting
3374      * to/from code points */
3375     bool utf8_has_been_setup = FALSE;
3376
3377     dVAR;
3378
3379     U8 *pat = (U8*)STRING(text_node);
3380
3381     if (OP(text_node) == EXACT) {
3382
3383         /* In an exact node, only one thing can be matched, that first
3384          * character.  If both the pat and the target are UTF-8, we can just
3385          * copy the input to the output, avoiding finding the code point of
3386          * that character */
3387         if (! UTF_PATTERN) {
3388             c2 = c1 = *pat;
3389         }
3390         else if (utf8_target) {
3391             Copy(pat, c1_utf8, UTF8SKIP(pat), U8);
3392             Copy(pat, c2_utf8, UTF8SKIP(pat), U8);
3393             utf8_has_been_setup = TRUE;
3394         }
3395         else {
3396             c2 = c1 = valid_utf8_to_uvchr(pat, NULL);
3397         }
3398     }
3399     else /* an EXACTFish node */
3400          if ((UTF_PATTERN
3401                     && is_MULTI_CHAR_FOLD_utf8_safe(pat,
3402                                                     pat + STR_LEN(text_node)))
3403              || (! UTF_PATTERN
3404                     && is_MULTI_CHAR_FOLD_latin1_safe(pat,
3405                                                     pat + STR_LEN(text_node))))
3406     {
3407         /* Multi-character folds require more context to sort out.  Also
3408          * PL_utf8_foldclosures used below doesn't handle them, so have to be
3409          * handled outside this routine */
3410         use_chrtest_void = TRUE;
3411     }
3412     else { /* an EXACTFish node which doesn't begin with a multi-char fold */
3413         c1 = (UTF_PATTERN) ? valid_utf8_to_uvchr(pat, NULL) : *pat;
3414         if (c1 > 256) {
3415             /* Load the folds hash, if not already done */
3416             SV** listp;
3417             if (! PL_utf8_foldclosures) {
3418                 if (! PL_utf8_tofold) {
3419                     U8 dummy[UTF8_MAXBYTES+1];
3420
3421                     /* Force loading this by folding an above-Latin1 char */
3422                     to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL);
3423                     assert(PL_utf8_tofold); /* Verify that worked */
3424                 }
3425                 PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold);
3426             }
3427
3428             /* The fold closures data structure is a hash with the keys being
3429              * the UTF-8 of every character that is folded to, like 'k', and
3430              * the values each an array of all code points that fold to its
3431              * key.  e.g. [ 'k', 'K', KELVIN_SIGN ].  Multi-character folds are
3432              * not included */
3433             if ((! (listp = hv_fetch(PL_utf8_foldclosures,
3434                                      (char *) pat,
3435                                      UTF8SKIP(pat),
3436                                      FALSE))))
3437             {
3438                 /* Not found in the hash, therefore there are no folds
3439                  * containing it, so there is only a single character that
3440                  * could match */
3441                 c2 = c1;
3442             }
3443             else {  /* Does participate in folds */
3444                 AV* list = (AV*) *listp;
3445                 if (av_len(list) != 1) {
3446
3447                     /* If there aren't exactly two folds to this, it is outside
3448                      * the scope of this function */
3449                     use_chrtest_void = TRUE;
3450                 }
3451                 else {  /* There are two.  Get them */
3452                     SV** c_p = av_fetch(list, 0, FALSE);
3453                     if (c_p == NULL) {
3454                         Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
3455                     }
3456                     c1 = SvUV(*c_p);
3457
3458                     c_p = av_fetch(list, 1, FALSE);
3459                     if (c_p == NULL) {
3460                         Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
3461                     }
3462                     c2 = SvUV(*c_p);
3463
3464                     /* Folds that cross the 255/256 boundary are forbidden if
3465                      * EXACTFL, or EXACTFA and one is ASCIII.  Since the
3466                      * pattern character is above 256, and its only other match
3467                      * is below 256, the only legal match will be to itself.
3468                      * We have thrown away the original, so have to compute
3469                      * which is the one above 255 */
3470                     if ((c1 < 256) != (c2 < 256)) {
3471                         if (OP(text_node) == EXACTFL
3472                             || (OP(text_node) == EXACTFA
3473                                 && (isASCII(c1) || isASCII(c2))))
3474                         {
3475                             if (c1 < 256) {
3476                                 c1 = c2;
3477                             }
3478                             else {
3479                                 c2 = c1;
3480                             }
3481                         }
3482                     }
3483                 }
3484             }
3485         }
3486         else /* Here, c1 is < 255 */
3487              if (utf8_target
3488                  && HAS_NONLATIN1_FOLD_CLOSURE(c1)
3489                  && OP(text_node) != EXACTFL
3490                  && (OP(text_node) != EXACTFA || ! isASCII(c1)))
3491         {
3492             /* Here, there could be something above Latin1 in the target which
3493              * folds to this character in the pattern.  All such cases except
3494              * LATIN SMALL LETTER Y WITH DIAERESIS have more than two characters
3495              * involved in their folds, so are outside the scope of this
3496              * function */
3497             if (UNLIKELY(c1 == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
3498                 c2 = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS;
3499             }
3500             else {
3501                 use_chrtest_void = TRUE;
3502             }
3503         }
3504         else { /* Here nothing above Latin1 can fold to the pattern character */
3505             switch (OP(text_node)) {
3506
3507                 case EXACTFL:   /* /l rules */
3508                     c2 = PL_fold_locale[c1];
3509                     break;
3510
3511                 case EXACTF:
3512                     if (! utf8_target) {    /* /d rules */
3513                         c2 = PL_fold[c1];
3514                         break;
3515                     }
3516                     /* FALLTHROUGH */
3517                     /* /u rules for all these.  This happens to work for
3518                      * EXACTFA as nothing in Latin1 folds to ASCII */
3519                 case EXACTFA:
3520                 case EXACTFU_TRICKYFOLD:
3521                 case EXACTFU_SS:
3522                 case EXACTFU:
3523                     c2 = PL_fold_latin1[c1];
3524                     break;
3525
3526                 default:
3527                     Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node));
3528                     assert(0); /* NOTREACHED */
3529             }
3530         }
3531     }
3532
3533     /* Here have figured things out.  Set up the returns */
3534     if (use_chrtest_void) {
3535         *c2p = *c1p = CHRTEST_VOID;
3536     }
3537     else if (utf8_target) {
3538         if (! utf8_has_been_setup) {    /* Don't have the utf8; must get it */
3539             uvchr_to_utf8(c1_utf8, c1);
3540             uvchr_to_utf8(c2_utf8, c2);
3541         }
3542
3543         /* Invariants are stored in both the utf8 and byte outputs; Use
3544          * negative numbers otherwise for the byte ones.  Make sure that the
3545          * byte ones are the same iff the utf8 ones are the same */
3546         *c1p = (UTF8_IS_INVARIANT(*c1_utf8)) ? *c1_utf8 : CHRTEST_NOT_A_CP_1;
3547         *c2p = (UTF8_IS_INVARIANT(*c2_utf8))
3548                 ? *c2_utf8
3549                 : (c1 == c2)
3550                   ? CHRTEST_NOT_A_CP_1
3551                   : CHRTEST_NOT_A_CP_2;
3552     }
3553     else if (c1 > 255) {
3554        if (c2 > 255) {  /* both possibilities are above what a non-utf8 string
3555                            can represent */
3556            return FALSE;
3557        }
3558
3559        *c1p = *c2p = c2;    /* c2 is the only representable value */
3560     }
3561     else {  /* c1 is representable; see about c2 */
3562        *c1p = c1;
3563        *c2p = (c2 < 256) ? c2 : c1;
3564     }
3565
3566     return TRUE;
3567 }
3568
3569 /* returns -1 on failure, $+[0] on success */
3570 STATIC I32
3571 S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
3572 {
3573 #if PERL_VERSION < 9 && !defined(PERL_CORE)
3574     dMY_CXT;
3575 #endif
3576     dVAR;
3577     const bool utf8_target = PL_reg_match_utf8;
3578     const U32 uniflags = UTF8_ALLOW_DEFAULT;
3579     REGEXP *rex_sv = reginfo->prog;
3580     regexp *rex = ReANY(rex_sv);
3581     RXi_GET_DECL(rex,rexi);
3582     I32 oldsave;
3583     /* the current state. This is a cached copy of PL_regmatch_state */
3584     regmatch_state *st;
3585     /* cache heavy used fields of st in registers */
3586     regnode *scan;
3587     regnode *next;
3588     U32 n = 0;  /* general value; init to avoid compiler warning */
3589     I32 ln = 0; /* len or last;  init to avoid compiler warning */
3590     char *locinput = startpos;
3591     char *pushinput; /* where to continue after a PUSH */
3592     I32 nextchr;   /* is always set to UCHARAT(locinput) */
3593
3594     bool result = 0;        /* return value of S_regmatch */
3595     int depth = 0;          /* depth of backtrack stack */
3596     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
3597     const U32 max_nochange_depth =
3598         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
3599         3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
3600     regmatch_state *yes_state = NULL; /* state to pop to on success of
3601                                                             subpattern */
3602     /* mark_state piggy backs on the yes_state logic so that when we unwind 
3603        the stack on success we can update the mark_state as we go */
3604     regmatch_state *mark_state = NULL; /* last mark state we have seen */
3605     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
3606     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
3607     U32 state_num;
3608     bool no_final = 0;      /* prevent failure from backtracking? */
3609     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
3610     char *startpoint = locinput;
3611     SV *popmark = NULL;     /* are we looking for a mark? */
3612     SV *sv_commit = NULL;   /* last mark name seen in failure */
3613     SV *sv_yes_mark = NULL; /* last mark name we have seen 
3614                                during a successful match */
3615     U32 lastopen = 0;       /* last open we saw */
3616     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;   
3617     SV* const oreplsv = GvSV(PL_replgv);
3618     /* these three flags are set by various ops to signal information to
3619      * the very next op. They have a useful lifetime of exactly one loop
3620      * iteration, and are not preserved or restored by state pushes/pops
3621      */
3622     bool sw = 0;            /* the condition value in (?(cond)a|b) */
3623     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
3624     int logical = 0;        /* the following EVAL is:
3625                                 0: (?{...})
3626                                 1: (?(?{...})X|Y)
3627                                 2: (??{...})
3628                                or the following IFMATCH/UNLESSM is:
3629                                 false: plain (?=foo)
3630                                 true:  used as a condition: (?(?=foo))
3631                             */
3632     PAD* last_pad = NULL;
3633     dMULTICALL;
3634     I32 gimme = G_SCALAR;
3635     CV *caller_cv = NULL;       /* who called us */
3636     CV *last_pushed_cv = NULL;  /* most recently called (?{}) CV */
3637     CHECKPOINT runops_cp;       /* savestack position before executing EVAL */
3638     U32 maxopenparen = 0;       /* max '(' index seen so far */
3639
3640 #ifdef DEBUGGING
3641     GET_RE_DEBUG_FLAGS_DECL;
3642 #endif
3643
3644     /* shut up 'may be used uninitialized' compiler warnings for dMULTICALL */
3645     multicall_oldcatch = 0;
3646     multicall_cv = NULL;
3647     cx = NULL;
3648     PERL_UNUSED_VAR(multicall_cop);
3649     PERL_UNUSED_VAR(newsp);
3650
3651
3652     PERL_ARGS_ASSERT_REGMATCH;
3653
3654     DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
3655             PerlIO_printf(Perl_debug_log,"regmatch start\n");
3656     }));
3657     /* on first ever call to regmatch, allocate first slab */
3658     if (!PL_regmatch_slab) {
3659         Newx(PL_regmatch_slab, 1, regmatch_slab);
3660         PL_regmatch_slab->prev = NULL;
3661         PL_regmatch_slab->next = NULL;
3662         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
3663     }
3664
3665     oldsave = PL_savestack_ix;
3666     SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
3667     SAVEVPTR(PL_regmatch_slab);
3668     SAVEVPTR(PL_regmatch_state);
3669
3670     /* grab next free state slot */
3671     st = ++PL_regmatch_state;
3672     if (st >  SLAB_LAST(PL_regmatch_slab))
3673         st = PL_regmatch_state = S_push_slab(aTHX);
3674
3675     /* Note that nextchr is a byte even in UTF */
3676     SET_nextchr;
3677     scan = prog;
3678     while (scan != NULL) {
3679
3680         DEBUG_EXECUTE_r( {
3681             SV * const prop = sv_newmortal();
3682             regnode *rnext=regnext(scan);
3683             DUMP_EXEC_POS( locinput, scan, utf8_target );
3684             regprop(rex, prop, scan);
3685             
3686             PerlIO_printf(Perl_debug_log,
3687                     "%3"IVdf":%*s%s(%"IVdf")\n",
3688                     (IV)(scan - rexi->program), depth*2, "",
3689                     SvPVX_const(prop),
3690                     (PL_regkind[OP(scan)] == END || !rnext) ? 
3691                         0 : (IV)(rnext - rexi->program));
3692         });
3693
3694         next = scan + NEXT_OFF(scan);
3695         if (next == scan)
3696             next = NULL;
3697         state_num = OP(scan);
3698
3699       reenter_switch:
3700
3701         SET_nextchr;
3702         assert(nextchr < 256 && (nextchr >= 0 || nextchr == NEXTCHR_EOS));
3703
3704         switch (state_num) {
3705         case BOL: /*  /^../  */
3706             if (locinput == PL_bostr)
3707             {
3708                 /* reginfo->till = reginfo->bol; */
3709                 break;
3710             }
3711             sayNO;
3712
3713         case MBOL: /*  /^../m  */
3714             if (locinput == PL_bostr ||
3715                 (!NEXTCHR_IS_EOS && locinput[-1] == '\n'))
3716             {
3717                 break;
3718             }
3719             sayNO;
3720
3721         case SBOL: /*  /^../s  */
3722             if (locinput == PL_bostr)
3723                 break;
3724             sayNO;
3725
3726         case GPOS: /*  \G  */
3727             if (locinput == reginfo->ganch)
3728                 break;
3729             sayNO;
3730
3731         case KEEPS: /*   \K  */
3732             /* update the startpoint */
3733             st->u.keeper.val = rex->offs[0].start;
3734             rex->offs[0].start = locinput - PL_bostr;
3735             PUSH_STATE_GOTO(KEEPS_next, next, locinput);
3736             assert(0); /*NOTREACHED*/
3737         case KEEPS_next_fail:
3738             /* rollback the start point change */
3739             rex->offs[0].start = st->u.keeper.val;
3740             sayNO_SILENT;
3741             assert(0); /*NOTREACHED*/
3742
3743         case EOL: /* /..$/  */
3744                 goto seol;
3745
3746         case MEOL: /* /..$/m  */
3747             if (!NEXTCHR_IS_EOS && nextchr != '\n')
3748                 sayNO;
3749             break;
3750
3751         case SEOL: /* /..$/s  */
3752           seol:
3753             if (!NEXTCHR_IS_EOS && nextchr != '\n')
3754                 sayNO;
3755             if (PL_regeol - locinput > 1)
3756                 sayNO;
3757             break;
3758
3759         case EOS: /*  \z  */
3760             if (!NEXTCHR_IS_EOS)
3761                 sayNO;
3762             break;
3763
3764         case SANY: /*  /./s  */
3765             if (NEXTCHR_IS_EOS)
3766                 sayNO;
3767             goto increment_locinput;
3768
3769         case CANY: /*  \C  */
3770             if (NEXTCHR_IS_EOS)
3771                 sayNO;
3772             locinput++;
3773             break;
3774
3775         case REG_ANY: /*  /./  */
3776             if ((NEXTCHR_IS_EOS) || nextchr == '\n')
3777                 sayNO;
3778             goto increment_locinput;
3779
3780
3781 #undef  ST
3782 #define ST st->u.trie
3783         case TRIEC: /* (ab|cd) with known charclass */
3784             /* In this case the charclass data is available inline so
3785                we can fail fast without a lot of extra overhead. 
3786              */
3787             if(!NEXTCHR_IS_EOS && !ANYOF_BITMAP_TEST(scan, nextchr)) {
3788                 DEBUG_EXECUTE_r(
3789                     PerlIO_printf(Perl_debug_log,
3790                               "%*s  %sfailed to match trie start class...%s\n",
3791                               REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3792                 );
3793                 sayNO_SILENT;
3794                 assert(0); /* NOTREACHED */
3795             }
3796             /* FALL THROUGH */
3797         case TRIE:  /* (ab|cd)  */
3798             /* the basic plan of execution of the trie is:
3799              * At the beginning, run though all the states, and
3800              * find the longest-matching word. Also remember the position
3801              * of the shortest matching word. For example, this pattern:
3802              *    1  2 3 4    5
3803              *    ab|a|x|abcd|abc
3804              * when matched against the string "abcde", will generate
3805              * accept states for all words except 3, with the longest
3806              * matching word being 4, and the shortest being 2 (with
3807              * the position being after char 1 of the string).
3808              *
3809              * Then for each matching word, in word order (i.e. 1,2,4,5),
3810              * we run the remainder of the pattern; on each try setting
3811              * the current position to the character following the word,
3812              * returning to try the next word on failure.
3813              *
3814              * We avoid having to build a list of words at runtime by
3815              * using a compile-time structure, wordinfo[].prev, which
3816              * gives, for each word, the previous accepting word (if any).
3817              * In the case above it would contain the mappings 1->2, 2->0,
3818              * 3->0, 4->5, 5->1.  We can use this table to generate, from
3819              * the longest word (4 above), a list of all words, by
3820              * following the list of prev pointers; this gives us the
3821              * unordered list 4,5,1,2. Then given the current word we have
3822              * just tried, we can go through the list and find the
3823              * next-biggest word to try (so if we just failed on word 2,
3824              * the next in the list is 4).
3825              *
3826              * Since at runtime we don't record the matching position in
3827              * the string for each word, we have to work that out for
3828              * each word we're about to process. The wordinfo table holds
3829              * the character length of each word; given that we recorded
3830              * at the start: the position of the shortest word and its
3831              * length in chars, we just need to move the pointer the
3832              * difference between the two char lengths. Depending on
3833              * Unicode status and folding, that's cheap or expensive.
3834              *
3835              * This algorithm is optimised for the case where are only a
3836              * small number of accept states, i.e. 0,1, or maybe 2.
3837              * With lots of accepts states, and having to try all of them,
3838              * it becomes quadratic on number of accept states to find all
3839              * the next words.
3840              */
3841
3842             {
3843                 /* what type of TRIE am I? (utf8 makes this contextual) */
3844                 DECL_TRIE_TYPE(scan);
3845
3846                 /* what trie are we using right now */
3847                 reg_trie_data * const trie
3848                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
3849                 HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]);
3850                 U32 state = trie->startstate;
3851
3852                 if (   trie->bitmap
3853                     && (NEXTCHR_IS_EOS || !TRIE_BITMAP_TEST(trie, nextchr)))
3854                 {
3855                     if (trie->states[ state ].wordnum) {
3856                          DEBUG_EXECUTE_r(
3857                             PerlIO_printf(Perl_debug_log,
3858                                           "%*s  %smatched empty string...%s\n",
3859                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3860                         );
3861                         if (!trie->jump)
3862                             break;
3863                     } else {
3864                         DEBUG_EXECUTE_r(
3865                             PerlIO_printf(Perl_debug_log,
3866                                           "%*s  %sfailed to match trie start class...%s\n",
3867                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3868                         );
3869                         sayNO_SILENT;
3870                    }
3871                 }
3872
3873             { 
3874                 U8 *uc = ( U8* )locinput;
3875
3876                 STRLEN len = 0;
3877                 STRLEN foldlen = 0;
3878                 U8 *uscan = (U8*)NULL;
3879                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
3880                 U32 charcount = 0; /* how many input chars we have matched */
3881                 U32 accepted = 0; /* have we seen any accepting states? */
3882
3883                 ST.jump = trie->jump;
3884                 ST.me = scan;
3885                 ST.firstpos = NULL;
3886                 ST.longfold = FALSE; /* char longer if folded => it's harder */
3887                 ST.nextword = 0;
3888
3889                 /* fully traverse the TRIE; note the position of the
3890                    shortest accept state and the wordnum of the longest
3891                    accept state */
3892
3893                 while ( state && uc <= (U8*)PL_regeol ) {
3894                     U32 base = trie->states[ state ].trans.base;
3895                     UV uvc = 0;
3896                     U16 charid = 0;
3897                     U16 wordnum;
3898                     wordnum = trie->states[ state ].wordnum;
3899
3900                     if (wordnum) { /* it's an accept state */
3901                         if (!accepted) {
3902                             accepted = 1;
3903                             /* record first match position */
3904                             if (ST.longfold) {
3905                                 ST.firstpos = (U8*)locinput;
3906                                 ST.firstchars = 0;
3907                             }
3908                             else {
3909                                 ST.firstpos = uc;
3910                                 ST.firstchars = charcount;
3911                             }
3912                         }
3913                         if (!ST.nextword || wordnum < ST.nextword)
3914                             ST.nextword = wordnum;
3915                         ST.topword = wordnum;
3916                     }
3917
3918                     DEBUG_TRIE_EXECUTE_r({
3919                                 DUMP_EXEC_POS( (char *)uc, scan, utf8_target );
3920                          &