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