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