regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  * "One Ring to rule them all, One Ring to find them..."
   6  */
   7
   8 /* This file contains functions for executing a regular expression.  See
   9  * also regcomp.c which funnily enough, contains functions for compiling
  10  * a regular expression.
  11  *
  12  * This file is also copied at build time to ext/re/re_exec.c, where
  13  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
  14  * This causes the main functions to be compiled under new names and with
  15  * debugging support added, which makes "use re 'debug'" work.
  16  */
  17
  18 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  19  * confused with the original package (see point 3 below).  Thanks, Henry!
  20  */
  21
  22 /* Additional note: this code is very heavily munged from Henry's version
  23  * in places.  In some spots I've traded clarity for efficiency, so don't
  24  * blame Henry for some of the lack of readability.
  25  */
  26
  27 /* The names of the functions have been changed from regcomp and
  28  * regexec to  pregcomp and pregexec in order to avoid conflicts
  29  * with the POSIX routines of the same names.
  30 */
  31
  32 #ifdef PERL_EXT_RE_BUILD
  33 #include "re_top.h"
  34 #endif
  35
  36 /*
  37  * pregcomp and pregexec -- regsub and regerror are not used in perl
  38  *
  39  *      Copyright (c) 1986 by University of Toronto.
  40  *      Written by Henry Spencer.  Not derived from licensed software.
  41  *
  42  *      Permission is granted to anyone to use this software for any
  43  *      purpose on any computer system, and to redistribute it freely,
  44  *      subject to the following restrictions:
  45  *
  46  *      1. The author is not responsible for the consequences of use of
  47  *              this software, no matter how awful, even if they arise
  48  *              from defects in it.
  49  *
  50  *      2. The origin of this software must not be misrepresented, either
  51  *              by explicit claim or by omission.
  52  *
  53  *      3. Altered versions must be plainly marked as such, and must not
  54  *              be misrepresented as being the original software.
  55  *
  56  ****    Alterations to Henry's code are...
  57  ****
  58  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  59  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  60  ****
  61  ****    You may distribute under the terms of either the GNU General Public
  62  ****    License or the Artistic License, as specified in the README file.
  63  *
  64  * Beware that some of this code is subtly aware of the way operator
  65  * precedence is structured in regular expressions.  Serious changes in
  66  * regular-expression syntax might require a total rethink.
  67  */
  68 #include "EXTERN.h"
  69 #define PERL_IN_REGEXEC_C
  70 #include "perl.h"
  71
  72 #ifdef PERL_IN_XSUB_RE
  73 #  include "re_comp.h"
  74 #else
  75 #  include "regcomp.h"
  76 #endif
  77
  78 #define RF_tainted      1               /* tainted information used? */
  79 #define RF_warned       2               /* warned about big count? */
  80
  81 #define RF_utf8         8               /* Pattern contains multibyte chars? */
  82
  83 #define UTF ((PL_reg_flags & RF_utf8) != 0)
  84
  85 #define RS_init         1               /* eval environment created */
  86 #define RS_set          2               /* replsv value is set */
  87
  88 #ifndef STATIC
  89 #define STATIC  static
  90 #endif
  91
  92 #define REGINCLASS(prog,p,c)  (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
  93
  94 /*
  95  * Forwards.
  96  */
  97
  98 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
  99 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 100
 101 #define HOPc(pos,off) \
 102         (char *)(PL_reg_match_utf8 \
 103             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
 104             : (U8*)(pos + off))
 105 #define HOPBACKc(pos, off) \
 106         (char*)(PL_reg_match_utf8\
 107             ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
 108             : (pos - off >= PL_bostr)           \
 109                 ? (U8*)pos - off                \
 110                 : NULL)
 111
 112 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
 113 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 114
 115 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
 116     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
 117 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 118 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
 119 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 120 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
 121
 122 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
 123
 124 /* for use after a quantifier and before an EXACT-like node -- japhy */
 125 /* it would be nice to rework regcomp.sym to generate this stuff. sigh */
 126 #define JUMPABLE(rn) (      \
 127     OP(rn) == OPEN ||       \
 128     (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
 129     OP(rn) == EVAL ||   \
 130     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 131     OP(rn) == PLUS || OP(rn) == MINMOD || \
 132     OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
 133     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
 134 )
 135 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
 136
 137 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
 138
 139 #if 0
 140 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
 141    we don't need this definition. */
 142 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
 143 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  || OP(rn)==REFF  || OP(rn)==NREFF  )
 144 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
 145
 146 #else
 147 /* ... so we use this as its faster. */
 148 #define IS_TEXT(rn)   ( OP(rn)==EXACT   )
 149 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
 150 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
 151
 152 #endif
 153
 154 /*
 155   Search for mandatory following text node; for lookahead, the text must
 156   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 157 */
 158 #define FIND_NEXT_IMPT(rn) STMT_START { \
 159     while (JUMPABLE(rn)) { \
 160         const OPCODE type = OP(rn); \
 161         if (type == SUSPEND || PL_regkind[type] == CURLY) \
 162             rn = NEXTOPER(NEXTOPER(rn)); \
 163         else if (type == PLUS) \
 164             rn = NEXTOPER(rn); \
 165         else if (type == IFMATCH) \
 166             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
 167         else rn += NEXT_OFF(rn); \
 168     } \
 169 } STMT_END
 170
 171
 172 static void restore_pos(pTHX_ void *arg);
 173
 174 STATIC CHECKPOINT
 175 S_regcppush(pTHX_ I32 parenfloor)
 176 {
 177     dVAR;
 178     const int retval = PL_savestack_ix;
 179 #define REGCP_PAREN_ELEMS 4
 180     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 181     int p;
 182     GET_RE_DEBUG_FLAGS_DECL;
 183
 184     if (paren_elems_to_push < 0)
 185         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 186
 187 #define REGCP_OTHER_ELEMS 7
 188     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
 189
 190     for (p = PL_regsize; p > parenfloor; p--) {
 191 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 192         SSPUSHINT(PL_regoffs[p].end);
 193         SSPUSHINT(PL_regoffs[p].start);
 194         SSPUSHPTR(PL_reg_start_tmp[p]);
 195         SSPUSHINT(p);
 196         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
 197           "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
 198                       (UV)p, (IV)PL_regoffs[p].start,
 199                       (IV)(PL_reg_start_tmp[p] - PL_bostr),
 200                       (IV)PL_regoffs[p].end
 201         ));
 202     }
 203 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 204     SSPUSHPTR(PL_regoffs);
 205     SSPUSHINT(PL_regsize);
 206     SSPUSHINT(*PL_reglastparen);
 207     SSPUSHINT(*PL_reglastcloseparen);
 208     SSPUSHPTR(PL_reginput);
 209 #define REGCP_FRAME_ELEMS 2
 210 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
 211  * are needed for the regexp context stack bookkeeping. */
 212     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 213     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
 214
 215     return retval;
 216 }
 217
 218 /* These are needed since we do not localize EVAL nodes: */
 219 #define REGCP_SET(cp)                                           \
 220     DEBUG_STATE_r(                                              \
 221             PerlIO_printf(Perl_debug_log,                       \
 222                 "  Setting an EVAL scope, savestack=%"IVdf"\n", \
 223                 (IV)PL_savestack_ix));                          \
 224     cp = PL_savestack_ix
 225
 226 #define REGCP_UNWIND(cp)                                        \
 227     DEBUG_STATE_r(                                              \
 228         if (cp != PL_savestack_ix)                              \
 229             PerlIO_printf(Perl_debug_log,                       \
 230                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 231                 (IV)(cp), (IV)PL_savestack_ix));                \
 232     regcpblow(cp)
 233
 234 STATIC char *
 235 S_regcppop(pTHX_ const regexp *rex)
 236 {
 237     dVAR;
 238     U32 i;
 239     char *input;
 240
 241     GET_RE_DEBUG_FLAGS_DECL;
 242
 243     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 244     i = SSPOPINT;
 245     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 246     i = SSPOPINT; /* Parentheses elements to pop. */
 247     input = (char *) SSPOPPTR;
 248     *PL_reglastcloseparen = SSPOPINT;
 249     *PL_reglastparen = SSPOPINT;
 250     PL_regsize = SSPOPINT;
 251     PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
 252
 253
 254     /* Now restore the parentheses context. */
 255     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 256          i > 0; i -= REGCP_PAREN_ELEMS) {
 257         I32 tmps;
 258         U32 paren = (U32)SSPOPINT;
 259         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 260         PL_regoffs[paren].start = SSPOPINT;
 261         tmps = SSPOPINT;
 262         if (paren <= *PL_reglastparen)
 263             PL_regoffs[paren].end = tmps;
 264         DEBUG_BUFFERS_r(
 265             PerlIO_printf(Perl_debug_log,
 266                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 267                           (UV)paren, (IV)PL_regoffs[paren].start,
 268                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 269                           (IV)PL_regoffs[paren].end,
 270                           (paren > *PL_reglastparen ? "(no)" : ""));
 271         );
 272     }
 273     DEBUG_BUFFERS_r(
 274         if (*PL_reglastparen + 1 <= rex->nparens) {
 275             PerlIO_printf(Perl_debug_log,
 276                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 277                           (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
 278         }
 279     );
 280 #if 1
 281     /* It would seem that the similar code in regtry()
 282      * already takes care of this, and in fact it is in
 283      * a better location to since this code can #if 0-ed out
 284      * but the code in regtry() is needed or otherwise tests
 285      * requiring null fields (pat.t#187 and split.t#{13,14}
 286      * (as of patchlevel 7877)  will fail.  Then again,
 287      * this code seems to be necessary or otherwise
 288      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
 289      * --jhi updated by dapm */
 290     for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
 291         if (i > PL_regsize)
 292             PL_regoffs[i].start = -1;
 293         PL_regoffs[i].end = -1;
 294     }
 295 #endif
 296     return input;
 297 }
 298
 299 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 300
 301 /*
 302  * pregexec and friends
 303  */
 304
 305 #ifndef PERL_IN_XSUB_RE
 306 /*
 307  - pregexec - match a regexp against a string
 308  */
 309 I32
 310 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
 311          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 312 /* strend: pointer to null at end of string */
 313 /* strbeg: real beginning of string */
 314 /* minend: end of match must be >=minend after stringarg. */
 315 /* nosave: For optimizations. */
 316 {
 317     return
 318         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 319                       nosave ? 0 : REXEC_COPY_STR);
 320 }
 321 #endif
 322
 323 /*
 324  * Need to implement the following flags for reg_anch:
 325  *
 326  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 327  * USE_INTUIT_ML
 328  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 329  * INTUIT_AUTORITATIVE_ML
 330  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 331  * INTUIT_ONCE_ML
 332  *
 333  * Another flag for this function: SECOND_TIME (so that float substrs
 334  * with giant delta may be not rechecked).
 335  */
 336
 337 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 338
 339 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
 340    Otherwise, only SvCUR(sv) is used to get strbeg. */
 341
 342 /* XXXX We assume that strpos is strbeg unless sv. */
 343
 344 /* XXXX Some places assume that there is a fixed substring.
 345         An update may be needed if optimizer marks as "INTUITable"
 346         RExen without fixed substrings.  Similarly, it is assumed that
 347         lengths of all the strings are no more than minlen, thus they
 348         cannot come from lookahead.
 349         (Or minlen should take into account lookahead.)
 350   NOTE: Some of this comment is not correct. minlen does now take account
 351   of lookahead/behind. Further research is required. -- demerphq
 352
 353 */
 354
 355 /* A failure to find a constant substring means that there is no need to make
 356    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 357    finding a substring too deep into the string means that less calls to
 358    regtry() should be needed.
 359
 360    REx compiler's optimizer found 4 possible hints:
 361         a) Anchored substring;
 362         b) Fixed substring;
 363         c) Whether we are anchored (beginning-of-line or \G);
 364         d) First node (of those at offset 0) which may distingush positions;
 365    We use a)b)d) and multiline-part of c), and try to find a position in the
 366    string which does not contradict any of them.
 367  */
 368
 369 /* Most of decisions we do here should have been done at compile time.
 370    The nodes of the REx which we used for the search should have been
 371    deleted from the finite automaton. */
 372
 373 char *
 374 Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 375                      char *strend, const U32 flags, re_scream_pos_data *data)
 376 {
 377     dVAR;
 378     struct regexp *const prog = (struct regexp *)SvANY(rx);
 379     register I32 start_shift = 0;
 380     /* Should be nonnegative! */
 381     register I32 end_shift   = 0;
 382     register char *s;
 383     register SV *check;
 384     char *strbeg;
 385     char *t;
 386     const bool do_utf8 = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
 387     I32 ml_anch;
 388     register char *other_last = NULL;   /* other substr checked before this */
 389     char *check_at = NULL;              /* check substr found at this pos */
 390     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
 391     RXi_GET_DECL(prog,progi);
 392 #ifdef DEBUGGING
 393     const char * const i_strpos = strpos;
 394 #endif
 395
 396     GET_RE_DEBUG_FLAGS_DECL;
 397
 398     RX_MATCH_UTF8_set(rx,do_utf8);
 399
 400     if (prog->extflags & RXf_UTF8) {
 401         PL_reg_flags |= RF_utf8;
 402     }
 403     DEBUG_EXECUTE_r(
 404         debug_start_match(rx, do_utf8, strpos, strend,
 405             sv ? "Guessing start of match in sv for"
 406                : "Guessing start of match in string for");
 407               );
 408
 409     /* CHR_DIST() would be more correct here but it makes things slow. */
 410     if (prog->minlen > strend - strpos) {
 411         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 412                               "String too short... [re_intuit_start]\n"));
 413         goto fail;
 414     }
 415
 416     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
 417     PL_regeol = strend;
 418     if (do_utf8) {
 419         if (!prog->check_utf8 && prog->check_substr)
 420             to_utf8_substr(prog);
 421         check = prog->check_utf8;
 422     } else {
 423         if (!prog->check_substr && prog->check_utf8)
 424             to_byte_substr(prog);
 425         check = prog->check_substr;
 426     }
 427     if (check == &PL_sv_undef) {
 428         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 429                 "Non-utf8 string cannot match utf8 check string\n"));
 430         goto fail;
 431     }
 432     if (prog->extflags & RXf_ANCH) {    /* Match at beg-of-str or after \n */
 433         ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
 434                      || ( (prog->extflags & RXf_ANCH_BOL)
 435                           && !multiline ) );    /* Check after \n? */
 436
 437         if (!ml_anch) {
 438           if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
 439                 && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
 440                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
 441                && sv && !SvROK(sv)
 442                && (strpos != strbeg)) {
 443               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 444               goto fail;
 445           }
 446           if (prog->check_offset_min == prog->check_offset_max &&
 447               !(prog->extflags & RXf_CANY_SEEN)) {
 448             /* Substring at constant offset from beg-of-str... */
 449             I32 slen;
 450
 451             s = HOP3c(strpos, prog->check_offset_min, strend);
 452
 453             if (SvTAIL(check)) {
 454                 slen = SvCUR(check);    /* >= 1 */
 455
 456                 if ( strend - s > slen || strend - s < slen - 1
 457                      || (strend - s == slen && strend[-1] != '\n')) {
 458                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 459                     goto fail_finish;
 460                 }
 461                 /* Now should match s[0..slen-2] */
 462                 slen--;
 463                 if (slen && (*SvPVX_const(check) != *s
 464                              || (slen > 1
 465                                  && memNE(SvPVX_const(check), s, slen)))) {
 466                   report_neq:
 467                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 468                     goto fail_finish;
 469                 }
 470             }
 471             else if (*SvPVX_const(check) != *s
 472                      || ((slen = SvCUR(check)) > 1
 473                          && memNE(SvPVX_const(check), s, slen)))
 474                 goto report_neq;
 475             check_at = s;
 476             goto success_at_start;
 477           }
 478         }
 479         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 480         s = strpos;
 481         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 482         end_shift = prog->check_end_shift;
 483
 484         if (!ml_anch) {
 485             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
 486                                          - (SvTAIL(check) != 0);
 487             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
 488
 489             if (end_shift < eshift)
 490                 end_shift = eshift;
 491         }
 492     }
 493     else {                              /* Can match at random position */
 494         ml_anch = 0;
 495         s = strpos;
 496         start_shift = prog->check_offset_min;  /* okay to underestimate on CC */
 497         end_shift = prog->check_end_shift;
 498
 499         /* end shift should be non negative here */
 500     }
 501
 502 #ifdef QDEBUGGING       /* 7/99: reports of failure (with the older version) */
 503     if (end_shift < 0)
 504         Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
 505                    (IV)end_shift, RX_PRECOMP(prog));
 506 #endif
 507
 508   restart:
 509     /* Find a possible match in the region s..strend by looking for
 510        the "check" substring in the region corrected by start/end_shift. */
 511
 512     {
 513         I32 srch_start_shift = start_shift;
 514         I32 srch_end_shift = end_shift;
 515         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
 516             srch_end_shift -= ((strbeg - s) - srch_start_shift);
 517             srch_start_shift = strbeg - s;
 518         }
 519     DEBUG_OPTIMISE_MORE_r({
 520         PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
 521             (IV)prog->check_offset_min,
 522             (IV)srch_start_shift,
 523             (IV)srch_end_shift,
 524             (IV)prog->check_end_shift);
 525     });
 526
 527     if (flags & REXEC_SCREAM) {
 528         I32 p = -1;                     /* Internal iterator of scream. */
 529         I32 * const pp = data ? data->scream_pos : &p;
 530
 531         if (PL_screamfirst[BmRARE(check)] >= 0
 532             || ( BmRARE(check) == '\n'
 533                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 534                  && SvTAIL(check) ))
 535             s = screaminstr(sv, check,
 536                             srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
 537         else
 538             goto fail_finish;
 539         /* we may be pointing at the wrong string */
 540         if (s && RXp_MATCH_COPIED(prog))
 541             s = strbeg + (s - SvPVX_const(sv));
 542         if (data)
 543             *data->scream_olds = s;
 544     }
 545     else {
 546         U8* start_point;
 547         U8* end_point;
 548         if (prog->extflags & RXf_CANY_SEEN) {
 549             start_point= (U8*)(s + srch_start_shift);
 550             end_point= (U8*)(strend - srch_end_shift);
 551         } else {
 552             start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
 553             end_point= HOP3(strend, -srch_end_shift, strbeg);
 554         }
 555         DEBUG_OPTIMISE_MORE_r({
 556             PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n",
 557                 (int)(end_point - start_point),
 558                 (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point),
 559                 start_point);
 560         });
 561
 562         s = fbm_instr( start_point, end_point,
 563                       check, multiline ? FBMrf_MULTILINE : 0);
 564     }
 565     }
 566     /* Update the count-of-usability, remove useless subpatterns,
 567         unshift s.  */
 568
 569     DEBUG_EXECUTE_r({
 570         RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 571             SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
 572         PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
 573                           (s ? "Found" : "Did not find"),
 574             (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)
 575                 ? "anchored" : "floating"),
 576             quoted,
 577             RE_SV_TAIL(check),
 578             (s ? " at offset " : "...\n") );
 579     });
 580
 581     if (!s)
 582         goto fail_finish;
 583     /* Finish the diagnostic message */
 584     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 585
 586     /* XXX dmq: first branch is for positive lookbehind...
 587        Our check string is offset from the beginning of the pattern.
 588        So we need to do any stclass tests offset forward from that
 589        point. I think. :-(
 590      */
 591
 592
 593
 594     check_at=s;
 595
 596
 597     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 598        Start with the other substr.
 599        XXXX no SCREAM optimization yet - and a very coarse implementation
 600        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
 601                 *always* match.  Probably should be marked during compile...
 602        Probably it is right to do no SCREAM here...
 603      */
 604
 605     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8)
 606                 : (prog->float_substr && prog->anchored_substr))
 607     {
 608         /* Take into account the "other" substring. */
 609         /* XXXX May be hopelessly wrong for UTF... */
 610         if (!other_last)
 611             other_last = strpos;
 612         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
 613           do_other_anchored:
 614             {
 615                 char * const last = HOP3c(s, -start_shift, strbeg);
 616                 char *last1, *last2;
 617                 char * const saved_s = s;
 618                 SV* must;
 619
 620                 t = s - prog->check_offset_max;
 621                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 622                     && (!do_utf8
 623                         || ((t = (char*)reghopmaybe3((U8*)s, -(prog->check_offset_max), (U8*)strpos))
 624                             && t > strpos)))
 625                     NOOP;
 626                 else
 627                     t = strpos;
 628                 t = HOP3c(t, prog->anchored_offset, strend);
 629                 if (t < other_last)     /* These positions already checked */
 630                     t = other_last;
 631                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
 632                 if (last < last1)
 633                     last1 = last;
 634                 /* XXXX It is not documented what units *_offsets are in.
 635                    We assume bytes, but this is clearly wrong.
 636                    Meaning this code needs to be carefully reviewed for errors.
 637                    dmq.
 638                   */
 639
 640                 /* On end-of-str: see comment below. */
 641                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
 642                 if (must == &PL_sv_undef) {
 643                     s = (char*)NULL;
 644                     DEBUG_r(must = prog->anchored_utf8);        /* for debug */
 645                 }
 646                 else
 647                     s = fbm_instr(
 648                         (unsigned char*)t,
 649                         HOP3(HOP3(last1, prog->anchored_offset, strend)
 650                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
 651                         must,
 652                         multiline ? FBMrf_MULTILINE : 0
 653                     );
 654                 DEBUG_EXECUTE_r({
 655                     RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 656                         SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 657                     PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
 658                         (s ? "Found" : "Contradicts"),
 659                         quoted, RE_SV_TAIL(must));
 660                 });
 661
 662
 663                 if (!s) {
 664                     if (last1 >= last2) {
 665                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 666                                                 ", giving up...\n"));
 667                         goto fail_finish;
 668                     }
 669                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 670                         ", trying floating at offset %ld...\n",
 671                         (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
 672                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
 673                     s = HOP3c(last, 1, strend);
 674                     goto restart;
 675                 }
 676                 else {
 677                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 678                           (long)(s - i_strpos)));
 679                     t = HOP3c(s, -prog->anchored_offset, strbeg);
 680                     other_last = HOP3c(s, 1, strend);
 681                     s = saved_s;
 682                     if (t == strpos)
 683                         goto try_at_start;
 684                     goto try_at_offset;
 685                 }
 686             }
 687         }
 688         else {          /* Take into account the floating substring. */
 689             char *last, *last1;
 690             char * const saved_s = s;
 691             SV* must;
 692
 693             t = HOP3c(s, -start_shift, strbeg);
 694             last1 = last =
 695                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
 696             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
 697                 last = HOP3c(t, prog->float_max_offset, strend);
 698             s = HOP3c(t, prog->float_min_offset, strend);
 699             if (s < other_last)
 700                 s = other_last;
 701  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 702             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
 703             /* fbm_instr() takes into account exact value of end-of-str
 704                if the check is SvTAIL(ed).  Since false positives are OK,
 705                and end-of-str is not later than strend we are OK. */
 706             if (must == &PL_sv_undef) {
 707                 s = (char*)NULL;
 708                 DEBUG_r(must = prog->float_utf8);       /* for debug message */
 709             }
 710             else
 711                 s = fbm_instr((unsigned char*)s,
 712                               (unsigned char*)last + SvCUR(must)
 713                                   - (SvTAIL(must)!=0),
 714                               must, multiline ? FBMrf_MULTILINE : 0);
 715             DEBUG_EXECUTE_r({
 716                 RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 717                     SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 718                 PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
 719                     (s ? "Found" : "Contradicts"),
 720                     quoted, RE_SV_TAIL(must));
 721             });
 722             if (!s) {
 723                 if (last1 == last) {
 724                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 725                                             ", giving up...\n"));
 726                     goto fail_finish;
 727                 }
 728                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 729                     ", trying anchored starting at offset %ld...\n",
 730                     (long)(saved_s + 1 - i_strpos)));
 731                 other_last = last;
 732                 s = HOP3c(t, 1, strend);
 733                 goto restart;
 734             }
 735             else {
 736                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 737                       (long)(s - i_strpos)));
 738                 other_last = s; /* Fix this later. --Hugo */
 739                 s = saved_s;
 740                 if (t == strpos)
 741                     goto try_at_start;
 742                 goto try_at_offset;
 743             }
 744         }
 745     }
 746
 747
 748     t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
 749
 750     DEBUG_OPTIMISE_MORE_r(
 751         PerlIO_printf(Perl_debug_log,
 752             "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
 753             (IV)prog->check_offset_min,
 754             (IV)prog->check_offset_max,
 755             (IV)(s-strpos),
 756             (IV)(t-strpos),
 757             (IV)(t-s),
 758             (IV)(strend-strpos)
 759         )
 760     );
 761
 762     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 763         && (!do_utf8
 764             || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
 765                  && t > strpos)))
 766     {
 767         /* Fixed substring is found far enough so that the match
 768            cannot start at strpos. */
 769       try_at_offset:
 770         if (ml_anch && t[-1] != '\n') {
 771             /* Eventually fbm_*() should handle this, but often
 772                anchored_offset is not 0, so this check will not be wasted. */
 773             /* XXXX In the code below we prefer to look for "^" even in
 774                presence of anchored substrings.  And we search even
 775                beyond the found float position.  These pessimizations
 776                are historical artefacts only.  */
 777           find_anchor:
 778             while (t < strend - prog->minlen) {
 779                 if (*t == '\n') {
 780                     if (t < check_at - prog->check_offset_min) {
 781                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
 782                             /* Since we moved from the found position,
 783                                we definitely contradict the found anchored
 784                                substr.  Due to the above check we do not
 785                                contradict "check" substr.
 786                                Thus we can arrive here only if check substr
 787                                is float.  Redo checking for "other"=="fixed".
 788                              */
 789                             strpos = t + 1;
 790                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
 791                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
 792                             goto do_other_anchored;
 793                         }
 794                         /* We don't contradict the found floating substring. */
 795                         /* XXXX Why not check for STCLASS? */
 796                         s = t + 1;
 797                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 798                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
 799                         goto set_useful;
 800                     }
 801                     /* Position contradicts check-string */
 802                     /* XXXX probably better to look for check-string
 803                        than for "\n", so one should lower the limit for t? */
 804                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
 805                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
 806                     other_last = strpos = s = t + 1;
 807                     goto restart;
 808                 }
 809                 t++;
 810             }
 811             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 812                         PL_colors[0], PL_colors[1]));
 813             goto fail_finish;
 814         }
 815         else {
 816             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
 817                         PL_colors[0], PL_colors[1]));
 818         }
 819         s = t;
 820       set_useful:
 821         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
 822     }
 823     else {
 824         /* The found string does not prohibit matching at strpos,
 825            - no optimization of calling REx engine can be performed,
 826            unless it was an MBOL and we are not after MBOL,
 827            or a future STCLASS check will fail this. */
 828       try_at_start:
 829         /* Even in this situation we may use MBOL flag if strpos is offset
 830            wrt the start of the string. */
 831         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
 832             && (strpos != strbeg) && strpos[-1] != '\n'
 833             /* May be due to an implicit anchor of m{.*foo}  */
 834             && !(prog->intflags & PREGf_IMPLICIT))
 835         {
 836             t = strpos;
 837             goto find_anchor;
 838         }
 839         DEBUG_EXECUTE_r( if (ml_anch)
 840             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
 841                           (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
 842         );
 843       success_at_start:
 844         if (!(prog->intflags & PREGf_NAUGHTY)   /* XXXX If strpos moved? */
 845             && (do_utf8 ? (
 846                 prog->check_utf8                /* Could be deleted already */
 847                 && --BmUSEFUL(prog->check_utf8) < 0
 848                 && (prog->check_utf8 == prog->float_utf8)
 849             ) : (
 850                 prog->check_substr              /* Could be deleted already */
 851                 && --BmUSEFUL(prog->check_substr) < 0
 852                 && (prog->check_substr == prog->float_substr)
 853             )))
 854         {
 855             /* If flags & SOMETHING - do not do it many times on the same match */
 856             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
 857             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
 858             if (do_utf8 ? prog->check_substr : prog->check_utf8)
 859                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
 860             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
 861             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
 862             check = NULL;                       /* abort */
 863             s = strpos;
 864             /* XXXX This is a remnant of the old implementation.  It
 865                     looks wasteful, since now INTUIT can use many
 866                     other heuristics. */
 867             prog->extflags &= ~RXf_USE_INTUIT;
 868         }
 869         else
 870             s = strpos;
 871     }
 872
 873     /* Last resort... */
 874     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
 875     /* trie stclasses are too expensive to use here, we are better off to
 876        leave it to regmatch itself */
 877     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
 878         /* minlen == 0 is possible if regstclass is \b or \B,
 879            and the fixed substr is ''$.
 880            Since minlen is already taken into account, s+1 is before strend;
 881            accidentally, minlen >= 1 guaranties no false positives at s + 1
 882            even for \b or \B.  But (minlen? 1 : 0) below assumes that
 883            regstclass does not come from lookahead...  */
 884         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
 885            This leaves EXACTF only, which is dealt with in find_byclass().  */
 886         const U8* const str = (U8*)STRING(progi->regstclass);
 887         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
 888                     ? CHR_DIST(str+STR_LEN(progi->regstclass), str)
 889                     : 1);
 890         char * endpos;
 891         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
 892             endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
 893         else if (prog->float_substr || prog->float_utf8)
 894             endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
 895         else
 896             endpos= strend;
 897
 898         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" s: %"IVdf" endpos: %"IVdf"\n",
 899                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg)));
 900
 901         t = s;
 902         s = find_byclass(prog, progi->regstclass, s, endpos, NULL);
 903         if (!s) {
 904 #ifdef DEBUGGING
 905             const char *what = NULL;
 906 #endif
 907             if (endpos == strend) {
 908                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 909                                 "Could not match STCLASS...\n") );
 910                 goto fail;
 911             }
 912             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 913                                    "This position contradicts STCLASS...\n") );
 914             if ((prog->extflags & RXf_ANCH) && !ml_anch)
 915                 goto fail;
 916             /* Contradict one of substrings */
 917             if (prog->anchored_substr || prog->anchored_utf8) {
 918                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
 919                     DEBUG_EXECUTE_r( what = "anchored" );
 920                   hop_and_restart:
 921                     s = HOP3c(t, 1, strend);
 922                     if (s + start_shift + end_shift > strend) {
 923                         /* XXXX Should be taken into account earlier? */
 924                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 925                                                "Could not match STCLASS...\n") );
 926                         goto fail;
 927                     }
 928                     if (!check)
 929                         goto giveup;
 930                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 931                                 "Looking for %s substr starting at offset %ld...\n",
 932                                  what, (long)(s + start_shift - i_strpos)) );
 933                     goto restart;
 934                 }
 935                 /* Have both, check_string is floating */
 936                 if (t + start_shift >= check_at) /* Contradicts floating=check */
 937                     goto retry_floating_check;
 938                 /* Recheck anchored substring, but not floating... */
 939                 s = check_at;
 940                 if (!check)
 941                     goto giveup;
 942                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 943                           "Looking for anchored substr starting at offset %ld...\n",
 944                           (long)(other_last - i_strpos)) );
 945                 goto do_other_anchored;
 946             }
 947             /* Another way we could have checked stclass at the
 948                current position only: */
 949             if (ml_anch) {
 950                 s = t = t + 1;
 951                 if (!check)
 952                     goto giveup;
 953                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 954                           "Looking for /%s^%s/m starting at offset %ld...\n",
 955                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
 956                 goto try_at_offset;
 957             }
 958             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
 959                 goto fail;
 960             /* Check is floating subtring. */
 961           retry_floating_check:
 962             t = check_at - start_shift;
 963             DEBUG_EXECUTE_r( what = "floating" );
 964             goto hop_and_restart;
 965         }
 966         if (t != s) {
 967             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 968                         "By STCLASS: moving %ld --> %ld\n",
 969                                   (long)(t - i_strpos), (long)(s - i_strpos))
 970                    );
 971         }
 972         else {
 973             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 974                                   "Does not contradict STCLASS...\n");
 975                    );
 976         }
 977     }
 978   giveup:
 979     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
 980                           PL_colors[4], (check ? "Guessed" : "Giving up"),
 981                           PL_colors[5], (long)(s - i_strpos)) );
 982     return s;
 983
 984   fail_finish:                          /* Substring not found */
 985     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
 986         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
 987   fail:
 988     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 989                           PL_colors[4], PL_colors[5]));
 990     return NULL;
 991 }
 992
 993 #define DECL_TRIE_TYPE(scan) \
 994     const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold } \
 995                     trie_type = (scan->flags != EXACT) \
 996                               ? (do_utf8 ? trie_utf8_fold : (UTF ? trie_latin_utf8_fold : trie_plain)) \
 997                               : (do_utf8 ? trie_utf8 : trie_plain)
 998
 999 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
1000 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
1001     switch (trie_type) {                                                    \
1002     case trie_utf8_fold:                                                    \
1003         if ( foldlen>0 ) {                                                  \
1004             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
1005             foldlen -= len;                                                 \
1006             uscan += len;                                                   \
1007             len=0;                                                          \
1008         } else {                                                            \
1009             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );   \
1010             uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
1011             foldlen -= UNISKIP( uvc );                                      \
1012             uscan = foldbuf + UNISKIP( uvc );                               \
1013         }                                                                   \
1014         break;                                                              \
1015     case trie_latin_utf8_fold:                                              \
1016         if ( foldlen>0 ) {                                                  \
1017             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
1018             foldlen -= len;                                                 \
1019             uscan += len;                                                   \
1020             len=0;                                                          \
1021         } else {                                                            \
1022             len = 1;                                                        \
1023             uvc = to_uni_fold( *(U8*)uc, foldbuf, &foldlen );               \
1024             foldlen -= UNISKIP( uvc );                                      \
1025             uscan = foldbuf + UNISKIP( uvc );                               \
1026         }                                                                   \
1027         break;                                                              \
1028     case trie_utf8:                                                         \
1029         uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );       \
1030         break;                                                              \
1031     case trie_plain:                                                        \
1032         uvc = (UV)*uc;                                                      \
1033         len = 1;                                                            \
1034     }                                                                       \
1035                                                                             \
1036     if (uvc < 256) {                                                        \
1037         charid = trie->charmap[ uvc ];                                      \
1038     }                                                                       \
1039     else {                                                                  \
1040         charid = 0;                                                         \
1041         if (widecharmap) {                                                  \
1042             SV** const svpp = hv_fetch(widecharmap,                         \
1043                         (char*)&uvc, sizeof(UV), 0);                        \
1044             if (svpp)                                                       \
1045                 charid = (U16)SvIV(*svpp);                                  \
1046         }                                                                   \
1047     }                                                                       \
1048 } STMT_END
1049
1050 #define REXEC_FBC_EXACTISH_CHECK(CoNd)                 \
1051 {                                                      \
1052     char *my_strend= (char *)strend;                   \
1053     if ( (CoNd)                                        \
1054          && (ln == len ||                              \
1055              !ibcmp_utf8(s, &my_strend, 0,  do_utf8,   \
1056                         m, NULL, ln, (bool)UTF))       \
1057          && (!reginfo || regtry(reginfo, &s)) )        \
1058         goto got_it;                                   \
1059     else {                                             \
1060          U8 foldbuf[UTF8_MAXBYTES_CASE+1];             \
1061          uvchr_to_utf8(tmpbuf, c);                     \
1062          f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);  \
1063          if ( f != c                                   \
1064               && (f == c1 || f == c2)                  \
1065               && (ln == len ||                         \
1066                 !ibcmp_utf8(s, &my_strend, 0,  do_utf8,\
1067                               m, NULL, ln, (bool)UTF)) \
1068               && (!reginfo || regtry(reginfo, &s)) )   \
1069               goto got_it;                             \
1070     }                                                  \
1071 }                                                      \
1072 s += len
1073
1074 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
1075 STMT_START {                                              \
1076     while (s <= e) {                                      \
1077         if ( (CoNd)                                       \
1078              && (ln == 1 || !(OP(c) == EXACTF             \
1079                               ? ibcmp(s, m, ln)           \
1080                               : ibcmp_locale(s, m, ln)))  \
1081              && (!reginfo || regtry(reginfo, &s)) )        \
1082             goto got_it;                                  \
1083         s++;                                              \
1084     }                                                     \
1085 } STMT_END
1086
1087 #define REXEC_FBC_UTF8_SCAN(CoDe)                     \
1088 STMT_START {                                          \
1089     while (s + (uskip = UTF8SKIP(s)) <= strend) {     \
1090         CoDe                                          \
1091         s += uskip;                                   \
1092     }                                                 \
1093 } STMT_END
1094
1095 #define REXEC_FBC_SCAN(CoDe)                          \
1096 STMT_START {                                          \
1097     while (s < strend) {                              \
1098         CoDe                                          \
1099         s++;                                          \
1100     }                                                 \
1101 } STMT_END
1102
1103 #define REXEC_FBC_UTF8_CLASS_SCAN(CoNd)               \
1104 REXEC_FBC_UTF8_SCAN(                                  \
1105     if (CoNd) {                                       \
1106         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1107             goto got_it;                              \
1108         else                                          \
1109             tmp = doevery;                            \
1110     }                                                 \
1111     else                                              \
1112         tmp = 1;                                      \
1113 )
1114
1115 #define REXEC_FBC_CLASS_SCAN(CoNd)                    \
1116 REXEC_FBC_SCAN(                                       \
1117     if (CoNd) {                                       \
1118         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1119             goto got_it;                              \
1120         else                                          \
1121             tmp = doevery;                            \
1122     }                                                 \
1123     else                                              \
1124         tmp = 1;                                      \
1125 )
1126
1127 #define REXEC_FBC_TRYIT               \
1128 if ((!reginfo || regtry(reginfo, &s))) \
1129     goto got_it
1130
1131 #define REXEC_FBC_CSCAN(CoNdUtF8,CoNd)                         \
1132     if (do_utf8) {                                             \
1133         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1134     }                                                          \
1135     else {                                                     \
1136         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1137     }                                                          \
1138     break
1139
1140 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
1141     if (do_utf8) {                                             \
1142         UtFpReLoAd;                                            \
1143         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1144     }                                                          \
1145     else {                                                     \
1146         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1147     }                                                          \
1148     break
1149
1150 #define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd)                   \
1151     PL_reg_flags |= RF_tainted;                                \
1152     if (do_utf8) {                                             \
1153         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1154     }                                                          \
1155     else {                                                     \
1156         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1157     }                                                          \
1158     break
1159
1160 #define DUMP_EXEC_POS(li,s,doutf8) \
1161     dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
1162
1163 /* We know what class REx starts with.  Try to find this position... */
1164 /* if reginfo is NULL, its a dryrun */
1165 /* annoyingly all the vars in this routine have different names from their counterparts
1166    in regmatch. /grrr */
1167
1168 STATIC char *
1169 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
1170     const char *strend, regmatch_info *reginfo)
1171 {
1172         dVAR;
1173         const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
1174         char *m;
1175         STRLEN ln;
1176         STRLEN lnc;
1177         register STRLEN uskip;
1178         unsigned int c1;
1179         unsigned int c2;
1180         char *e;
1181         register I32 tmp = 1;   /* Scratch variable? */
1182         register const bool do_utf8 = PL_reg_match_utf8;
1183         RXi_GET_DECL(prog,progi);
1184
1185         /* We know what class it must start with. */
1186         switch (OP(c)) {
1187         case ANYOF:
1188             if (do_utf8) {
1189                  REXEC_FBC_UTF8_CLASS_SCAN((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
1190                           !UTF8_IS_INVARIANT((U8)s[0]) ?
1191                           reginclass(prog, c, (U8*)s, 0, do_utf8) :
1192                           REGINCLASS(prog, c, (U8*)s));
1193             }
1194             else {
1195                  while (s < strend) {
1196                       STRLEN skip = 1;
1197
1198                       if (REGINCLASS(prog, c, (U8*)s) ||
1199                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1200                            /* The assignment of 2 is intentional:
1201                             * for the folded sharp s, the skip is 2. */
1202                            (skip = SHARP_S_SKIP))) {
1203                            if (tmp && (!reginfo || regtry(reginfo, &s)))
1204                                 goto got_it;
1205                            else
1206                                 tmp = doevery;
1207                       }
1208                       else
1209                            tmp = 1;
1210                       s += skip;
1211                  }
1212             }
1213             break;
1214         case CANY:
1215             REXEC_FBC_SCAN(
1216                 if (tmp && (!reginfo || regtry(reginfo, &s)))
1217                     goto got_it;
1218                 else
1219                     tmp = doevery;
1220             );
1221             break;
1222         case EXACTF:
1223             m   = STRING(c);
1224             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1225             lnc = (I32) ln;     /* length to match in characters */
1226             if (UTF) {
1227                 STRLEN ulen1, ulen2;
1228                 U8 *sm = (U8 *) m;
1229                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1230                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1231                 /* used by commented-out code below */
1232                 /*const U32 uniflags = UTF8_ALLOW_DEFAULT;*/
1233
1234                 /* XXX: Since the node will be case folded at compile
1235                    time this logic is a little odd, although im not
1236                    sure that its actually wrong. --dmq */
1237
1238                 c1 = to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1239                 c2 = to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1240
1241                 /* XXX: This is kinda strange. to_utf8_XYZ returns the
1242                    codepoint of the first character in the converted
1243                    form, yet originally we did the extra step.
1244                    No tests fail by commenting this code out however
1245                    so Ive left it out. -- dmq.
1246
1247                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE,
1248                                     0, uniflags);
1249                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1250                                     0, uniflags);
1251                 */
1252
1253                 lnc = 0;
1254                 while (sm < ((U8 *) m + ln)) {
1255                     lnc++;
1256                     sm += UTF8SKIP(sm);
1257                 }
1258             }
1259             else {
1260                 c1 = *(U8*)m;
1261                 c2 = PL_fold[c1];
1262             }
1263             goto do_exactf;
1264         case EXACTFL:
1265             m   = STRING(c);
1266             ln  = STR_LEN(c);
1267             lnc = (I32) ln;
1268             c1 = *(U8*)m;
1269             c2 = PL_fold_locale[c1];
1270           do_exactf:
1271             e = HOP3c(strend, -((I32)lnc), s);
1272
1273             if (!reginfo && e < s)
1274                 e = s;                  /* Due to minlen logic of intuit() */
1275
1276             /* The idea in the EXACTF* cases is to first find the
1277              * first character of the EXACTF* node and then, if
1278              * necessary, case-insensitively compare the full
1279              * text of the node.  The c1 and c2 are the first
1280              * characters (though in Unicode it gets a bit
1281              * more complicated because there are more cases
1282              * than just upper and lower: one needs to use
1283              * the so-called folding case for case-insensitive
1284              * matching (called "loose matching" in Unicode).
1285              * ibcmp_utf8() will do just that. */
1286
1287             if (do_utf8 || UTF) {
1288                 UV c, f;
1289                 U8 tmpbuf [UTF8_MAXBYTES+1];
1290                 STRLEN len = 1;
1291                 STRLEN foldlen;
1292                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1293                 if (c1 == c2) {
1294                     /* Upper and lower of 1st char are equal -
1295                      * probably not a "letter". */
1296                     while (s <= e) {
1297                         if (do_utf8) {
1298                             c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1299                                            uniflags);
1300                         } else {
1301                             c = *((U8*)s);
1302                         }
1303                         REXEC_FBC_EXACTISH_CHECK(c == c1);
1304                     }
1305                 }
1306                 else {
1307                     while (s <= e) {
1308                         if (do_utf8) {
1309                             c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1310                                            uniflags);
1311                         } else {
1312                             c = *((U8*)s);
1313                         }
1314
1315                         /* Handle some of the three Greek sigmas cases.
1316                          * Note that not all the possible combinations
1317                          * are handled here: some of them are handled
1318                          * by the standard folding rules, and some of
1319                          * them (the character class or ANYOF cases)
1320                          * are handled during compiletime in
1321                          * regexec.c:S_regclass(). */
1322                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1323                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1324                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1325
1326                         REXEC_FBC_EXACTISH_CHECK(c == c1 || c == c2);
1327                     }
1328                 }
1329             }
1330             else {
1331                 /* Neither pattern nor string are UTF8 */
1332                 if (c1 == c2)
1333                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
1334                 else
1335                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
1336             }
1337             break;
1338         case BOUNDL:
1339             PL_reg_flags |= RF_tainted;
1340             /* FALL THROUGH */
1341         case BOUND:
1342             if (do_utf8) {
1343                 if (s == PL_bostr)
1344                     tmp = '\n';
1345                 else {
1346                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1347                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1348                 }
1349                 tmp = ((OP(c) == BOUND ?
1350                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1351                 LOAD_UTF8_CHARCLASS_ALNUM();
1352                 REXEC_FBC_UTF8_SCAN(
1353                     if (tmp == !(OP(c) == BOUND ?
1354                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1355                                  isALNUM_LC_utf8((U8*)s)))
1356                     {
1357                         tmp = !tmp;
1358                         REXEC_FBC_TRYIT;
1359                 }
1360                 );
1361             }
1362             else {
1363                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1364                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1365                 REXEC_FBC_SCAN(
1366                     if (tmp ==
1367                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1368                         tmp = !tmp;
1369                         REXEC_FBC_TRYIT;
1370                 }
1371                 );
1372             }
1373             if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s)))
1374                 goto got_it;
1375             break;
1376         case NBOUNDL:
1377             PL_reg_flags |= RF_tainted;
1378             /* FALL THROUGH */
1379         case NBOUND:
1380             if (do_utf8) {
1381                 if (s == PL_bostr)
1382                     tmp = '\n';
1383                 else {
1384                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1385                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1386                 }
1387                 tmp = ((OP(c) == NBOUND ?
1388                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1389                 LOAD_UTF8_CHARCLASS_ALNUM();
1390                 REXEC_FBC_UTF8_SCAN(
1391                     if (tmp == !(OP(c) == NBOUND ?
1392                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1393                                  isALNUM_LC_utf8((U8*)s)))
1394                         tmp = !tmp;
1395                     else REXEC_FBC_TRYIT;
1396                 );
1397             }
1398             else {
1399                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1400                 tmp = ((OP(c) == NBOUND ?
1401                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1402                 REXEC_FBC_SCAN(
1403                     if (tmp ==
1404                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1405                         tmp = !tmp;
1406                     else REXEC_FBC_TRYIT;
1407                 );
1408             }
1409             if ((!prog->minlen && !tmp) && (!reginfo || regtry(reginfo, &s)))
1410                 goto got_it;
1411             break;
1412         case ALNUM:
1413             REXEC_FBC_CSCAN_PRELOAD(
1414                 LOAD_UTF8_CHARCLASS_ALNUM(),
1415                 swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1416                 isALNUM(*s)
1417             );
1418         case ALNUML:
1419             REXEC_FBC_CSCAN_TAINT(
1420                 isALNUM_LC_utf8((U8*)s),
1421                 isALNUM_LC(*s)
1422             );
1423         case NALNUM:
1424             REXEC_FBC_CSCAN_PRELOAD(
1425                 LOAD_UTF8_CHARCLASS_ALNUM(),
1426                 !swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1427                 !isALNUM(*s)
1428             );
1429         case NALNUML:
1430             REXEC_FBC_CSCAN_TAINT(
1431                 !isALNUM_LC_utf8((U8*)s),
1432                 !isALNUM_LC(*s)
1433             );
1434         case SPACE:
1435             REXEC_FBC_CSCAN_PRELOAD(
1436                 LOAD_UTF8_CHARCLASS_SPACE(),
1437                 *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8),
1438                 isSPACE(*s)
1439             );
1440         case SPACEL:
1441             REXEC_FBC_CSCAN_TAINT(
1442                 *s == ' ' || isSPACE_LC_utf8((U8*)s),
1443                 isSPACE_LC(*s)
1444             );
1445         case NSPACE:
1446             REXEC_FBC_CSCAN_PRELOAD(
1447                 LOAD_UTF8_CHARCLASS_SPACE(),
1448                 !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)),
1449                 !isSPACE(*s)
1450             );
1451         case NSPACEL:
1452             REXEC_FBC_CSCAN_TAINT(
1453                 !(*s == ' ' || isSPACE_LC_utf8((U8*)s)),
1454                 !isSPACE_LC(*s)
1455             );
1456         case DIGIT:
1457             REXEC_FBC_CSCAN_PRELOAD(
1458                 LOAD_UTF8_CHARCLASS_DIGIT(),
1459                 swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1460                 isDIGIT(*s)
1461             );
1462         case DIGITL:
1463             REXEC_FBC_CSCAN_TAINT(
1464                 isDIGIT_LC_utf8((U8*)s),
1465                 isDIGIT_LC(*s)
1466             );
1467         case NDIGIT:
1468             REXEC_FBC_CSCAN_PRELOAD(
1469                 LOAD_UTF8_CHARCLASS_DIGIT(),
1470                 !swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1471                 !isDIGIT(*s)
1472             );
1473         case NDIGITL:
1474             REXEC_FBC_CSCAN_TAINT(
1475                 !isDIGIT_LC_utf8((U8*)s),
1476                 !isDIGIT_LC(*s)
1477             );
1478         case LNBREAK:
1479             REXEC_FBC_CSCAN(
1480                 is_LNBREAK_utf8(s),
1481                 is_LNBREAK_latin1(s)
1482             );
1483         case VERTWS:
1484             REXEC_FBC_CSCAN(
1485                 is_VERTWS_utf8(s),
1486                 is_VERTWS_latin1(s)
1487             );
1488         case NVERTWS:
1489             REXEC_FBC_CSCAN(
1490                 !is_VERTWS_utf8(s),
1491                 !is_VERTWS_latin1(s)
1492             );
1493         case HORIZWS:
1494             REXEC_FBC_CSCAN(
1495                 is_HORIZWS_utf8(s),
1496                 is_HORIZWS_latin1(s)
1497             );
1498         case NHORIZWS:
1499             REXEC_FBC_CSCAN(
1500                 !is_HORIZWS_utf8(s),
1501                 !is_HORIZWS_latin1(s)
1502             );
1503         case AHOCORASICKC:
1504         case AHOCORASICK:
1505             {
1506                 DECL_TRIE_TYPE(c);
1507                 /* what trie are we using right now */
1508                 reg_ac_data *aho
1509                     = (reg_ac_data*)progi->data->data[ ARG( c ) ];
1510                 reg_trie_data *trie
1511                     = (reg_trie_data*)progi->data->data[ aho->trie ];
1512                 HV *widecharmap = (HV*) progi->data->data[ aho->trie + 1 ];
1513
1514                 const char *last_start = strend - trie->minlen;
1515 #ifdef DEBUGGING
1516                 const char *real_start = s;
1517 #endif
1518                 STRLEN maxlen = trie->maxlen;
1519                 SV *sv_points;
1520                 U8 **points; /* map of where we were in the input string
1521                                 when reading a given char. For ASCII this
1522                                 is unnecessary overhead as the relationship
1523                                 is always 1:1, but for Unicode, especially
1524                                 case folded Unicode this is not true. */
1525                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1526                 U8 *bitmap=NULL;
1527
1528
1529                 GET_RE_DEBUG_FLAGS_DECL;
1530
1531                 /* We can't just allocate points here. We need to wrap it in
1532                  * an SV so it gets freed properly if there is a croak while
1533                  * running the match */
1534                 ENTER;
1535                 SAVETMPS;
1536                 sv_points=newSV(maxlen * sizeof(U8 *));
1537                 SvCUR_set(sv_points,
1538                     maxlen * sizeof(U8 *));
1539                 SvPOK_on(sv_points);
1540                 sv_2mortal(sv_points);
1541                 points=(U8**)SvPV_nolen(sv_points );
1542                 if ( trie_type != trie_utf8_fold
1543                      && (trie->bitmap || OP(c)==AHOCORASICKC) )
1544                 {
1545                     if (trie->bitmap)
1546                         bitmap=(U8*)trie->bitmap;
1547                     else
1548                         bitmap=(U8*)ANYOF_BITMAP(c);
1549                 }
1550                 /* this is the Aho-Corasick algorithm modified a touch
1551                    to include special handling for long "unknown char"
1552                    sequences. The basic idea being that we use AC as long
1553                    as we are dealing with a possible matching char, when
1554                    we encounter an unknown char (and we have not encountered
1555                    an accepting state) we scan forward until we find a legal
1556                    starting char.
1557                    AC matching is basically that of trie matching, except
1558                    that when we encounter a failing transition, we fall back
1559                    to the current states "fail state", and try the current char
1560                    again, a process we repeat until we reach the root state,
1561                    state 1, or a legal transition. If we fail on the root state
1562                    then we can either terminate if we have reached an accepting
1563                    state previously, or restart the entire process from the beginning
1564                    if we have not.
1565
1566                  */
1567                 while (s <= last_start) {
1568                     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1569                     U8 *uc = (U8*)s;
1570                     U16 charid = 0;
1571                     U32 base = 1;
1572                     U32 state = 1;
1573                     UV uvc = 0;
1574                     STRLEN len = 0;
1575                     STRLEN foldlen = 0;
1576                     U8 *uscan = (U8*)NULL;
1577                     U8 *leftmost = NULL;
1578 #ifdef DEBUGGING
1579                     U32 accepted_word= 0;
1580 #endif
1581                     U32 pointpos = 0;
1582
1583                     while ( state && uc <= (U8*)strend ) {
1584                         int failed=0;
1585                         U32 word = aho->states[ state ].wordnum;
1586
1587                         if( state==1 ) {
1588                             if ( bitmap ) {
1589                                 DEBUG_TRIE_EXECUTE_r(
1590                                     if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1591                                         dump_exec_pos( (char *)uc, c, strend, real_start,
1592                                             (char *)uc, do_utf8 );
1593                                         PerlIO_printf( Perl_debug_log,
1594                                             " Scanning for legal start char...\n");
1595                                     }
1596                                 );
1597                                 while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
1598                                     uc++;
1599                                 }
1600                                 s= (char *)uc;
1601                             }
1602                             if (uc >(U8*)last_start) break;
1603                         }
1604
1605                         if ( word ) {
1606                             U8 *lpos= points[ (pointpos - trie->wordlen[word-1] ) % maxlen ];
1607                             if (!leftmost || lpos < leftmost) {
1608                                 DEBUG_r(accepted_word=word);
1609                                 leftmost= lpos;
1610                             }
1611                             if (base==0) break;
1612
1613                         }
1614                         points[pointpos++ % maxlen]= uc;
1615                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
1616                                              uscan, len, uvc, charid, foldlen,
1617                                              foldbuf, uniflags);
1618                         DEBUG_TRIE_EXECUTE_r({
1619                             dump_exec_pos( (char *)uc, c, strend, real_start,
1620                                 s,   do_utf8 );
1621                             PerlIO_printf(Perl_debug_log,
1622                                 " Charid:%3u CP:%4"UVxf" ",
1623                                  charid, uvc);
1624                         });
1625
1626                         do {
1627 #ifdef DEBUGGING
1628                             word = aho->states[ state ].wordnum;
1629 #endif
1630                             base = aho->states[ state ].trans.base;
1631
1632                             DEBUG_TRIE_EXECUTE_r({
1633                                 if (failed)
1634                                     dump_exec_pos( (char *)uc, c, strend, real_start,
1635                                         s,   do_utf8 );
1636                                 PerlIO_printf( Perl_debug_log,
1637                                     "%sState: %4"UVxf", word=%"UVxf,
1638                                     failed ? " Fail transition to " : "",
1639                                     (UV)state, (UV)word);
1640                             });
1641                             if ( base ) {
1642                                 U32 tmp;
1643                                 if (charid &&
1644                                      (base + charid > trie->uniquecharcount )
1645                                      && (base + charid - 1 - trie->uniquecharcount
1646                                             < trie->lasttrans)
1647                                      && trie->trans[base + charid - 1 -
1648                                             trie->uniquecharcount].check == state
1649                                      && (tmp=trie->trans[base + charid - 1 -
1650                                         trie->uniquecharcount ].next))
1651                                 {
1652                                     DEBUG_TRIE_EXECUTE_r(
1653                                         PerlIO_printf( Perl_debug_log," - legal\n"));
1654                                     state = tmp;
1655                                     break;
1656                                 }
1657                                 else {
1658                                     DEBUG_TRIE_EXECUTE_r(
1659                                         PerlIO_printf( Perl_debug_log," - fail\n"));
1660                                     failed = 1;
1661                                     state = aho->fail[state];
1662                                 }
1663                             }
1664                             else {
1665                                 /* we must be accepting here */
1666                                 DEBUG_TRIE_EXECUTE_r(
1667                                         PerlIO_printf( Perl_debug_log," - accepting\n"));
1668                                 failed = 1;
1669                                 break;
1670                             }
1671                         } while(state);
1672                         uc += len;
1673                         if (failed) {
1674                             if (leftmost)
1675                                 break;
1676                             if (!state) state = 1;
1677                         }
1678                     }
1679                     if ( aho->states[ state ].wordnum ) {
1680                         U8 *lpos = points[ (pointpos - trie->wordlen[aho->states[ state ].wordnum-1]) % maxlen ];
1681                         if (!leftmost || lpos < leftmost) {
1682                             DEBUG_r(accepted_word=aho->states[ state ].wordnum);
1683                             leftmost = lpos;
1684                         }
1685                     }
1686                     if (leftmost) {
1687                         s = (char*)leftmost;
1688                         DEBUG_TRIE_EXECUTE_r({
1689                             PerlIO_printf(
1690                                 Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
1691                                 (UV)accepted_word, (IV)(s - real_start)
1692                             );
1693                         });
1694                         if (!reginfo || regtry(reginfo, &s)) {
1695                             FREETMPS;
1696                             LEAVE;
1697                             goto got_it;
1698                         }
1699                         s = HOPc(s,1);
1700                         DEBUG_TRIE_EXECUTE_r({
1701                             PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
1702                         });
1703                     } else {
1704                         DEBUG_TRIE_EXECUTE_r(
1705                             PerlIO_printf( Perl_debug_log,"No match.\n"));
1706                         break;
1707                     }
1708                 }
1709                 FREETMPS;
1710                 LEAVE;
1711             }
1712             break;
1713         default:
1714             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1715             break;
1716         }
1717         return 0;
1718       got_it:
1719         return s;
1720 }
1721
1722 static void
1723 S_swap_match_buff (pTHX_ regexp *prog) {
1724     regexp_paren_pair *t;
1725
1726     if (!prog->swap) {
1727     /* We have to be careful. If the previous successful match
1728        was from this regex we don't want a subsequent paritally
1729        successful match to clobber the old results.
1730        So when we detect this possibility we add a swap buffer
1731        to the re, and switch the buffer each match. If we fail
1732        we switch it back, otherwise we leave it swapped.
1733     */
1734         Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
1735     }
1736     t = prog->swap;
1737     prog->swap = prog->offs;
1738     prog->offs = t;
1739 }
1740
1741
1742 /*
1743  - regexec_flags - match a regexp against a string
1744  */
1745 I32
1746 Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
1747               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1748 /* strend: pointer to null at end of string */
1749 /* strbeg: real beginning of string */
1750 /* minend: end of match must be >=minend after stringarg. */
1751 /* data: May be used for some additional optimizations.
1752          Currently its only used, with a U32 cast, for transmitting
1753          the ganch offset when doing a /g match. This will change */
1754 /* nosave: For optimizations. */
1755 {
1756     dVAR;
1757     struct regexp *const prog = (struct regexp *)SvANY(rx);
1758     /*register*/ char *s;
1759     register regnode *c;
1760     /*register*/ char *startpos = stringarg;
1761     I32 minlen;         /* must match at least this many chars */
1762     I32 dontbother = 0; /* how many characters not to try at end */
1763     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1764     I32 scream_pos = -1;                /* Internal iterator of scream. */
1765     char *scream_olds = NULL;
1766     const bool do_utf8 = (bool)DO_UTF8(sv);
1767     I32 multiline;
1768     RXi_GET_DECL(prog,progi);
1769     regmatch_info reginfo;  /* create some info to pass to regtry etc */
1770     bool swap_on_fail = 0;
1771
1772     GET_RE_DEBUG_FLAGS_DECL;
1773
1774     PERL_UNUSED_ARG(data);
1775
1776     /* Be paranoid... */
1777     if (prog == NULL || startpos == NULL) {
1778         Perl_croak(aTHX_ "NULL regexp parameter");
1779         return 0;
1780     }
1781
1782     multiline = prog->extflags & RXf_PMf_MULTILINE;
1783     reginfo.prog = rx;   /* Yes, sorry that this is confusing.  */
1784
1785     RX_MATCH_UTF8_set(rx, do_utf8);
1786     DEBUG_EXECUTE_r(
1787         debug_start_match(rx, do_utf8, startpos, strend,
1788         "Matching");
1789     );
1790
1791     minlen = prog->minlen;
1792
1793     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
1794         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1795                               "String too short [regexec_flags]...\n"));
1796         goto phooey;
1797     }
1798
1799
1800     /* Check validity of program. */
1801     if (UCHARAT(progi->program) != REG_MAGIC) {
1802         Perl_croak(aTHX_ "corrupted regexp program");
1803     }
1804
1805     PL_reg_flags = 0;
1806     PL_reg_eval_set = 0;
1807     PL_reg_maxiter = 0;
1808
1809     if (prog->extflags & RXf_UTF8)
1810         PL_reg_flags |= RF_utf8;
1811
1812     /* Mark beginning of line for ^ and lookbehind. */
1813     reginfo.bol = startpos; /* XXX not used ??? */
1814     PL_bostr  = strbeg;
1815     reginfo.sv = sv;
1816
1817     /* Mark end of line for $ (and such) */
1818     PL_regeol = strend;
1819
1820     /* see how far we have to get to not match where we matched before */
1821     reginfo.till = startpos+minend;
1822
1823     /* If there is a "must appear" string, look for it. */
1824     s = startpos;
1825
1826     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
1827         MAGIC *mg;
1828
1829         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1830             reginfo.ganch = startpos + prog->gofs;
1831         else if (sv && SvTYPE(sv) >= SVt_PVMG
1832                   && SvMAGIC(sv)
1833                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1834                   && mg->mg_len >= 0) {
1835             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
1836             if (prog->extflags & RXf_ANCH_GPOS) {
1837                 if (s > reginfo.ganch)
1838                     goto phooey;
1839                 s = reginfo.ganch - prog->gofs;
1840             }
1841         }
1842         else if (data) {
1843             reginfo.ganch = strbeg + PTR2UV(data);
1844         } else                          /* pos() not defined */
1845             reginfo.ganch = strbeg;
1846     }
1847     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
1848         swap_on_fail = 1;
1849         swap_match_buff(prog); /* do we need a save destructor here for
1850                                   eval dies? */
1851     }
1852     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1853         re_scream_pos_data d;
1854
1855         d.scream_olds = &scream_olds;
1856         d.scream_pos = &scream_pos;
1857         s = re_intuit_start(rx, sv, s, strend, flags, &d);
1858         if (!s) {
1859             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1860             goto phooey;        /* not present */
1861         }
1862     }
1863
1864
1865
1866     /* Simplest case:  anchored match need be tried only once. */
1867     /*  [unless only anchor is BOL and multiline is set] */
1868     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
1869         if (s == startpos && regtry(&reginfo, &startpos))
1870             goto got_it;
1871         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
1872                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
1873         {
1874             char *end;
1875
1876             if (minlen)
1877                 dontbother = minlen - 1;
1878             end = HOP3c(strend, -dontbother, strbeg) - 1;
1879             /* for multiline we only have to try after newlines */
1880             if (prog->check_substr || prog->check_utf8) {
1881                 if (s == startpos)
1882                     goto after_try;
1883                 while (1) {
1884                     if (regtry(&reginfo, &s))
1885                         goto got_it;
1886                   after_try:
1887                     if (s > end)
1888                         goto phooey;
1889                     if (prog->extflags & RXf_USE_INTUIT) {
1890                         s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
1891                         if (!s)
1892                             goto phooey;
1893                     }
1894                     else
1895                         s++;
1896                 }
1897             } else {
1898                 if (s > startpos)
1899                     s--;
1900                 while (s < end) {
1901                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1902                         if (regtry(&reginfo, &s))
1903                             goto got_it;
1904                     }
1905                 }
1906             }
1907         }
1908         goto phooey;
1909     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
1910     {
1911         /* the warning about reginfo.ganch being used without intialization
1912            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
1913            and we only enter this block when the same bit is set. */
1914         char *tmp_s = reginfo.ganch - prog->gofs;
1915         if (regtry(&reginfo, &tmp_s))
1916             goto got_it;
1917         goto phooey;
1918     }
1919
1920     /* Messy cases:  unanchored match. */
1921     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
1922         /* we have /x+whatever/ */
1923         /* it must be a one character string (XXXX Except UTF?) */
1924         char ch;
1925 #ifdef DEBUGGING
1926         int did_match = 0;
1927 #endif
1928         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1929             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1930         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1931
1932         if (do_utf8) {
1933             REXEC_FBC_SCAN(
1934                 if (*s == ch) {
1935                     DEBUG_EXECUTE_r( did_match = 1 );
1936                     if (regtry(&reginfo, &s)) goto got_it;
1937                     s += UTF8SKIP(s);
1938                     while (s < strend && *s == ch)
1939                         s += UTF8SKIP(s);
1940                 }
1941             );
1942         }
1943         else {
1944             REXEC_FBC_SCAN(
1945                 if (*s == ch) {
1946                     DEBUG_EXECUTE_r( did_match = 1 );
1947                     if (regtry(&reginfo, &s)) goto got_it;
1948                     s++;
1949                     while (s < strend && *s == ch)
1950                         s++;
1951                 }
1952             );
1953         }
1954         DEBUG_EXECUTE_r(if (!did_match)
1955                 PerlIO_printf(Perl_debug_log,
1956                                   "Did not find anchored character...\n")
1957                );
1958     }
1959     else if (prog->anchored_substr != NULL
1960               || prog->anchored_utf8 != NULL
1961               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1962                   && prog->float_max_offset < strend - s)) {
1963         SV *must;
1964         I32 back_max;
1965         I32 back_min;
1966         char *last;
1967         char *last1;            /* Last position checked before */
1968 #ifdef DEBUGGING
1969         int did_match = 0;
1970 #endif
1971         if (prog->anchored_substr || prog->anchored_utf8) {
1972             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1973                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1974             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1975             back_max = back_min = prog->anchored_offset;
1976         } else {
1977             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1978                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1979             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1980             back_max = prog->float_max_offset;
1981             back_min = prog->float_min_offset;
1982         }
1983
1984
1985         if (must == &PL_sv_undef)
1986             /* could not downgrade utf8 check substring, so must fail */
1987             goto phooey;
1988
1989         if (back_min<0) {
1990             last = strend;
1991         } else {
1992             last = HOP3c(strend,        /* Cannot start after this */
1993                   -(I32)(CHR_SVLEN(must)
1994                          - (SvTAIL(must) != 0) + back_min), strbeg);
1995         }
1996         if (s > PL_bostr)
1997             last1 = HOPc(s, -1);
1998         else
1999             last1 = s - 1;      /* bogus */
2000
2001         /* XXXX check_substr already used to find "s", can optimize if
2002            check_substr==must. */
2003         scream_pos = -1;
2004         dontbother = end_shift;
2005         strend = HOPc(strend, -dontbother);
2006         while ( (s <= last) &&
2007                 ((flags & REXEC_SCREAM)
2008                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
2009                                     end_shift, &scream_pos, 0))
2010                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
2011                                   (unsigned char*)strend, must,
2012                                   multiline ? FBMrf_MULTILINE : 0))) ) {
2013             /* we may be pointing at the wrong string */
2014             if ((flags & REXEC_SCREAM) && RXp_MATCH_COPIED(prog))
2015                 s = strbeg + (s - SvPVX_const(sv));
2016             DEBUG_EXECUTE_r( did_match = 1 );
2017             if (HOPc(s, -back_max) > last1) {
2018                 last1 = HOPc(s, -back_min);
2019                 s = HOPc(s, -back_max);
2020             }
2021             else {
2022                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
2023
2024                 last1 = HOPc(s, -back_min);
2025                 s = t;
2026             }
2027             if (do_utf8) {
2028                 while (s <= last1) {
2029                     if (regtry(&reginfo, &s))
2030                         goto got_it;
2031                     s += UTF8SKIP(s);
2032                 }
2033             }
2034             else {
2035                 while (s <= last1) {
2036                     if (regtry(&reginfo, &s))
2037                         goto got_it;
2038                     s++;
2039                 }
2040             }
2041         }
2042         DEBUG_EXECUTE_r(if (!did_match) {
2043             RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
2044                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
2045             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
2046                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
2047                                ? "anchored" : "floating"),
2048                 quoted, RE_SV_TAIL(must));
2049         });
2050         goto phooey;
2051     }
2052     else if ( (c = progi->regstclass) ) {
2053         if (minlen) {
2054             const OPCODE op = OP(progi->regstclass);
2055             /* don't bother with what can't match */
2056             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
2057                 strend = HOPc(strend, -(minlen - 1));
2058         }
2059         DEBUG_EXECUTE_r({
2060             SV * const prop = sv_newmortal();
2061             regprop(prog, prop, c);
2062             {
2063                 RE_PV_QUOTED_DECL(quoted,do_utf8,PERL_DEBUG_PAD_ZERO(1),
2064                     s,strend-s,60);
2065                 PerlIO_printf(Perl_debug_log,
2066                     "Matching stclass %.*s against %s (%d chars)\n",
2067                     (int)SvCUR(prop), SvPVX_const(prop),
2068                      quoted, (int)(strend - s));
2069             }
2070         });
2071         if (find_byclass(prog, c, s, strend, &reginfo))
2072             goto got_it;
2073         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
2074     }
2075     else {
2076         dontbother = 0;
2077         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2078             /* Trim the end. */
2079             char *last;
2080             SV* float_real;
2081
2082             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
2083                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
2084             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
2085
2086             if (flags & REXEC_SCREAM) {
2087                 last = screaminstr(sv, float_real, s - strbeg,
2088                                    end_shift, &scream_pos, 1); /* last one */
2089                 if (!last)
2090                     last = scream_olds; /* Only one occurrence. */
2091                 /* we may be pointing at the wrong string */
2092                 else if (RXp_MATCH_COPIED(prog))
2093                     s = strbeg + (s - SvPVX_const(sv));
2094             }
2095             else {
2096                 STRLEN len;
2097                 const char * const little = SvPV_const(float_real, len);
2098
2099                 if (SvTAIL(float_real)) {
2100                     if (memEQ(strend - len + 1, little, len - 1))
2101                         last = strend - len + 1;
2102                     else if (!multiline)
2103                         last = memEQ(strend - len, little, len)
2104                             ? strend - len : NULL;
2105                     else
2106                         goto find_last;
2107                 } else {
2108                   find_last:
2109                     if (len)
2110                         last = rninstr(s, strend, little, little + len);
2111                     else
2112                         last = strend;  /* matching "$" */
2113                 }
2114             }
2115             if (last == NULL) {
2116                 DEBUG_EXECUTE_r(
2117                     PerlIO_printf(Perl_debug_log,
2118                         "%sCan't trim the tail, match fails (should not happen)%s\n",
2119                         PL_colors[4], PL_colors[5]));
2120                 goto phooey; /* Should not happen! */
2121             }
2122             dontbother = strend - last + prog->float_min_offset;
2123         }
2124         if (minlen && (dontbother < minlen))
2125             dontbother = minlen - 1;
2126         strend -= dontbother;              /* this one's always in bytes! */
2127         /* We don't know much -- general case. */
2128         if (do_utf8) {
2129             for (;;) {
2130                 if (regtry(&reginfo, &s))
2131                     goto got_it;
2132                 if (s >= strend)
2133                     break;
2134                 s += UTF8SKIP(s);
2135             };
2136         }
2137         else {
2138             do {
2139                 if (regtry(&reginfo, &s))
2140                     goto got_it;
2141             } while (s++ < strend);
2142         }
2143     }
2144
2145     /* Failure. */
2146     goto phooey;
2147
2148 got_it:
2149     RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
2150
2151     if (PL_reg_eval_set)
2152         restore_pos(aTHX_ prog);
2153     if (prog->paren_names)
2154         (void)hv_iterinit(prog->paren_names);
2155
2156     /* make sure $`, $&, $', and $digit will work later */
2157     if ( !(flags & REXEC_NOT_FIRST) ) {
2158         RX_MATCH_COPY_FREE(rx);
2159         if (flags & REXEC_COPY_STR) {
2160             const I32 i = PL_regeol - startpos + (stringarg - strbeg);
2161 #ifdef PERL_OLD_COPY_ON_WRITE
2162             if ((SvIsCOW(sv)
2163                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2164                 if (DEBUG_C_TEST) {
2165                     PerlIO_printf(Perl_debug_log,
2166                                   "Copy on write: regexp capture, type %d\n",
2167                                   (int) SvTYPE(sv));
2168                 }
2169                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2170                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2171                 assert (SvPOKp(prog->saved_copy));
2172             } else
2173 #endif
2174             {
2175                 RX_MATCH_COPIED_on(rx);
2176                 s = savepvn(strbeg, i);
2177                 prog->subbeg = s;
2178             }
2179             prog->sublen = i;
2180         }
2181         else {
2182             prog->subbeg = strbeg;
2183             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2184         }
2185     }
2186
2187     return 1;
2188
2189 phooey:
2190     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2191                           PL_colors[4], PL_colors[5]));
2192     if (PL_reg_eval_set)
2193         restore_pos(aTHX_ prog);
2194     if (swap_on_fail)
2195         /* we failed :-( roll it back */
2196         swap_match_buff(prog);
2197
2198     return 0;
2199 }
2200
2201
2202 /*
2203  - regtry - try match at specific point
2204  */
2205 STATIC I32                      /* 0 failure, 1 success */
2206 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
2207 {
2208     dVAR;
2209     CHECKPOINT lastcp;
2210     REGEXP *const rx = reginfo->prog;
2211     regexp *const prog = (struct regexp *)SvANY(rx);
2212     RXi_GET_DECL(prog,progi);
2213     GET_RE_DEBUG_FLAGS_DECL;
2214     reginfo->cutpoint=NULL;
2215
2216     if ((prog->extflags & RXf_EVAL_SEEN) && !PL_reg_eval_set) {
2217         MAGIC *mg;
2218
2219         PL_reg_eval_set = RS_init;
2220         DEBUG_EXECUTE_r(DEBUG_s(
2221             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2222                           (IV)(PL_stack_sp - PL_stack_base));
2223             ));
2224         SAVESTACK_CXPOS();
2225         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2226         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2227         SAVETMPS;
2228         /* Apparently this is not needed, judging by wantarray. */
2229         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2230            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2231
2232         if (reginfo->sv) {
2233             /* Make $_ available to executed code. */
2234             if (reginfo->sv != DEFSV) {
2235                 SAVE_DEFSV;
2236                 DEFSV = reginfo->sv;
2237             }
2238
2239             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2240                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2241                 /* prepare for quick setting of pos */
2242 #ifdef PERL_OLD_COPY_ON_WRITE
2243                 if (SvIsCOW(reginfo->sv))
2244                     sv_force_normal_flags(reginfo->sv, 0);
2245 #endif
2246                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2247                                  &PL_vtbl_mglob, NULL, 0);
2248                 mg->mg_len = -1;
2249             }
2250             PL_reg_magic    = mg;
2251             PL_reg_oldpos   = mg->mg_len;
2252             SAVEDESTRUCTOR_X(restore_pos, prog);
2253         }
2254         if (!PL_reg_curpm) {
2255             Newxz(PL_reg_curpm, 1, PMOP);
2256 #ifdef USE_ITHREADS
2257             {
2258                 SV* const repointer = newSViv(0);
2259                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2260                 SvFLAGS(repointer) |= SVf_BREAK;
2261                 av_push(PL_regex_padav,repointer);
2262                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2263                 PL_regex_pad = AvARRAY(PL_regex_padav);
2264             }
2265 #endif
2266         }
2267         PM_SETRE(PL_reg_curpm, rx);
2268         PL_reg_oldcurpm = PL_curpm;
2269         PL_curpm = PL_reg_curpm;
2270         if (RXp_MATCH_COPIED(prog)) {
2271             /*  Here is a serious problem: we cannot rewrite subbeg,
2272                 since it may be needed if this match fails.  Thus
2273                 $` inside (?{}) could fail... */
2274             PL_reg_oldsaved = prog->subbeg;
2275             PL_reg_oldsavedlen = prog->sublen;
2276 #ifdef PERL_OLD_COPY_ON_WRITE
2277             PL_nrs = prog->saved_copy;
2278 #endif
2279             RXp_MATCH_COPIED_off(prog);
2280         }
2281         else
2282             PL_reg_oldsaved = NULL;
2283         prog->subbeg = PL_bostr;
2284         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2285     }
2286     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
2287     prog->offs[0].start = *startpos - PL_bostr;
2288     PL_reginput = *startpos;
2289     PL_reglastparen = &prog->lastparen;
2290     PL_reglastcloseparen = &prog->lastcloseparen;
2291     prog->lastparen = 0;
2292     prog->lastcloseparen = 0;
2293     PL_regsize = 0;
2294     PL_regoffs = prog->offs;
2295     if (PL_reg_start_tmpl <= prog->nparens) {
2296         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2297         if(PL_reg_start_tmp)
2298             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2299         else
2300             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2301     }
2302
2303     /* XXXX What this code is doing here?!!!  There should be no need
2304        to do this again and again, PL_reglastparen should take care of
2305        this!  --ilya*/
2306
2307     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2308      * Actually, the code in regcppop() (which Ilya may be meaning by
2309      * PL_reglastparen), is not needed at all by the test suite
2310      * (op/regexp, op/pat, op/split), but that code is needed otherwise
2311      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
2312      * Meanwhile, this code *is* needed for the
2313      * above-mentioned test suite tests to succeed.  The common theme
2314      * on those tests seems to be returning null fields from matches.
2315      * --jhi updated by dapm */
2316 #if 1
2317     if (prog->nparens) {
2318         regexp_paren_pair *pp = PL_regoffs;
2319         register I32 i;
2320         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2321             ++pp;
2322             pp->start = -1;
2323             pp->end = -1;
2324         }
2325     }
2326 #endif
2327     REGCP_SET(lastcp);
2328     if (regmatch(reginfo, progi->program + 1)) {
2329         PL_regoffs[0].end = PL_reginput - PL_bostr;
2330         return 1;
2331     }
2332     if (reginfo->cutpoint)
2333         *startpos= reginfo->cutpoint;
2334     REGCP_UNWIND(lastcp);
2335     return 0;
2336 }
2337
2338
2339 #define sayYES goto yes
2340 #define sayNO goto no
2341 #define sayNO_SILENT goto no_silent
2342
2343 /* we dont use STMT_START/END here because it leads to
2344    "unreachable code" warnings, which are bogus, but distracting. */
2345 #define CACHEsayNO \
2346     if (ST.cache_mask) \
2347        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2348     sayNO
2349
2350 /* this is used to determine how far from the left messages like
2351    'failed...' are printed. It should be set such that messages
2352    are inline with the regop output that created them.
2353 */
2354 #define REPORT_CODE_OFF 32
2355
2356
2357 /* Make sure there is a test for this +1 options in re_tests */
2358 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2359
2360 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2361 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2362
2363 #define SLAB_FIRST(s) (&(s)->states[0])
2364 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2365
2366 /* grab a new slab and return the first slot in it */
2367
2368 STATIC regmatch_state *
2369 S_push_slab(pTHX)
2370 {
2371 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2372     dMY_CXT;
2373 #endif
2374     regmatch_slab *s = PL_regmatch_slab->next;
2375     if (!s) {
2376         Newx(s, 1, regmatch_slab);
2377         s->prev = PL_regmatch_slab;
2378         s->next = NULL;
2379         PL_regmatch_slab->next = s;
2380     }
2381     PL_regmatch_slab = s;
2382     return SLAB_FIRST(s);
2383 }
2384
2385
2386 /* push a new state then goto it */
2387
2388 #define PUSH_STATE_GOTO(state, node) \
2389     scan = node; \
2390     st->resume_state = state; \
2391     goto push_state;
2392
2393 /* push a new state with success backtracking, then goto it */
2394
2395 #define PUSH_YES_STATE_GOTO(state, node) \
2396     scan = node; \
2397     st->resume_state = state; \
2398     goto push_yes_state;
2399
2400
2401
2402 /*
2403
2404 regmatch() - main matching routine
2405
2406 This is basically one big switch statement in a loop. We execute an op,
2407 set 'next' to point the next op, and continue. If we come to a point which
2408 we may need to backtrack to on failure such as (A|B|C), we push a
2409 backtrack state onto the backtrack stack. On failure, we pop the top
2410 state, and re-enter the loop at the state indicated. If there are no more
2411 states to pop, we return failure.
2412
2413 Sometimes we also need to backtrack on success; for example /A+/, where
2414 after successfully matching one A, we need to go back and try to
2415 match another one; similarly for lookahead assertions: if the assertion
2416 completes successfully, we backtrack to the state just before the assertion
2417 and then carry on.  In these cases, the pushed state is marked as
2418 'backtrack on success too'. This marking is in fact done by a chain of
2419 pointers, each pointing to the previous 'yes' state. On success, we pop to
2420 the nearest yes state, discarding any intermediate failure-only states.
2421 Sometimes a yes state is pushed just to force some cleanup code to be
2422 called at the end of a successful match or submatch; e.g. (??{$re}) uses
2423 it to free the inner regex.
2424
2425 Note that failure backtracking rewinds the cursor position, while
2426 success backtracking leaves it alone.
2427
2428 A pattern is complete when the END op is executed, while a subpattern
2429 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
2430 ops trigger the "pop to last yes state if any, otherwise return true"
2431 behaviour.
2432
2433 A common convention in this function is to use A and B to refer to the two
2434 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
2435 the subpattern to be matched possibly multiple times, while B is the entire
2436 rest of the pattern. Variable and state names reflect this convention.
2437
2438 The states in the main switch are the union of ops and failure/success of
2439 substates associated with with that op.  For example, IFMATCH is the op
2440 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
2441 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
2442 successfully matched A and IFMATCH_A_fail is a state saying that we have
2443 just failed to match A. Resume states always come in pairs. The backtrack
2444 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
2445 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
2446 on success or failure.
2447
2448 The struct that holds a backtracking state is actually a big union, with
2449 one variant for each major type of op. The variable st points to the
2450 top-most backtrack struct. To make the code clearer, within each
2451 block of code we #define ST to alias the relevant union.
2452
2453 Here's a concrete example of a (vastly oversimplified) IFMATCH
2454 implementation:
2455
2456     switch (state) {
2457     ....
2458
2459 #define ST st->u.ifmatch
2460
2461     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2462         ST.foo = ...; // some state we wish to save
2463         ...
2464         // push a yes backtrack state with a resume value of
2465         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
2466         // first node of A:
2467         PUSH_YES_STATE_GOTO(IFMATCH_A, A);
2468         // NOTREACHED
2469
2470     case IFMATCH_A: // we have successfully executed A; now continue with B
2471         next = B;
2472         bar = ST.foo; // do something with the preserved value
2473         break;
2474
2475     case IFMATCH_A_fail: // A failed, so the assertion failed
2476         ...;   // do some housekeeping, then ...
2477         sayNO; // propagate the failure
2478
2479 #undef ST
2480
2481     ...
2482     }
2483
2484 For any old-timers reading this who are familiar with the old recursive
2485 approach, the code above is equivalent to:
2486
2487     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2488     {
2489         int foo = ...
2490         ...
2491         if (regmatch(A)) {
2492             next = B;
2493             bar = foo;
2494             break;
2495         }
2496         ...;   // do some housekeeping, then ...
2497         sayNO; // propagate the failure
2498     }
2499
2500 The topmost backtrack state, pointed to by st, is usually free. If you
2501 want to claim it, populate any ST.foo fields in it with values you wish to
2502 save, then do one of
2503
2504         PUSH_STATE_GOTO(resume_state, node);
2505         PUSH_YES_STATE_GOTO(resume_state, node);
2506
2507 which sets that backtrack state's resume value to 'resume_state', pushes a
2508 new free entry to the top of the backtrack stack, then goes to 'node'.
2509 On backtracking, the free slot is popped, and the saved state becomes the
2510 new free state. An ST.foo field in this new top state can be temporarily
2511 accessed to retrieve values, but once the main loop is re-entered, it
2512 becomes available for reuse.
2513
2514 Note that the depth of the backtrack stack constantly increases during the
2515 left-to-right execution of the pattern, rather than going up and down with
2516 the pattern nesting. For example the stack is at its maximum at Z at the
2517 end of the pattern, rather than at X in the following:
2518
2519     /(((X)+)+)+....(Y)+....Z/
2520
2521 The only exceptions to this are lookahead/behind assertions and the cut,
2522 (?>A), which pop all the backtrack states associated with A before
2523 continuing.
2524
2525 Bascktrack state structs are allocated in slabs of about 4K in size.
2526 PL_regmatch_state and st always point to the currently active state,
2527 and PL_regmatch_slab points to the slab currently containing
2528 PL_regmatch_state.  The first time regmatch() is called, the first slab is
2529 allocated, and is never freed until interpreter destruction. When the slab
2530 is full, a new one is allocated and chained to the end. At exit from
2531 regmatch(), slabs allocated since entry are freed.
2532
2533 */
2534
2535
2536 #define DEBUG_STATE_pp(pp)                                  \
2537     DEBUG_STATE_r({                                         \
2538         DUMP_EXEC_POS(locinput, scan, do_utf8);             \
2539         PerlIO_printf(Perl_debug_log,                       \
2540             "    %*s"pp" %s%s%s%s%s\n",                     \
2541             depth*2, "",                                    \
2542             PL_reg_name[st->resume_state],                     \
2543             ((st==yes_state||st==mark_state) ? "[" : ""),   \
2544             ((st==yes_state) ? "Y" : ""),                   \
2545             ((st==mark_state) ? "M" : ""),                  \
2546             ((st==yes_state||st==mark_state) ? "]" : "")    \
2547         );                                                  \
2548     });
2549
2550
2551 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
2552
2553 #ifdef DEBUGGING
2554
2555 STATIC void
2556 S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8,
2557     const char *start, const char *end, const char *blurb)
2558 {
2559     const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
2560     if (!PL_colorset)
2561             reginitcolors();
2562     {
2563         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
2564             RX_PRECOMP(prog), RX_PRELEN(prog), 60);
2565
2566         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1),
2567             start, end - start, 60);
2568
2569         PerlIO_printf(Perl_debug_log,
2570             "%s%s REx%s %s against %s\n",
2571                        PL_colors[4], blurb, PL_colors[5], s0, s1);
2572
2573         if (do_utf8||utf8_pat)
2574             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
2575                 utf8_pat ? "pattern" : "",
2576                 utf8_pat && do_utf8 ? " and " : "",
2577                 do_utf8 ? "string" : ""
2578             );
2579     }
2580 }
2581
2582 STATIC void
2583 S_dump_exec_pos(pTHX_ const char *locinput,
2584                       const regnode *scan,
2585                       const char *loc_regeol,
2586                       const char *loc_bostr,
2587                       const char *loc_reg_starttry,
2588                       const bool do_utf8)
2589 {
2590     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
2591     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2592     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
2593     /* The part of the string before starttry has one color
2594        (pref0_len chars), between starttry and current
2595        position another one (pref_len - pref0_len chars),
2596        after the current position the third one.
2597        We assume that pref0_len <= pref_len, otherwise we
2598        decrease pref0_len.  */
2599     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
2600         ? (5 + taill) - l : locinput - loc_bostr;
2601     int pref0_len;
2602
2603     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2604         pref_len++;
2605     pref0_len = pref_len  - (locinput - loc_reg_starttry);
2606     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
2607         l = ( loc_regeol - locinput > (5 + taill) - pref_len
2608               ? (5 + taill) - pref_len : loc_regeol - locinput);
2609     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2610         l--;
2611     if (pref0_len < 0)
2612         pref0_len = 0;
2613     if (pref0_len > pref_len)
2614         pref0_len = pref_len;
2615     {
2616         const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
2617
2618         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
2619             (locinput - pref_len),pref0_len, 60, 4, 5);
2620
2621         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
2622                     (locinput - pref_len + pref0_len),
2623                     pref_len - pref0_len, 60, 2, 3);
2624
2625         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
2626                     locinput, loc_regeol - locinput, 10, 0, 1);
2627
2628         const STRLEN tlen=len0+len1+len2;
2629         PerlIO_printf(Perl_debug_log,
2630                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
2631                     (IV)(locinput - loc_bostr),
2632                     len0, s0,
2633                     len1, s1,
2634                     (docolor ? "" : "> <"),
2635                     len2, s2,
2636                     (int)(tlen > 19 ? 0 :  19 - tlen),
2637                     "");
2638     }
2639 }
2640
2641 #endif
2642
2643 /* reg_check_named_buff_matched()
2644  * Checks to see if a named buffer has matched. The data array of
2645  * buffer numbers corresponding to the buffer is expected to reside
2646  * in the regexp->data->data array in the slot stored in the ARG() of
2647  * node involved. Note that this routine doesn't actually care about the
2648  * name, that information is not preserved from compilation to execution.
2649  * Returns the index of the leftmost defined buffer with the given name
2650  * or 0 if non of the buffers matched.
2651  */
2652 STATIC I32
2653 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
2654     I32 n;
2655     RXi_GET_DECL(rex,rexi);
2656     SV *sv_dat=(SV*)rexi->data->data[ ARG( scan ) ];
2657     I32 *nums=(I32*)SvPVX(sv_dat);
2658     for ( n=0; n<SvIVX(sv_dat); n++ ) {
2659         if ((I32)*PL_reglastparen >= nums[n] &&
2660             PL_regoffs[nums[n]].end != -1)
2661         {
2662             return nums[n];
2663         }
2664     }
2665     return 0;
2666 }
2667
2668
2669 /* free all slabs above current one  - called during LEAVE_SCOPE */
2670
2671 STATIC void
2672 S_clear_backtrack_stack(pTHX_ void *p)
2673 {
2674     regmatch_slab *s = PL_regmatch_slab->next;
2675     PERL_UNUSED_ARG(p);
2676
2677     if (!s)
2678         return;
2679     PL_regmatch_slab->next = NULL;
2680     while (s) {
2681         regmatch_slab * const osl = s;
2682         s = s->next;
2683         Safefree(osl);
2684     }
2685 }
2686
2687
2688 #define SETREX(Re1,Re2) \
2689     if (PL_reg_eval_set) PM_SETRE((PL_reg_curpm), (Re2)); \
2690     Re1 = (Re2)
2691
2692 STATIC I32                      /* 0 failure, 1 success */
2693 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
2694 {
2695 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2696     dMY_CXT;
2697 #endif
2698     dVAR;
2699     register const bool do_utf8 = PL_reg_match_utf8;
2700     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2701
2702     REGEXP *rex_sv = reginfo->prog;
2703     regexp *rex = (struct regexp *)SvANY(rex_sv);
2704     RXi_GET_DECL(rex,rexi);
2705
2706     I32 oldsave;
2707
2708     /* the current state. This is a cached copy of PL_regmatch_state */
2709     register regmatch_state *st;
2710
2711     /* cache heavy used fields of st in registers */
2712     register regnode *scan;
2713     register regnode *next;
2714     register U32 n = 0; /* general value; init to avoid compiler warning */
2715     register I32 ln = 0; /* len or last;  init to avoid compiler warning */
2716     register char *locinput = PL_reginput;
2717     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2718
2719     bool result = 0;        /* return value of S_regmatch */
2720     int depth = 0;          /* depth of backtrack stack */
2721     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
2722     const U32 max_nochange_depth =
2723         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
2724         3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
2725
2726     regmatch_state *yes_state = NULL; /* state to pop to on success of
2727                                                             subpattern */
2728     /* mark_state piggy backs on the yes_state logic so that when we unwind
2729        the stack on success we can update the mark_state as we go */
2730     regmatch_state *mark_state = NULL; /* last mark state we have seen */
2731
2732     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
2733     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
2734     U32 state_num;
2735     bool no_final = 0;      /* prevent failure from backtracking? */
2736     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
2737     char *startpoint = PL_reginput;
2738     SV *popmark = NULL;     /* are we looking for a mark? */
2739     SV *sv_commit = NULL;   /* last mark name seen in failure */
2740     SV *sv_yes_mark = NULL; /* last mark name we have seen
2741                                during a successfull match */
2742     U32 lastopen = 0;       /* last open we saw */
2743     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
2744
2745     SV* const oreplsv = GvSV(PL_replgv);
2746
2747
2748     /* these three flags are set by various ops to signal information to
2749      * the very next op. They have a useful lifetime of exactly one loop
2750      * iteration, and are not preserved or restored by state pushes/pops
2751      */
2752     bool sw = 0;            /* the condition value in (?(cond)a|b) */
2753     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
2754     int logical = 0;        /* the following EVAL is:
2755                                 0: (?{...})
2756                                 1: (?(?{...})X|Y)
2757                                 2: (??{...})
2758                                or the following IFMATCH/UNLESSM is:
2759                                 false: plain (?=foo)
2760                                 true:  used as a condition: (?(?=foo))
2761                             */
2762
2763 #ifdef DEBUGGING
2764     GET_RE_DEBUG_FLAGS_DECL;
2765 #endif
2766
2767     DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
2768             PerlIO_printf(Perl_debug_log,"regmatch start\n");
2769     }));
2770     /* on first ever call to regmatch, allocate first slab */
2771     if (!PL_regmatch_slab) {
2772         Newx(PL_regmatch_slab, 1, regmatch_slab);
2773         PL_regmatch_slab->prev = NULL;
2774         PL_regmatch_slab->next = NULL;
2775         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
2776     }
2777
2778     oldsave = PL_savestack_ix;
2779     SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
2780     SAVEVPTR(PL_regmatch_slab);
2781     SAVEVPTR(PL_regmatch_state);
2782
2783     /* grab next free state slot */
2784     st = ++PL_regmatch_state;
2785     if (st >  SLAB_LAST(PL_regmatch_slab))
2786         st = PL_regmatch_state = S_push_slab(aTHX);
2787
2788     /* Note that nextchr is a byte even in UTF */
2789     nextchr = UCHARAT(locinput);
2790     scan = prog;
2791     while (scan != NULL) {
2792
2793         DEBUG_EXECUTE_r( {
2794             SV * const prop = sv_newmortal();
2795             regnode *rnext=regnext(scan);
2796             DUMP_EXEC_POS( locinput, scan, do_utf8 );
2797             regprop(rex, prop, scan);
2798
2799             PerlIO_printf(Perl_debug_log,
2800                     "%3"IVdf":%*s%s(%"IVdf")\n",
2801                     (IV)(scan - rexi->program), depth*2, "",
2802                     SvPVX_const(prop),
2803                     (PL_regkind[OP(scan)] == END || !rnext) ?
2804                         0 : (IV)(rnext - rexi->program));
2805         });
2806
2807         next = scan + NEXT_OFF(scan);
2808         if (next == scan)
2809             next = NULL;
2810         state_num = OP(scan);
2811
2812       reenter_switch:
2813         switch (state_num) {
2814         case BOL:
2815             if (locinput == PL_bostr)
2816             {
2817                 /* reginfo->till = reginfo->bol; */
2818                 break;
2819             }
2820             sayNO;
2821         case MBOL:
2822             if (locinput == PL_bostr ||
2823                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2824             {
2825                 break;
2826             }
2827             sayNO;
2828         case SBOL:
2829             if (locinput == PL_bostr)
2830                 break;
2831             sayNO;
2832         case GPOS:
2833             if (locinput == reginfo->ganch)
2834                 break;
2835             sayNO;
2836
2837         case KEEPS:
2838             /* update the startpoint */
2839             st->u.keeper.val = PL_regoffs[0].start;
2840             PL_reginput = locinput;
2841             PL_regoffs[0].start = locinput - PL_bostr;
2842             PUSH_STATE_GOTO(KEEPS_next, next);
2843             /*NOT-REACHED*/
2844         case KEEPS_next_fail:
2845             /* rollback the start point change */
2846             PL_regoffs[0].start = st->u.keeper.val;
2847             sayNO_SILENT;
2848             /*NOT-REACHED*/
2849         case EOL:
2850                 goto seol;
2851         case MEOL:
2852             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2853                 sayNO;
2854             break;
2855         case SEOL:
2856           seol:
2857             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2858                 sayNO;
2859             if (PL_regeol - locinput > 1)
2860                 sayNO;
2861             break;
2862         case EOS:
2863             if (PL_regeol != locinput)
2864                 sayNO;
2865             break;
2866         case SANY:
2867             if (!nextchr && locinput >= PL_regeol)
2868                 sayNO;
2869             if (do_utf8) {
2870                 locinput += PL_utf8skip[nextchr];
2871                 if (locinput > PL_regeol)
2872                     sayNO;
2873                 nextchr = UCHARAT(locinput);
2874             }
2875             else
2876                 nextchr = UCHARAT(++locinput);
2877             break;
2878         case CANY:
2879             if (!nextchr && locinput >= PL_regeol)
2880                 sayNO;
2881             nextchr = UCHARAT(++locinput);
2882             break;
2883         case REG_ANY:
2884             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2885                 sayNO;
2886             if (do_utf8) {
2887                 locinput += PL_utf8skip[nextchr];
2888                 if (locinput > PL_regeol)
2889                     sayNO;
2890                 nextchr = UCHARAT(locinput);
2891             }
2892             else
2893                 nextchr = UCHARAT(++locinput);
2894             break;
2895
2896 #undef  ST
2897 #define ST st->u.trie
2898         case TRIEC:
2899             /* In this case the charclass data is available inline so
2900                we can fail fast without a lot of extra overhead.
2901              */
2902             if (scan->flags == EXACT || !do_utf8) {
2903                 if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
2904                     DEBUG_EXECUTE_r(
2905                         PerlIO_printf(Perl_debug_log,
2906                                   "%*s  %sfailed to match trie start class...%s\n",
2907                                   REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2908                     );
2909                     sayNO_SILENT;
2910                     /* NOTREACHED */
2911                 }
2912             }
2913             /* FALL THROUGH */
2914         case TRIE:
2915             {
2916                 /* what type of TRIE am I? (utf8 makes this contextual) */
2917                 DECL_TRIE_TYPE(scan);
2918
2919                 /* what trie are we using right now */
2920                 reg_trie_data * const trie
2921                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
2922                 HV * widecharmap = (HV *)rexi->data->data[ ARG( scan ) + 1 ];
2923                 U32 state = trie->startstate;
2924
2925                 if (trie->bitmap && trie_type != trie_utf8_fold &&
2926                     !TRIE_BITMAP_TEST(trie,*locinput)
2927                 ) {
2928                     if (trie->states[ state ].wordnum) {
2929                          DEBUG_EXECUTE_r(
2930                             PerlIO_printf(Perl_debug_log,
2931                                           "%*s  %smatched empty string...%s\n",
2932                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2933                         );
2934                         break;
2935                     } else {
2936                         DEBUG_EXECUTE_r(
2937                             PerlIO_printf(Perl_debug_log,
2938                                           "%*s  %sfailed to match trie start class...%s\n",
2939                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2940                         );
2941                         sayNO_SILENT;
2942                    }
2943                 }
2944
2945             {
2946                 U8 *uc = ( U8* )locinput;
2947
2948                 STRLEN len = 0;
2949                 STRLEN foldlen = 0;
2950                 U8 *uscan = (U8*)NULL;
2951                 STRLEN bufflen=0;
2952                 SV *sv_accept_buff = NULL;
2953                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2954
2955                 ST.accepted = 0; /* how many accepting states we have seen */
2956                 ST.B = next;
2957                 ST.jump = trie->jump;
2958                 ST.me = scan;
2959                 /*
2960                    traverse the TRIE keeping track of all accepting states
2961                    we transition through until we get to a failing node.
2962                 */
2963
2964                 while ( state && uc <= (U8*)PL_regeol ) {
2965                     U32 base = trie->states[ state ].trans.base;
2966                     UV uvc = 0;
2967                     U16 charid;
2968                     /* We use charid to hold the wordnum as we don't use it
2969                        for charid until after we have done the wordnum logic.
2970                        We define an alias just so that the wordnum logic reads
2971                        more naturally. */
2972
2973 #define got_wordnum charid
2974                     got_wordnum = trie->states[ state ].wordnum;
2975
2976                     if ( got_wordnum ) {
2977                         if ( ! ST.accepted ) {
2978                             ENTER;
2979                             /* SAVETMPS; */ /* XXX is this necessary? dmq */
2980                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2981                             sv_accept_buff=newSV(bufflen *
2982                                             sizeof(reg_trie_accepted) - 1);
2983                             SvCUR_set(sv_accept_buff, 0);
2984                             SvPOK_on(sv_accept_buff);
2985                             sv_2mortal(sv_accept_buff);
2986                             SAVETMPS;
2987                             ST.accept_buff =
2988                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2989                         }
2990                         do {
2991                             if (ST.accepted >= bufflen) {
2992                                 bufflen *= 2;
2993                                 ST.accept_buff =(reg_trie_accepted*)
2994                                     SvGROW(sv_accept_buff,
2995                                         bufflen * sizeof(reg_trie_accepted));
2996                             }
2997                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2998                                 + sizeof(reg_trie_accepted));
2999
3000
3001                             ST.accept_buff[ST.accepted].wordnum = got_wordnum;
3002                             ST.accept_buff[ST.accepted].endpos = uc;
3003                             ++ST.accepted;
3004                         } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
3005                     }
3006 #undef got_wordnum
3007
3008                     DEBUG_TRIE_EXECUTE_r({
3009                                 DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
3010                                 PerlIO_printf( Perl_debug_log,
3011                                     "%*s  %sState: %4"UVxf" Accepted: %4"UVxf" ",
3012                                     2+depth * 2, "", PL_colors[4],
3013                                     (UV)state, (UV)ST.accepted );
3014                     });
3015
3016                     if ( base ) {
3017                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
3018                                              uscan, len, uvc, charid, foldlen,
3019                                              foldbuf, uniflags);
3020
3021                         if (charid &&
3022                              (base + charid > trie->uniquecharcount )
3023                              && (base + charid - 1 - trie->uniquecharcount
3024                                     < trie->lasttrans)
3025                              && trie->trans[base + charid - 1 -
3026                                     trie->uniquecharcount].check == state)
3027                         {
3028                             state = trie->trans[base + charid - 1 -
3029                                 trie->uniquecharcount ].next;
3030                         }
3031                         else {
3032                             state = 0;
3033                         }
3034                         uc += len;
3035
3036                     }
3037                     else {
3038                         state = 0;
3039                     }
3040                     DEBUG_TRIE_EXECUTE_r(
3041                         PerlIO_printf( Perl_debug_log,
3042                             "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
3043                             charid, uvc, (UV)state, PL_colors[5] );
3044                     );
3045                 }
3046                 if (!ST.accepted )
3047                    sayNO;
3048
3049                 DEBUG_EXECUTE_r(
3050                     PerlIO_printf( Perl_debug_log,
3051                         "%*s  %sgot %"IVdf" possible matches%s\n",
3052                         REPORT_CODE_OFF + depth * 2, "",
3053                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
3054                 );
3055             }}
3056             goto trie_first_try; /* jump into the fail handler */
3057             /* NOTREACHED */
3058         case TRIE_next_fail: /* we failed - try next alterative */
3059             if ( ST.jump) {
3060                 REGCP_UNWIND(ST.cp);
3061                 for (n = *PL_reglastparen; n > ST.lastparen; n--)
3062                     PL_regoffs[n].end = -1;
3063                 *PL_reglastparen = n;
3064             }
3065           trie_first_try:
3066             if (do_cutgroup) {
3067                 do_cutgroup = 0;
3068                 no_final = 0;
3069             }
3070
3071             if ( ST.jump) {
3072                 ST.lastparen = *PL_reglastparen;
3073                 REGCP_SET(ST.cp);
3074             }
3075             if ( ST.accepted == 1 ) {
3076                 /* only one choice left - just continue */
3077                 DEBUG_EXECUTE_r({
3078                     AV *const trie_words
3079                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
3080                     SV ** const tmp = av_fetch( trie_words,
3081                         ST.accept_buff[ 0 ].wordnum-1, 0 );
3082                     SV *sv= tmp ? sv_newmortal() : NULL;
3083
3084                     PerlIO_printf( Perl_debug_log,
3085                         "%*s  %sonly one match left: #%d <%s>%s\n",
3086                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3087                         ST.accept_buff[ 0 ].wordnum,
3088                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3089                                 PL_colors[0], PL_colors[1],
3090                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3091                             )
3092                         : "not compiled under -Dr",
3093                         PL_colors[5] );
3094                 });
3095                 PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
3096                 /* in this case we free tmps/leave before we call regmatch
3097                    as we wont be using accept_buff again. */
3098
3099                 locinput = PL_reginput;
3100                 nextchr = UCHARAT(locinput);
3101                 if ( !ST.jump || !ST.jump[ST.accept_buff[0].wordnum])
3102                     scan = ST.B;
3103                 else
3104                     scan = ST.me + ST.jump[ST.accept_buff[0].wordnum];
3105                 if (!has_cutgroup) {
3106                     FREETMPS;
3107                     LEAVE;
3108                 } else {
3109                     ST.accepted--;
3110                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3111                 }
3112
3113                 continue; /* execute rest of RE */
3114             }
3115
3116             if ( !ST.accepted-- ) {
3117                 DEBUG_EXECUTE_r({
3118                     PerlIO_printf( Perl_debug_log,
3119                         "%*s  %sTRIE failed...%s\n",
3120                         REPORT_CODE_OFF+depth*2, "",
3121                         PL_colors[4],
3122                         PL_colors[5] );
3123                 });
3124                 FREETMPS;
3125                 LEAVE;
3126                 sayNO_SILENT;
3127                 /*NOTREACHED*/
3128             }
3129
3130             /*
3131                There are at least two accepting states left.  Presumably
3132                the number of accepting states is going to be low,
3133                typically two. So we simply scan through to find the one
3134                with lowest wordnum.  Once we find it, we swap the last
3135                state into its place and decrement the size. We then try to
3136                match the rest of the pattern at the point where the word
3137                ends. If we succeed, control just continues along the
3138                regex; if we fail we return here to try the next accepting
3139                state
3140              */
3141
3142             {
3143                 U32 best = 0;
3144                 U32 cur;
3145                 for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
3146                     DEBUG_TRIE_EXECUTE_r(
3147                         PerlIO_printf( Perl_debug_log,
3148                             "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
3149                             REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
3150                             (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
3151                             ST.accept_buff[ cur ].wordnum, PL_colors[5] );
3152                     );
3153
3154                     if (ST.accept_buff[cur].wordnum <
3155                             ST.accept_buff[best].wordnum)
3156                         best = cur;
3157                 }
3158
3159                 DEBUG_EXECUTE_r({
3160                     AV *const trie_words
3161                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
3162                     SV ** const tmp = av_fetch( trie_words,
3163                         ST.accept_buff[ best ].wordnum - 1, 0 );
3164                     regnode *nextop=(!ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) ?
3165                                     ST.B :
3166                                     ST.me + ST.jump[ST.accept_buff[best].wordnum];
3167                     SV *sv= tmp ? sv_newmortal() : NULL;
3168
3169                     PerlIO_printf( Perl_debug_log,
3170                         "%*s  %strying alternation #%d <%s> at node #%d %s\n",
3171                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3172                         ST.accept_buff[best].wordnum,
3173                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3174                                 PL_colors[0], PL_colors[1],
3175                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3176                             ) : "not compiled under -Dr",
3177                             REG_NODE_NUM(nextop),
3178                         PL_colors[5] );
3179                 });
3180
3181                 if ( best<ST.accepted ) {
3182                     reg_trie_accepted tmp = ST.accept_buff[ best ];
3183                     ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
3184                     ST.accept_buff[ ST.accepted ] = tmp;
3185                     best = ST.accepted;
3186                 }
3187                 PL_reginput = (char *)ST.accept_buff[ best ].endpos;
3188                 if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
3189                     scan = ST.B;
3190                 } else {
3191                     scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
3192                 }
3193                 PUSH_YES_STATE_GOTO(TRIE_next, scan);
3194                 /* NOTREACHED */
3195             }
3196             /* NOTREACHED */
3197         case TRIE_next:
3198             FREETMPS;
3199             LEAVE;
3200             sayYES;
3201 #undef  ST
3202
3203         case EXACT: {
3204             char *s = STRING(scan);
3205             ln = STR_LEN(scan);
3206             if (do_utf8 != UTF) {
3207                 /* The target and the pattern have differing utf8ness. */
3208                 char *l = locinput;
3209                 const char * const e = s + ln;
3210
3211                 if (do_utf8) {
3212                     /* The target is utf8, the pattern is not utf8. */
3213                     while (s < e) {
3214                         STRLEN ulen;
3215                         if (l >= PL_regeol)
3216                              sayNO;
3217                         if (NATIVE_TO_UNI(*(U8*)s) !=
3218                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
3219                                             uniflags))
3220                              sayNO;
3221                         l += ulen;
3222                         s ++;
3223                     }
3224                 }
3225                 else {
3226                     /* The target is not utf8, the pattern is utf8. */
3227                     while (s < e) {
3228                         STRLEN ulen;
3229                         if (l >= PL_regeol)
3230                             sayNO;
3231                         if (NATIVE_TO_UNI(*((U8*)l)) !=
3232                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
3233                                            uniflags))
3234                             sayNO;
3235                         s += ulen;
3236                         l ++;
3237                     }
3238                 }
3239                 locinput = l;
3240                 nextchr = UCHARAT(locinput);
3241                 break;
3242             }
3243             /* The target and the pattern have the same utf8ness. */
3244             /* Inline the first character, for speed. */
3245             if (UCHARAT(s) != nextchr)
3246                 sayNO;
3247             if (PL_regeol - locinput < ln)
3248                 sayNO;
3249             if (ln > 1 && memNE(s, locinput, ln))
3250                 sayNO;
3251             locinput += ln;
3252             nextchr = UCHARAT(locinput);
3253             break;
3254             }
3255         case EXACTFL:
3256             PL_reg_flags |= RF_tainted;
3257             /* FALL THROUGH */
3258         case EXACTF: {
3259             char * const s = STRING(scan);
3260             ln = STR_LEN(scan);
3261
3262             if (do_utf8 || UTF) {
3263               /* Either target or the pattern are utf8. */
3264                 const char * const l = locinput;
3265                 char *e = PL_regeol;
3266
3267                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
3268                                l, &e, 0,  do_utf8)) {
3269                      /* One more case for the sharp s:
3270                       * pack("U0U*", 0xDF) =~ /ss/i,
3271                       * the 0xC3 0x9F are the UTF-8
3272                       * byte sequence for the U+00DF. */
3273
3274                      if (!(do_utf8 &&
3275                            toLOWER(s[0]) == 's' &&
3276                            ln >= 2 &&
3277                            toLOWER(s[1]) == 's' &&
3278                            (U8)l[0] == 0xC3 &&
3279                            e - l >= 2 &&
3280                            (U8)l[1] == 0x9F))
3281                           sayNO;
3282                 }
3283                 locinput = e;
3284                 nextchr = UCHARAT(locinput);
3285                 break;
3286             }
3287
3288             /* Neither the target and the pattern are utf8. */
3289
3290             /* Inline the first character, for speed. */
3291             if (UCHARAT(s) != nextchr &&
3292                 UCHARAT(s) != ((OP(scan) == EXACTF)
3293                                ? PL_fold : PL_fold_locale)[nextchr])
3294                 sayNO;
3295             if (PL_regeol - locinput < ln)
3296                 sayNO;
3297             if (ln > 1 && (OP(scan) == EXACTF
3298                            ? ibcmp(s, locinput, ln)
3299                            : ibcmp_locale(s, locinput, ln)))
3300                 sayNO;
3301             locinput += ln;
3302             nextchr = UCHARAT(locinput);
3303             break;
3304             }
3305         case ANYOF:
3306             if (do_utf8) {
3307                 STRLEN inclasslen = PL_regeol - locinput;
3308
3309                 if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, do_utf8))
3310                     goto anyof_fail;
3311                 if (locinput >= PL_regeol)
3312                     sayNO;
3313                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
3314                 nextchr = UCHARAT(locinput);
3315                 break;
3316             }
3317             else {
3318                 if (nextchr < 0)
3319                     nextchr = UCHARAT(locinput);
3320                 if (!REGINCLASS(rex, scan, (U8*)locinput))
3321                     goto anyof_fail;
3322                 if (!nextchr && locinput >= PL_regeol)
3323                     sayNO;
3324                 nextchr = UCHARAT(++locinput);
3325                 break;
3326             }
3327         anyof_fail:
3328             /* If we might have the case of the German sharp s
3329              * in a casefolding Unicode character class. */
3330
3331             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
3332                  locinput += SHARP_S_SKIP;
3333                  nextchr = UCHARAT(locinput);
3334             }
3335             else
3336                  sayNO;
3337             break;
3338         case ALNUML:
3339             PL_reg_flags |= RF_tainted;
3340             /* FALL THROUGH */
3341         case ALNUM:
3342             if (!nextchr)
3343                 sayNO;
3344             if (do_utf8) {
3345                 LOAD_UTF8_CHARCLASS_ALNUM();
3346                 if (!(OP(scan) == ALNUM
3347                       ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3348                       : isALNUM_LC_utf8((U8*)locinput)))
3349                 {
3350                     sayNO;
3351                 }
3352                 locinput += PL_utf8skip[nextchr];
3353                 nextchr = UCHARAT(locinput);
3354                 break;
3355             }
3356             if (!(OP(scan) == ALNUM
3357                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3358                 sayNO;
3359             nextchr = UCHARAT(++locinput);
3360             break;
3361         case NALNUML:
3362             PL_reg_flags |= RF_tainted;
3363             /* FALL THROUGH */
3364         case NALNUM:
3365             if (!nextchr && locinput >= PL_regeol)
3366                 sayNO;
3367             if (do_utf8) {
3368                 LOAD_UTF8_CHARCLASS_ALNUM();
3369                 if (OP(scan) == NALNUM
3370                     ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3371                     : isALNUM_LC_utf8((U8*)locinput))
3372                 {
3373                     sayNO;
3374                 }
3375                 locinput += PL_utf8skip[nextchr];
3376                 nextchr = UCHARAT(locinput);
3377                 break;
3378             }
3379             if (OP(scan) == NALNUM
3380                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3381                 sayNO;
3382             nextchr = UCHARAT(++locinput);
3383             break;
3384         case BOUNDL:
3385         case NBOUNDL:
3386             PL_reg_flags |= RF_tainted;
3387             /* FALL THROUGH */
3388         case BOUND:
3389         case NBOUND:
3390             /* was last char in word? */
3391             if (do_utf8) {
3392                 if (locinput == PL_bostr)
3393                     ln = '\n';
3394                 else {
3395                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3396
3397                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3398                 }
3399                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3400                     ln = isALNUM_uni(ln);
3401                     LOAD_UTF8_CHARCLASS_ALNUM();
3402                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3403                 }
3404                 else {
3405                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
3406                     n = isALNUM_LC_utf8((U8*)locinput);
3407                 }
3408             }
3409             else {
3410                 ln = (locinput != PL_bostr) ?
3411                     UCHARAT(locinput - 1) : '\n';
3412                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3413                     ln = isALNUM(ln);
3414                     n = isALNUM(nextchr);
3415                 }
3416                 else {
3417                     ln = isALNUM_LC(ln);
3418                     n = isALNUM_LC(nextchr);
3419                 }
3420             }
3421             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3422                                     OP(scan) == BOUNDL))
3423                     sayNO;
3424             break;
3425         case SPACEL:
3426             PL_reg_flags |= RF_tainted;
3427             /* FALL THROUGH */
3428         case SPACE:
3429             if (!nextchr)
3430                 sayNO;
3431             if (do_utf8) {
3432                 if (UTF8_IS_CONTINUED(nextchr)) {
3433                     LOAD_UTF8_CHARCLASS_SPACE();
3434                     if (!(OP(scan) == SPACE
3435                           ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3436                           : isSPACE_LC_utf8((U8*)locinput)))
3437                     {
3438                         sayNO;
3439                     }
3440                     locinput += PL_utf8skip[nextchr];
3441                     nextchr = UCHARAT(locinput);
3442                     break;
3443                 }
3444                 if (!(OP(scan) == SPACE
3445                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3446                     sayNO;
3447                 nextchr = UCHARAT(++locinput);
3448             }
3449             else {
3450                 if (!(OP(scan) == SPACE
3451                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3452                     sayNO;
3453                 nextchr = UCHARAT(++locinput);
3454             }
3455             break;
3456         case NSPACEL:
3457             PL_reg_flags |= RF_tainted;
3458             /* FALL THROUGH */
3459         case NSPACE:
3460             if (!nextchr && locinput >= PL_regeol)
3461                 sayNO;
3462             if (do_utf8) {
3463                 LOAD_UTF8_CHARCLASS_SPACE();
3464                 if (OP(scan) == NSPACE
3465                     ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3466                     : isSPACE_LC_utf8((U8*)locinput))
3467                 {
3468                     sayNO;
3469                 }
3470                 locinput += PL_utf8skip[nextchr];
3471                 nextchr = UCHARAT(locinput);
3472                 break;
3473             }
3474             if (OP(scan) == NSPACE
3475                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3476                 sayNO;
3477             nextchr = UCHARAT(++locinput);
3478             break;
3479         case DIGITL:
3480             PL_reg_flags |= RF_tainted;
3481             /* FALL THROUGH */
3482         case DIGIT:
3483             if (!nextchr)
3484                 sayNO;
3485             if (do_utf8) {
3486                 LOAD_UTF8_CHARCLASS_DIGIT();
3487                 if (!(OP(scan) == DIGIT
3488                       ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3489                       : isDIGIT_LC_utf8((U8*)locinput)))
3490                 {
3491                     sayNO;
3492                 }
3493                 locinput += PL_utf8skip[nextchr];
3494                 nextchr = UCHARAT(locinput);
3495                 break;
3496             }
3497             if (!(OP(scan) == DIGIT
3498                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3499                 sayNO;
3500             nextchr = UCHARAT(++locinput);
3501             break;
3502         case NDIGITL:
3503             PL_reg_flags |= RF_tainted;
3504             /* FALL THROUGH */
3505         case NDIGIT:
3506             if (!nextchr && locinput >= PL_regeol)
3507                 sayNO;
3508             if (do_utf8) {
3509                 LOAD_UTF8_CHARCLASS_DIGIT();
3510                 if (OP(scan) == NDIGIT
3511                     ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3512                     : isDIGIT_LC_utf8((U8*)locinput))
3513                 {
3514                     sayNO;
3515                 }
3516                 locinput += PL_utf8skip[nextchr];
3517                 nextchr = UCHARAT(locinput);
3518                 break;
3519             }
3520             if (OP(scan) == NDIGIT
3521                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3522                 sayNO;
3523             nextchr = UCHARAT(++locinput);
3524             break;
3525         case CLUMP:
3526             if (locinput >= PL_regeol)
3527                 sayNO;
3528             if  (do_utf8) {
3529                 LOAD_UTF8_CHARCLASS_MARK();
3530                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3531                     sayNO;
3532                 locinput += PL_utf8skip[nextchr];
3533                 while (locinput < PL_regeol &&
3534                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3535                     locinput += UTF8SKIP(locinput);
3536                 if (locinput > PL_regeol)
3537                     sayNO;
3538             }
3539             else
3540                locinput++;
3541             nextchr = UCHARAT(locinput);
3542             break;
3543
3544         case NREFFL:
3545         {
3546             char *s;
3547             char type;
3548             PL_reg_flags |= RF_tainted;
3549             /* FALL THROUGH */
3550         case NREF:
3551         case NREFF:
3552             type = OP(scan);
3553             n = reg_check_named_buff_matched(rex,scan);
3554
3555             if ( n ) {
3556                 type = REF + ( type - NREF );
3557                 goto do_ref;
3558             } else {
3559                 sayNO;
3560             }
3561             /* unreached */
3562         case REFFL:
3563             PL_reg_flags |= RF_tainted;
3564             /* FALL THROUGH */
3565         case REF:
3566         case REFF:
3567             n = ARG(scan);  /* which paren pair */
3568             type = OP(scan);
3569           do_ref:
3570             ln = PL_regoffs[n].start;
3571             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3572             if (*PL_reglastparen < n || ln == -1)
3573                 sayNO;                  /* Do not match unless seen CLOSEn. */
3574             if (ln == PL_regoffs[n].end)
3575                 break;
3576
3577             s = PL_bostr + ln;
3578             if (do_utf8 && type != REF) {       /* REF can do byte comparison */
3579                 char *l = locinput;
3580                 const char *e = PL_bostr + PL_regoffs[n].end;
3581                 /*
3582                  * Note that we can't do the "other character" lookup trick as
3583                  * in the 8-bit case (no pun intended) because in Unicode we
3584                  * have to map both upper and title case to lower case.
3585                  */
3586                 if (type == REFF) {
3587                     while (s < e) {
3588                         STRLEN ulen1, ulen2;
3589                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3590                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3591
3592                         if (l >= PL_regeol)
3593                             sayNO;
3594                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3595                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3596                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3597                             sayNO;
3598                         s += ulen1;
3599                         l += ulen2;
3600                     }
3601                 }
3602                 locinput = l;
3603                 nextchr = UCHARAT(locinput);
3604                 break;
3605             }
3606
3607             /* Inline the first character, for speed. */
3608             if (UCHARAT(s) != nextchr &&
3609                 (type == REF ||
3610                  (UCHARAT(s) != (type == REFF
3611                                   ? PL_fold : PL_fold_locale)[nextchr])))
3612                 sayNO;
3613             ln = PL_regoffs[n].end - ln;
3614             if (locinput + ln > PL_regeol)
3615                 sayNO;
3616             if (ln > 1 && (type == REF
3617                            ? memNE(s, locinput, ln)
3618                            : (type == REFF
3619                               ? ibcmp(s, locinput, ln)
3620                               : ibcmp_locale(s, locinput, ln))))
3621                 sayNO;
3622             locinput += ln;
3623             nextchr = UCHARAT(locinput);
3624             break;
3625         }
3626         case NOTHING:
3627         case TAIL:
3628             break;
3629         case BACK:
3630             break;
3631
3632 #undef  ST
3633 #define ST st->u.eval
3634         {
3635             SV *ret;
3636             SV *re_sv;
3637             regexp *re;
3638             regexp_internal *rei;
3639             regnode *startpoint;
3640
3641         case GOSTART:
3642         case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
3643             if (cur_eval && cur_eval->locinput==locinput) {
3644                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan))
3645                     Perl_croak(aTHX_ "Infinite recursion in regex");
3646                 if ( ++nochange_depth > max_nochange_depth )
3647                     Perl_croak(aTHX_
3648                         "Pattern subroutine nesting without pos change"
3649                         " exceeded limit in regex");
3650             } else {
3651                 nochange_depth = 0;
3652             }
3653             re_sv = rex_sv;
3654             re = rex;
3655             rei = rexi;
3656             (void)ReREFCNT_inc(rex_sv);
3657             if (OP(scan)==GOSUB) {
3658                 startpoint = scan + ARG2L(scan);
3659                 ST.close_paren = ARG(scan);
3660             } else {
3661                 startpoint = rei->program+1;
3662                 ST.close_paren = 0;
3663             }
3664             goto eval_recurse_doit;
3665             /* NOTREACHED */
3666         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */
3667             if (cur_eval && cur_eval->locinput==locinput) {
3668                 if ( ++nochange_depth > max_nochange_depth )
3669                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
3670             } else {
3671                 nochange_depth = 0;
3672             }
3673             {
3674                 /* execute the code in the {...} */
3675                 dSP;
3676                 SV ** const before = SP;
3677                 OP_4tree * const oop = PL_op;
3678                 COP * const ocurcop = PL_curcop;
3679                 PAD *old_comppad;
3680
3681                 n = ARG(scan);
3682                 PL_op = (OP_4tree*)rexi->data->data[n];
3683                 DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
3684                     "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3685                 PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
3686                 PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
3687
3688                 if (sv_yes_mark) {
3689                     SV *sv_mrk = get_sv("REGMARK", 1);
3690                     sv_setsv(sv_mrk, sv_yes_mark);
3691                 }
3692
3693                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3694                 SPAGAIN;
3695                 if (SP == before)
3696                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3697                 else {
3698                     ret = POPs;
3699                     PUTBACK;
3700                 }
3701
3702                 PL_op = oop;
3703                 PAD_RESTORE_LOCAL(old_comppad);
3704                 PL_curcop = ocurcop;
3705                 if (!logical) {
3706                     /* /(?{...})/ */
3707                     sv_setsv(save_scalar(PL_replgv), ret);
3708                     break;
3709                 }
3710             }
3711             if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
3712                 logical = 0;
3713                 {
3714                     /* extract RE object from returned value; compiling if
3715                      * necessary */
3716                     MAGIC *mg = NULL;
3717                     REGEXP *rx = NULL;
3718
3719                     if (SvROK(ret)) {
3720                         SV *const sv = SvRV(ret);
3721
3722                         if (SvTYPE(sv) == SVt_REGEXP) {
3723                             rx = sv;
3724                         } else if (SvSMAGICAL(sv)) {
3725                             mg = mg_find(sv, PERL_MAGIC_qr);
3726                             assert(mg);
3727                         }
3728                     } else if (SvTYPE(ret) == SVt_REGEXP) {
3729                         rx = ret;
3730                     } else if (SvSMAGICAL(ret)) {
3731                         if (SvGMAGICAL(ret)) {
3732                             /* I don't believe that there is ever qr magic
3733                                here.  */
3734                             assert(!mg_find(ret, PERL_MAGIC_qr));
3735                             sv_unmagic(ret, PERL_MAGIC_qr);
3736                         }
3737                         else {
3738                             mg = mg_find(ret, PERL_MAGIC_qr);
3739                             /* testing suggests mg only ends up non-NULL for
3740                                scalars who were upgraded and compiled in the
3741                                else block below. In turn, this is only
3742                                triggered in the "postponed utf8 string" tests
3743                                in t/op/pat.t  */
3744                         }
3745                     }
3746
3747                     if (mg) {
3748                         rx = mg->mg_obj; /*XXX:dmq*/
3749                         assert(re);
3750                     }
3751                     if (rx) {
3752                         rx = reg_temp_copy(rx);
3753                     }
3754                     else {
3755                         U32 pm_flags = 0;
3756                         const I32 osize = PL_regsize;
3757
3758                         if (DO_UTF8(ret)) pm_flags |= RXf_UTF8;
3759                         rx = CALLREGCOMP(ret, pm_flags);
3760                         if (!(SvFLAGS(ret)
3761                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3762                                  | SVs_GMG))) {
3763                             /* This isn't a first class regexp. Instead, it's
3764                                caching a regexp onto an existing, Perl visible
3765                                scalar.  */
3766                             sv_magic(ret, rx, PERL_MAGIC_qr, 0, 0);
3767                         }
3768                         PL_regsize = osize;
3769                     }
3770                     re_sv = rx;
3771                     re = (struct regexp *)SvANY(rx);
3772                 }
3773                 RXp_MATCH_COPIED_off(re);
3774                 re->subbeg = rex->subbeg;
3775                 re->sublen = rex->sublen;
3776                 rei = RXi_GET(re);
3777                 DEBUG_EXECUTE_r(
3778                     debug_start_match(re_sv, do_utf8, locinput, PL_regeol,
3779                         "Matching embedded");
3780                 );
3781                 startpoint = rei->program + 1;
3782                 ST.close_paren = 0; /* only used for GOSUB */
3783                 /* borrowed from regtry */
3784                 if (PL_reg_start_tmpl <= re->nparens) {
3785                     PL_reg_start_tmpl = re->nparens*3/2 + 3;
3786                     if(PL_reg_start_tmp)
3787                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3788                     else
3789                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3790                 }
3791
3792         eval_recurse_doit: /* Share code with GOSUB below this line */
3793                 /* run the pattern returned from (??{...}) */
3794                 ST.cp = regcppush(0);   /* Save *all* the positions. */
3795                 REGCP_SET(ST.lastcp);
3796
3797                 PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
3798
3799                 *PL_reglastparen = 0;
3800                 *PL_reglastcloseparen = 0;
3801                 PL_reginput = locinput;
3802                 PL_regsize = 0;
3803
3804                 /* XXXX This is too dramatic a measure... */
3805                 PL_reg_maxiter = 0;
3806
3807                 ST.toggle_reg_flags = PL_reg_flags;
3808                 if (re->extflags & RXf_UTF8)
3809                     PL_reg_flags |= RF_utf8;
3810                 else
3811                     PL_reg_flags &= ~RF_utf8;
3812                 ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
3813
3814                 ST.prev_rex = rex_sv;
3815                 ST.prev_curlyx = cur_curlyx;
3816                 SETREX(rex_sv,re_sv);
3817                 rex = re;
3818                 rexi = rei;
3819                 cur_curlyx = NULL;
3820                 ST.B = next;
3821                 ST.prev_eval = cur_eval;
3822                 cur_eval = st;
3823                 /* now continue from first node in postoned RE */
3824                 PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
3825                 /* NOTREACHED */
3826             }
3827             /* logical is 1,   /(?(?{...})X|Y)/ */
3828             sw = (bool)SvTRUE(ret);
3829             logical = 0;
3830             break;
3831         }
3832
3833         case EVAL_AB: /* cleanup after a successful (??{A})B */
3834             /* note: this is called twice; first after popping B, then A */
3835             PL_reg_flags ^= ST.toggle_reg_flags;
3836             ReREFCNT_dec(rex_sv);
3837             SETREX(rex_sv,ST.prev_rex);
3838             rex = (struct regexp *)SvANY(rex_sv);
3839             rexi = RXi_GET(rex);
3840             regcpblow(ST.cp);
3841             cur_eval = ST.prev_eval;
3842             cur_curlyx = ST.prev_curlyx;
3843             /* XXXX This is too dramatic a measure... */
3844             PL_reg_maxiter = 0;
3845             if ( nochange_depth )
3846                 nochange_depth--;
3847             sayYES;
3848
3849
3850         case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
3851             /* note: this is called twice; first after popping B, then A */
3852             PL_reg_flags ^= ST.toggle_reg_flags;
3853             ReREFCNT_dec(rex_sv);
3854             SETREX(rex_sv,ST.prev_rex);
3855             rex = (struct regexp *)SvANY(rex_sv);
3856             rexi = RXi_GET(rex);
3857             PL_reginput = locinput;
3858             REGCP_UNWIND(ST.lastcp);
3859             regcppop(rex);
3860             cur_eval = ST.prev_eval;
3861             cur_curlyx = ST.prev_curlyx;
3862             /* XXXX This is too dramatic a measure... */
3863             PL_reg_maxiter = 0;
3864             if ( nochange_depth )
3865                 nochange_depth--;
3866             sayNO_SILENT;
3867 #undef ST
3868
3869         case OPEN:
3870             n = ARG(scan);  /* which paren pair */
3871             PL_reg_start_tmp[n] = locinput;
3872             if (n > PL_regsize)
3873                 PL_regsize = n;
3874             lastopen = n;
3875             break;
3876         case CLOSE:
3877             n = ARG(scan);  /* which paren pair */
3878             PL_regoffs[n].start = PL_reg_start_tmp[n] - PL_bostr;
3879             PL_regoffs[n].end = locinput - PL_bostr;
3880             /*if (n > PL_regsize)
3881                 PL_regsize = n;*/
3882             if (n > *PL_reglastparen)
3883                 *PL_reglastparen = n;
3884             *PL_reglastcloseparen = n;
3885             if (cur_eval && cur_eval->u.eval.close_paren == n) {
3886                 goto fake_end;
3887             }
3888             break;
3889         case ACCEPT:
3890             if (ARG(scan)){
3891                 regnode *cursor;
3892                 for (cursor=scan;
3893                      cursor && OP(cursor)!=END;
3894                      cursor=regnext(cursor))
3895                 {
3896                     if ( OP(cursor)==CLOSE ){
3897                         n = ARG(cursor);
3898                         if ( n <= lastopen ) {
3899                             PL_regoffs[n].start
3900                                 = PL_reg_start_tmp[n] - PL_bostr;
3901                             PL_regoffs[n].end = locinput - PL_bostr;
3902                             /*if (n > PL_regsize)
3903                             PL_regsize = n;*/
3904                             if (n > *PL_reglastparen)
3905                                 *PL_reglastparen = n;
3906                             *PL_reglastcloseparen = n;
3907                             if ( n == ARG(scan) || (cur_eval &&
3908                                 cur_eval->u.eval.close_paren == n))
3909                                 break;
3910                         }
3911                     }
3912                 }
3913             }
3914             goto fake_end;
3915             /*NOTREACHED*/
3916         case GROUPP:
3917             n = ARG(scan);  /* which paren pair */
3918             sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
3919             break;
3920         case NGROUPP:
3921             /* reg_check_named_buff_matched returns 0 for no match */
3922             sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
3923             break;
3924         case INSUBP:
3925             n = ARG(scan);
3926             sw = (cur_eval && (!n || cur_eval->u.eval.close_paren == n));
3927             break;
3928         case DEFINEP:
3929             sw = 0;
3930             break;
3931         case IFTHEN:
3932             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3933             if (sw)
3934                 next = NEXTOPER(NEXTOPER(scan));
3935             else {
3936                 next = scan + ARG(scan);
3937                 if (OP(next) == IFTHEN) /* Fake one. */
3938                     next = NEXTOPER(NEXTOPER(next));
3939             }
3940             break;
3941         case LOGICAL:
3942             logical = scan->flags;
3943             break;
3944
3945 /*******************************************************************
3946
3947 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
3948 pattern, where A and B are subpatterns. (For simple A, CURLYM or
3949 STAR/PLUS/CURLY/CURLYN are used instead.)
3950
3951 A*B is compiled as <CURLYX><A><WHILEM><B>
3952
3953 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
3954 state, which contains the current count, initialised to -1. It also sets
3955 cur_curlyx to point to this state, with any previous value saved in the
3956 state block.
3957
3958 CURLYX then jumps straight to the WHILEM op, rather than executing A,
3959 since the pattern may possibly match zero times (i.e. it's a while {} loop
3960 rather than a do {} while loop).
3961
3962 Each entry to WHILEM represents a successful match of A. The count in the
3963 CURLYX block is incremented, another WHILEM state is pushed, and execution
3964 passes to A or B depending on greediness and the current count.
3965
3966 For example, if matching against the string a1a2a3b (where the aN are
3967 substrings that match /A/), then the match progresses as follows: (the
3968 pushed states are interspersed with the bits of strings matched so far):
3969
3970     <CURLYX cnt=-1>
3971     <CURLYX cnt=0><WHILEM>
3972     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
3973     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
3974     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
3975     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
3976
3977 (Contrast this with something like CURLYM, which maintains only a single
3978 backtrack state:
3979
3980     <CURLYM cnt=0> a1
3981     a1 <CURLYM cnt=1> a2
3982     a1 a2 <CURLYM cnt=2> a3
3983     a1 a2 a3 <CURLYM cnt=3> b
3984 )
3985
3986 Each WHILEM state block marks a point to backtrack to upon partial failure
3987 of A or B, and also contains some minor state data related to that
3988 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
3989 overall state, such as the count, and pointers to the A and B ops.
3990
3991 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
3992 must always point to the *current* CURLYX block, the rules are:
3993
3994 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
3995 and set cur_curlyx to point the new block.
3996
3997 When popping the CURLYX block after a successful or unsuccessful match,
3998 restore the previous cur_curlyx.
3999
4000 When WHILEM is about to execute B, save the current cur_curlyx, and set it
4001 to the outer one saved in the CURLYX block.
4002
4003 When popping the WHILEM block after a successful or unsuccessful B match,
4004 restore the previous cur_curlyx.
4005
4006 Here's an example for the pattern (AI* BI)*BO
4007 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
4008
4009 cur_
4010 curlyx backtrack stack
4011 ------ ---------------
4012 NULL
4013 CO     <CO prev=NULL> <WO>
4014 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
4015 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
4016 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
4017
4018 At this point the pattern succeeds, and we work back down the stack to
4019 clean up, restoring as we go:
4020
4021 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
4022 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
4023 CO     <CO prev=NULL> <WO>
4024 NULL
4025
4026 *******************************************************************/
4027
4028 #define ST st->u.curlyx
4029
4030         case CURLYX:    /* start of /A*B/  (for complex A) */
4031         {
4032             /* No need to save/restore up to this paren */
4033             I32 parenfloor = scan->flags;
4034
4035             assert(next); /* keep Coverity happy */
4036             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
4037                 next += ARG(next);
4038
4039             /* XXXX Probably it is better to teach regpush to support
4040                parenfloor > PL_regsize... */
4041             if (parenfloor > (I32)*PL_reglastparen)
4042                 parenfloor = *PL_reglastparen; /* Pessimization... */
4043
4044             ST.prev_curlyx= cur_curlyx;
4045             cur_curlyx = st;
4046             ST.cp = PL_savestack_ix;
4047
4048             /* these fields contain the state of the current curly.
4049              * they are accessed by subsequent WHILEMs */
4050             ST.parenfloor = parenfloor;
4051             ST.min = ARG1(scan);
4052             ST.max = ARG2(scan);
4053             ST.A = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
4054             ST.B = next;
4055             ST.minmod = minmod;
4056             minmod = 0;
4057             ST.count = -1;      /* this will be updated by WHILEM */
4058             ST.lastloc = NULL;  /* this will be updated by WHILEM */
4059
4060             PL_reginput = locinput;
4061             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next));
4062             /* NOTREACHED */
4063         }
4064
4065         case CURLYX_end: /* just finished matching all of A*B */
4066             cur_curlyx = ST.prev_curlyx;
4067             sayYES;
4068             /* NOTREACHED */
4069
4070         case CURLYX_end_fail: /* just failed to match all of A*B */
4071             regcpblow(ST.cp);
4072             cur_curlyx = ST.prev_curlyx;
4073             sayNO;
4074             /* NOTREACHED */
4075
4076
4077 #undef ST
4078 #define ST st->u.whilem
4079
4080         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
4081         {
4082             /* see the discussion above about CURLYX/WHILEM */
4083             I32 n;
4084             assert(cur_curlyx); /* keep Coverity happy */
4085             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
4086             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
4087             ST.cache_offset = 0;
4088             ST.cache_mask = 0;
4089
4090             PL_reginput = locinput;
4091
4092             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4093                   "%*s  whilem: matched %ld out of %ld..%ld\n",
4094                   REPORT_CODE_OFF+depth*2, "", (long)n,
4095                   (long)cur_curlyx->u.curlyx.min,
4096                   (long)cur_curlyx->u.curlyx.max)
4097             );
4098
4099             /* First just match a string of min A's. */
4100
4101             if (n < cur_curlyx->u.curlyx.min) {
4102                 cur_curlyx->u.curlyx.lastloc = locinput;
4103                 PUSH_STATE_GOTO(WHILEM_A_pre, cur_curlyx->u.curlyx.A);
4104                 /* NOTREACHED */
4105             }
4106
4107             /* If degenerate A matches "", assume A done. */
4108
4109             if (locinput == cur_curlyx->u.curlyx.lastloc) {
4110                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4111                    "%*s  whilem: empty match detected, trying continuation...\n",
4112                    REPORT_CODE_OFF+depth*2, "")
4113                 );
4114                 goto do_whilem_B_max;
4115             }
4116
4117             /* super-linear cache processing */
4118
4119             if (scan->flags) {
4120
4121                 if (!PL_reg_maxiter) {
4122                     /* start the countdown: Postpone detection until we
4123                      * know the match is not *that* much linear. */
4124                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
4125                     /* possible overflow for long strings and many CURLYX's */
4126                     if (PL_reg_maxiter < 0)
4127                         PL_reg_maxiter = I32_MAX;
4128                     PL_reg_leftiter = PL_reg_maxiter;
4129                 }
4130
4131                 if (PL_reg_leftiter-- == 0) {
4132                     /* initialise cache */
4133                     const I32 size = (PL_reg_maxiter + 7)/8;
4134                     if (PL_reg_poscache) {
4135                         if ((I32)PL_reg_poscache_size < size) {
4136                             Renew(PL_reg_poscache, size, char);
4137                             PL_reg_poscache_size = size;
4138                         }
4139                         Zero(PL_reg_poscache, size, char);
4140                     }
4141                     else {
4142                         PL_reg_poscache_size = size;
4143                         Newxz(PL_reg_poscache, size, char);
4144                     }
4145                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4146       "%swhilem: Detected a super-linear match, switching on caching%s...\n",
4147                               PL_colors[4], PL_colors[5])
4148                     );
4149                 }
4150
4151                 if (PL_reg_leftiter < 0) {
4152                     /* have we already failed at this position? */
4153                     I32 offset, mask;
4154                     offset  = (scan->flags & 0xf) - 1
4155                                 + (locinput - PL_bostr)  * (scan->flags>>4);
4156                     mask    = 1 << (offset % 8);
4157                     offset /= 8;
4158                     if (PL_reg_poscache[offset] & mask) {
4159                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4160                             "%*s  whilem: (cache) already tried at this position...\n",
4161                             REPORT_CODE_OFF+depth*2, "")
4162                         );
4163                         sayNO; /* cache records failure */
4164                     }
4165                     ST.cache_offset = offset;
4166                     ST.cache_mask   = mask;
4167                 }
4168             }
4169
4170             /* Prefer B over A for minimal matching. */
4171
4172             if (cur_curlyx->u.curlyx.minmod) {
4173                 ST.save_curlyx = cur_curlyx;
4174                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4175                 ST.cp = regcppush(ST.save_curlyx->u.curlyx.parenfloor);
4176                 REGCP_SET(ST.lastcp);
4177                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B);
4178                 /* NOTREACHED */
4179             }
4180
4181             /* Prefer A over B for maximal matching. */
4182
4183             if (n < cur_curlyx->u.curlyx.max) { /* More greed allowed? */
4184                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4185                 cur_curlyx->u.curlyx.lastloc = locinput;
4186                 REGCP_SET(ST.lastcp);
4187                 PUSH_STATE_GOTO(WHILEM_A_max, cur_curlyx->u.curlyx.A);
4188                 /* NOTREACHED */
4189             }
4190             goto do_whilem_B_max;
4191         }
4192         /* NOTREACHED */
4193
4194         case WHILEM_B_min: /* just matched B in a minimal match */
4195         case WHILEM_B_max: /* just matched B in a maximal match */
4196             cur_curlyx = ST.save_curlyx;
4197             sayYES;
4198             /* NOTREACHED */
4199
4200         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
4201             cur_curlyx = ST.save_curlyx;
4202             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4203             cur_curlyx->u.curlyx.count--;
4204             CACHEsayNO;
4205             /* NOTREACHED */
4206
4207         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
4208             REGCP_UNWIND(ST.lastcp);
4209             regcppop(rex);
4210             /* FALL THROUGH */
4211         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
4212             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4213             cur_curlyx->u.curlyx.count--;
4214             CACHEsayNO;
4215             /* NOTREACHED */
4216
4217         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
4218             REGCP_UNWIND(ST.lastcp);
4219             regcppop(rex);      /* Restore some previous $<digit>s? */
4220             PL_reginput = locinput;
4221             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4222                 "%*s  whilem: failed, trying continuation...\n",
4223                 REPORT_CODE_OFF+depth*2, "")
4224             );
4225           do_whilem_B_max:
4226             if (cur_curlyx->u.curlyx.count >= REG_INFTY
4227                 && ckWARN(WARN_REGEXP)
4228                 && !(PL_reg_flags & RF_warned))
4229             {
4230                 PL_reg_flags |= RF_warned;
4231                 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
4232                      "Complex regular subexpression recursion",
4233                      REG_INFTY - 1);
4234             }
4235
4236             /* now try B */
4237             ST.save_curlyx = cur_curlyx;
4238             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4239             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B);
4240             /* NOTREACHED */
4241
4242         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
4243             cur_curlyx = ST.save_curlyx;
4244             REGCP_UNWIND(ST.lastcp);
4245             regcppop(rex);
4246
4247             if (cur_curlyx->u.curlyx.count >= cur_curlyx->u.curlyx.max) {
4248                 /* Maximum greed exceeded */
4249                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
4250                     && ckWARN(WARN_REGEXP)
4251                     && !(PL_reg_flags & RF_warned))
4252                 {
4253                     PL_reg_flags |= RF_warned;
4254                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
4255                         "%s limit (%d) exceeded",
4256                         "Complex regular subexpression recursion",
4257                         REG_INFTY - 1);
4258                 }
4259                 cur_curlyx->u.curlyx.count--;
4260                 CACHEsayNO;
4261             }
4262
4263             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4264                 "%*s  trying longer...\n", REPORT_CODE_OFF+depth*2, "")
4265             );
4266             /* Try grabbing another A and see if it helps. */
4267             PL_reginput = locinput;
4268             cur_curlyx->u.curlyx.lastloc = locinput;
4269             ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4270             REGCP_SET(ST.lastcp);
4271             PUSH_STATE_GOTO(WHILEM_A_min, ST.save_curlyx->u.curlyx.A);
4272             /* NOTREACHED */
4273
4274 #undef  ST
4275 #define ST st->u.branch
4276
4277         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
4278             next = scan + ARG(scan);
4279             if (next == scan)
4280                 next = NULL;
4281             scan = NEXTOPER(scan);
4282             /* FALL THROUGH */
4283
4284         case BRANCH:        /*  /(...|A|...)/ */
4285             scan = NEXTOPER(scan); /* scan now points to inner node */
4286             ST.lastparen = *PL_reglastparen;
4287             ST.next_branch = next;
4288             REGCP_SET(ST.cp);
4289             PL_reginput = locinput;
4290
4291             /* Now go into the branch */
4292             if (has_cutgroup) {
4293                 PUSH_YES_STATE_GOTO(BRANCH_next, scan);
4294             } else {
4295                 PUSH_STATE_GOTO(BRANCH_next, scan);
4296             }
4297             /* NOTREACHED */
4298         case CUTGROUP:
4299             PL_reginput = locinput;
4300             sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
4301                 (SV*)rexi->data->data[ ARG( scan ) ];
4302             PUSH_STATE_GOTO(CUTGROUP_next,next);
4303             /* NOTREACHED */
4304         case CUTGROUP_next_fail:
4305             do_cutgroup = 1;
4306             no_final = 1;
4307             if (st->u.mark.mark_name)
4308                 sv_commit = st->u.mark.mark_name;
4309             sayNO;
4310             /* NOTREACHED */
4311         case BRANCH_next:
4312             sayYES;
4313             /* NOTREACHED */
4314         case BRANCH_next_fail: /* that branch failed; try the next, if any */
4315             if (do_cutgroup) {
4316                 do_cutgroup = 0;
4317                 no_final = 0;
4318             }
4319             REGCP_UNWIND(ST.cp);
4320             for (n = *PL_reglastparen; n > ST.lastparen; n--)
4321                 PL_regoffs[n].end = -1;
4322             *PL_reglastparen = n;
4323             /*dmq: *PL_reglastcloseparen = n; */
4324             scan = ST.next_branch;
4325             /* no more branches? */
4326             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
4327                 DEBUG_EXECUTE_r({
4328                     PerlIO_printf( Perl_debug_log,
4329                         "%*s  %sBRANCH failed...%s\n",
4330                         REPORT_CODE_OFF+depth*2, "",
4331                         PL_colors[4],
4332                         PL_colors[5] );
4333                 });
4334                 sayNO_SILENT;
4335             }
4336             continue; /* execute next BRANCH[J] op */
4337             /* NOTREACHED */
4338
4339         case MINMOD:
4340             minmod = 1;
4341             break;
4342
4343 #undef  ST
4344 #define ST st->u.curlym
4345
4346         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
4347
4348             /* This is an optimisation of CURLYX that enables us to push
4349              * only a single backtracking state, no matter now many matches
4350              * there are in {m,n}. It relies on the pattern being constant
4351              * length, with no parens to influence future backrefs
4352              */
4353
4354             ST.me = scan;
4355             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4356
4357             /* if paren positive, emulate an OPEN/CLOSE around A */
4358             if (ST.me->flags) {
4359                 U32 paren = ST.me->flags;
4360                 if (paren > PL_regsize)
4361                     PL_regsize = paren;
4362                 if (paren > *PL_reglastparen)
4363                     *PL_reglastparen = paren;
4364                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
4365             }
4366             ST.A = scan;
4367             ST.B = next;
4368             ST.alen = 0;
4369             ST.count = 0;
4370             ST.minmod = minmod;
4371             minmod = 0;
4372             ST.c1 = CHRTEST_UNINIT;
4373             REGCP_SET(ST.cp);
4374
4375             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
4376                 goto curlym_do_B;
4377
4378           curlym_do_A: /* execute the A in /A{m,n}B/  */
4379             PL_reginput = locinput;
4380             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
4381             /* NOTREACHED */
4382
4383         case CURLYM_A: /* we've just matched an A */
4384             locinput = st->locinput;
4385             nextchr = UCHARAT(locinput);
4386
4387             ST.count++;
4388             /* after first match, determine A's length: u.curlym.alen */
4389             if (ST.count == 1) {
4390                 if (PL_reg_match_utf8) {
4391                     char *s = locinput;
4392                     while (s < PL_reginput) {
4393                         ST.alen++;
4394                         s += UTF8SKIP(s);
4395                     }
4396                 }
4397                 else {
4398                     ST.alen = PL_reginput - locinput;
4399                 }
4400                 if (ST.alen == 0)
4401                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
4402             }
4403             DEBUG_EXECUTE_r(
4404                 PerlIO_printf(Perl_debug_log,
4405                           "%*s  CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
4406                           (int)(REPORT_CODE_OFF+(depth*2)), "",
4407                           (IV) ST.count, (IV)ST.alen)
4408             );
4409
4410             locinput = PL_reginput;
4411
4412             if (cur_eval && cur_eval->u.eval.close_paren &&
4413                 cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4414                 goto fake_end;
4415
4416             if ( ST.count < (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)) )
4417                 goto curlym_do_A; /* try to match another A */
4418             goto curlym_do_B; /* try to match B */
4419
4420         case CURLYM_A_fail: /* just failed to match an A */
4421             REGCP_UNWIND(ST.cp);
4422
4423             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/
4424                 || (cur_eval && cur_eval->u.eval.close_paren &&
4425                     cur_eval->u.eval.close_paren == (U32)ST.me->flags))
4426                 sayNO;
4427
4428           curlym_do_B: /* execute the B in /A{m,n}B/  */
4429             PL_reginput = locinput;
4430             if (ST.c1 == CHRTEST_UNINIT) {
4431                 /* calculate c1 and c2 for possible match of 1st char
4432                  * following curly */
4433                 ST.c1 = ST.c2 = CHRTEST_VOID;
4434                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
4435                     regnode *text_node = ST.B;
4436                     if (! HAS_TEXT(text_node))
4437                         FIND_NEXT_IMPT(text_node);
4438                     /* this used to be
4439
4440                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
4441
4442                         But the former is redundant in light of the latter.
4443
4444                         if this changes back then the macro for
4445                         IS_TEXT and friends need to change.
4446                      */
4447                     if (PL_regkind[OP(text_node)] == EXACT)
4448                     {
4449
4450                         ST.c1 = (U8)*STRING(text_node);
4451                         ST.c2 =
4452                             (IS_TEXTF(text_node))
4453                             ? PL_fold[ST.c1]
4454                             : (IS_TEXTFL(text_node))
4455                                 ? PL_fold_locale[ST.c1]
4456                                 : ST.c1;
4457                     }
4458                 }
4459             }
4460
4461             DEBUG_EXECUTE_r(
4462                 PerlIO_printf(Perl_debug_log,
4463                     "%*s  CURLYM trying tail with matches=%"IVdf"...\n",
4464                     (int)(REPORT_CODE_OFF+(depth*2)),
4465                     "", (IV)ST.count)
4466                 );
4467             if (ST.c1 != CHRTEST_VOID
4468                     && UCHARAT(PL_reginput) != ST.c1
4469                     && UCHARAT(PL_reginput) != ST.c2)
4470             {
4471                 /* simulate B failing */
4472                 DEBUG_OPTIMISE_r(
4473                     PerlIO_printf(Perl_debug_log,
4474                         "%*s  CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
4475                         (int)(REPORT_CODE_OFF+(depth*2)),"",
4476                         (IV)ST.c1,(IV)ST.c2
4477                 ));
4478                 state_num = CURLYM_B_fail;
4479                 goto reenter_switch;
4480             }
4481
4482             if (ST.me->flags) {
4483                 /* mark current A as captured */
4484                 I32 paren = ST.me->flags;
4485                 if (ST.count) {
4486                     PL_regoffs[paren].start
4487                         = HOPc(PL_reginput, -ST.alen) - PL_bostr;
4488                     PL_regoffs[paren].end = PL_reginput - PL_bostr;
4489                     /*dmq: *PL_reglastcloseparen = paren; */
4490                 }
4491                 else
4492                     PL_regoffs[paren].end = -1;
4493                 if (cur_eval && cur_eval->u.eval.close_paren &&
4494                     cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4495                 {
4496                     if (ST.count)
4497                         goto fake_end;
4498                     else
4499                         sayNO;
4500                 }
4501             }
4502
4503             PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
4504             /* NOTREACHED */
4505
4506         case CURLYM_B_fail: /* just failed to match a B */
4507             REGCP_UNWIND(ST.cp);
4508             if (ST.minmod) {
4509                 if (ST.count == ARG2(ST.me) /* max */)
4510                     sayNO;
4511                 goto curlym_do_A; /* try to match a further A */
4512             }
4513             /* backtrack one A */
4514             if (ST.count == ARG1(ST.me) /* min */)
4515                 sayNO;
4516             ST.count--;
4517             locinput = HOPc(locinput, -ST.alen);
4518             goto curlym_do_B; /* try to match B */
4519
4520 #undef ST
4521 #define ST st->u.curly
4522
4523 #define CURLY_SETPAREN(paren, success) \
4524     if (paren) { \
4525         if (success) { \
4526             PL_regoffs[paren].start = HOPc(locinput, -1) - PL_bostr; \
4527             PL_regoffs[paren].end = locinput - PL_bostr; \
4528             *PL_reglastcloseparen = paren; \
4529         } \
4530         else \
4531             PL_regoffs[paren].end = -1; \
4532     }
4533
4534         case STAR:              /*  /A*B/ where A is width 1 */
4535             ST.paren = 0;
4536             ST.min = 0;
4537             ST.max = REG_INFTY;
4538             scan = NEXTOPER(scan);
4539             goto repeat;
4540         case PLUS:              /*  /A+B/ where A is width 1 */
4541             ST.paren = 0;
4542             ST.min = 1;
4543             ST.max = REG_INFTY;
4544             scan = NEXTOPER(scan);
4545             goto repeat;
4546         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 */
4547             ST.paren = scan->flags;     /* Which paren to set */
4548             if (ST.paren > PL_regsize)
4549                 PL_regsize = ST.paren;
4550             if (ST.paren > *PL_reglastparen)
4551                 *PL_reglastparen = ST.paren;
4552             ST.min = ARG1(scan);  /* min to match */
4553             ST.max = ARG2(scan);  /* max to match */
4554             if (cur_eval && cur_eval->u.eval.close_paren &&
4555                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4556                 ST.min=1;
4557                 ST.max=1;
4558             }
4559             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
4560             goto repeat;
4561         case CURLY:             /*  /A{m,n}B/ where A is width 1 */
4562             ST.paren = 0;
4563             ST.min = ARG1(scan);  /* min to match */
4564             ST.max = ARG2(scan);  /* max to match */
4565             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4566           repeat:
4567             /*
4568             * Lookahead to avoid useless match attempts
4569             * when we know what character comes next.
4570             *
4571             * Used to only do .*x and .*?x, but now it allows
4572             * for )'s, ('s and (?{ ... })'s to be in the way
4573             * of the quantifier and the EXACT-like node.  -- japhy
4574             */
4575
4576             if (ST.min > ST.max) /* XXX make this a compile-time check? */
4577                 sayNO;
4578             if (HAS_TEXT(next) || JUMPABLE(next)) {
4579                 U8 *s;
4580                 regnode *text_node = next;
4581
4582                 if (! HAS_TEXT(text_node))
4583                     FIND_NEXT_IMPT(text_node);
4584
4585                 if (! HAS_TEXT(text_node))
4586                     ST.c1 = ST.c2 = CHRTEST_VOID;
4587                 else {
4588                     if ( PL_regkind[OP(text_node)] != EXACT ) {
4589                         ST.c1 = ST.c2 = CHRTEST_VOID;
4590                         goto assume_ok_easy;
4591                     }
4592                     else
4593                         s = (U8*)STRING(text_node);
4594
4595                     /*  Currently we only get here when
4596
4597                         PL_rekind[OP(text_node)] == EXACT
4598
4599                         if this changes back then the macro for IS_TEXT and
4600                         friends need to change. */
4601                     if (!UTF) {
4602                         ST.c2 = ST.c1 = *s;
4603                         if (IS_TEXTF(text_node))
4604                             ST.c2 = PL_fold[ST.c1];
4605                         else if (IS_TEXTFL(text_node))
4606                             ST.c2 = PL_fold_locale[ST.c1];
4607                     }
4608                     else { /* UTF */
4609                         if (IS_TEXTF(text_node)) {
4610                              STRLEN ulen1, ulen2;
4611                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4612                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4613
4614                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4615                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4616 #ifdef EBCDIC
4617                              ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
4618                                                     ckWARN(WARN_UTF8) ?
4619                                                     0 : UTF8_ALLOW_ANY);
4620                              ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
4621                                                     ckWARN(WARN_UTF8) ?
4622                                                     0 : UTF8_ALLOW_ANY);
4623 #else
4624                              ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4625                                                     uniflags);
4626                              ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4627                                                     uniflags);
4628 #endif
4629                         }
4630                         else {
4631                             ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4632                                                      uniflags);
4633                         }
4634                     }
4635                 }
4636             }
4637             else
4638                 ST.c1 = ST.c2 = CHRTEST_VOID;
4639         assume_ok_easy:
4640
4641             ST.A = scan;
4642             ST.B = next;
4643             PL_reginput = locinput;
4644             if (minmod) {
4645                 minmod = 0;
4646                 if (ST.min && regrepeat(rex, ST.A, ST.min, depth) < ST.min)
4647                     sayNO;
4648                 ST.count = ST.min;
4649                 locinput = PL_reginput;
4650                 REGCP_SET(ST.cp);
4651                 if (ST.c1 == CHRTEST_VOID)
4652                     goto curly_try_B_min;
4653
4654                 ST.oldloc = locinput;
4655
4656                 /* set ST.maxpos to the furthest point along the
4657                  * string that could possibly match */
4658                 if  (ST.max == REG_INFTY) {
4659                     ST.maxpos = PL_regeol - 1;
4660                     if (do_utf8)
4661                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
4662                             ST.maxpos--;
4663                 }
4664                 else if (do_utf8) {
4665                     int m = ST.max - ST.min;
4666                     for (ST.maxpos = locinput;
4667                          m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
4668                         ST.maxpos += UTF8SKIP(ST.maxpos);
4669                 }
4670                 else {
4671                     ST.maxpos = locinput + ST.max - ST.min;
4672                     if (ST.maxpos >= PL_regeol)
4673                         ST.maxpos = PL_regeol - 1;
4674                 }
4675                 goto curly_try_B_min_known;
4676
4677             }
4678             else {
4679                 ST.count = regrepeat(rex, ST.A, ST.max, depth);
4680                 locinput = PL_reginput;
4681                 if (ST.count < ST.min)
4682                     sayNO;
4683                 if ((ST.count > ST.min)
4684                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
4685                 {
4686                     /* A{m,n} must come at the end of the string, there's
4687                      * no point in backing off ... */
4688                     ST.min = ST.count;
4689                     /* ...except that $ and \Z can match before *and* after
4690                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4691                        We may back off by one in this case. */
4692                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
4693                         ST.min--;
4694                 }
4695                 REGCP_SET(ST.cp);
4696                 goto curly_try_B_max;
4697             }
4698             /* NOTREACHED */
4699
4700
4701         case CURLY_B_min_known_fail:
4702             /* failed to find B in a non-greedy match where c1,c2 valid */
4703             if (ST.paren && ST.count)
4704                 PL_regoffs[ST.paren].end = -1;
4705
4706             PL_reginput = locinput;     /* Could be reset... */
4707             REGCP_UNWIND(ST.cp);
4708             /* Couldn't or didn't -- move forward. */
4709             ST.oldloc = locinput;
4710             if (do_utf8)
4711                 locinput += UTF8SKIP(locinput);
4712             else
4713                 locinput++;
4714             ST.count++;
4715           curly_try_B_min_known:
4716              /* find the next place where 'B' could work, then call B */
4717             {
4718                 int n;
4719                 if (do_utf8) {
4720                     n = (ST.oldloc == locinput) ? 0 : 1;
4721                     if (ST.c1 == ST.c2) {
4722                         STRLEN len;
4723                         /* set n to utf8_distance(oldloc, locinput) */
4724                         while (locinput <= ST.maxpos &&
4725                                utf8n_to_uvchr((U8*)locinput,
4726                                               UTF8_MAXBYTES, &len,
4727                                               uniflags) != (UV)ST.c1) {
4728                             locinput += len;
4729                             n++;
4730                         }
4731                     }
4732                     else {
4733                         /* set n to utf8_distance(oldloc, locinput) */
4734                         while (locinput <= ST.maxpos) {
4735                             STRLEN len;
4736                             const UV c = utf8n_to_uvchr((U8*)locinput,
4737                                                   UTF8_MAXBYTES, &len,
4738                                                   uniflags);
4739                             if (c == (UV)ST.c1 || c == (UV)ST.c2)
4740                                 break;
4741                             locinput += len;
4742                             n++;
4743                         }
4744                     }
4745                 }
4746                 else {
4747                     if (ST.c1 == ST.c2) {
4748                         while (locinput <= ST.maxpos &&
4749                                UCHARAT(locinput) != ST.c1)
4750                             locinput++;
4751                     }
4752                     else {
4753                         while (locinput <= ST.maxpos
4754                                && UCHARAT(locinput) != ST.c1
4755                                && UCHARAT(locinput) != ST.c2)
4756                             locinput++;
4757                     }
4758                     n = locinput - ST.oldloc;
4759                 }
4760                 if (locinput > ST.maxpos)
4761                     sayNO;
4762                 /* PL_reginput == oldloc now */
4763                 if (n) {
4764                     ST.count += n;
4765                     if (regrepeat(rex, ST.A, n, depth) < n)
4766                         sayNO;
4767                 }
4768                 PL_reginput = locinput;
4769                 CURLY_SETPAREN(ST.paren, ST.count);
4770                 if (cur_eval && cur_eval->u.eval.close_paren &&
4771                     cur_eval->u.eval.close_paren == (U32)ST.paren) {
4772                     goto fake_end;
4773                 }
4774                 PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
4775             }
4776             /* NOTREACHED */
4777
4778
4779         case CURLY_B_min_fail:
4780             /* failed to find B in a non-greedy match where c1,c2 invalid */
4781             if (ST.paren && ST.count)
4782                 PL_regoffs[ST.paren].end = -1;
4783
4784             REGCP_UNWIND(ST.cp);
4785             /* failed -- move forward one */
4786             PL_reginput = locinput;
4787             if (regrepeat(rex, ST.A, 1, depth)) {
4788                 ST.count++;
4789                 locinput = PL_reginput;
4790                 if (ST.count <= ST.max || (ST.max == REG_INFTY &&
4791                         ST.count > 0)) /* count overflow ? */
4792                 {
4793                   curly_try_B_min:
4794                     CURLY_SETPAREN(ST.paren, ST.count);
4795                     if (cur_eval && cur_eval->u.eval.close_paren &&
4796                         cur_eval->u.eval.close_paren == (U32)ST.paren) {
4797                         goto fake_end;
4798                     }
4799                     PUSH_STATE_GOTO(CURLY_B_min, ST.B);
4800                 }
4801             }
4802             sayNO;
4803             /* NOTREACHED */
4804
4805
4806         curly_try_B_max:
4807             /* a successful greedy match: now try to match B */
4808             if (cur_eval && cur_eval->u.eval.close_paren &&
4809                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4810                 goto fake_end;
4811             }
4812             {
4813                 UV c = 0;
4814                 if (ST.c1 != CHRTEST_VOID)
4815                     c = do_utf8 ? utf8n_to_uvchr((U8*)PL_reginput,
4816                                            UTF8_MAXBYTES, 0, uniflags)
4817                                 : (UV) UCHARAT(PL_reginput);
4818                 /* If it could work, try it. */
4819                 if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
4820                     CURLY_SETPAREN(ST.paren, ST.count);
4821                     PUSH_STATE_GOTO(CURLY_B_max, ST.B);
4822                     /* NOTREACHED */
4823                 }
4824             }
4825             /* FALL THROUGH */
4826         case CURLY_B_max_fail:
4827             /* failed to find B in a greedy match */
4828             if (ST.paren && ST.count)
4829                 PL_regoffs[ST.paren].end = -1;
4830
4831             REGCP_UNWIND(ST.cp);
4832             /*  back up. */
4833             if (--ST.count < ST.min)
4834                 sayNO;
4835             PL_reginput = locinput = HOPc(locinput, -1);
4836             goto curly_try_B_max;
4837
4838 #undef ST
4839
4840         case END:
4841             fake_end:
4842             if (cur_eval) {
4843                 /* we've just finished A in /(??{A})B/; now continue with B */
4844                 I32 tmpix;
4845                 st->u.eval.toggle_reg_flags
4846                             = cur_eval->u.eval.toggle_reg_flags;
4847                 PL_reg_flags ^= st->u.eval.toggle_reg_flags;
4848
4849                 st->u.eval.prev_rex = rex_sv;           /* inner */
4850                 SETREX(rex_sv,cur_eval->u.eval.prev_rex);
4851                 rex = (struct regexp *)SvANY(rex_sv);
4852                 rexi = RXi_GET(rex);
4853                 cur_curlyx = cur_eval->u.eval.prev_curlyx;
4854                 ReREFCNT_inc(rex_sv);
4855                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
4856                 REGCP_SET(st->u.eval.lastcp);
4857                 PL_reginput = locinput;
4858
4859                 /* Restore parens of the outer rex without popping the
4860                  * savestack */
4861                 tmpix = PL_savestack_ix;
4862                 PL_savestack_ix = cur_eval->u.eval.lastcp;
4863                 regcppop(rex);
4864                 PL_savestack_ix = tmpix;
4865
4866                 st->u.eval.prev_eval = cur_eval;
4867                 cur_eval = cur_eval->u.eval.prev_eval;
4868                 DEBUG_EXECUTE_r(
4869                     PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
4870                                       REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
4871                 if ( nochange_depth )
4872                     nochange_depth--;
4873
4874                 PUSH_YES_STATE_GOTO(EVAL_AB,
4875                         st->u.eval.prev_eval->u.eval.B); /* match B */
4876             }
4877
4878             if (locinput < reginfo->till) {
4879                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4880                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4881                                       PL_colors[4],
4882                                       (long)(locinput - PL_reg_starttry),
4883                                       (long)(reginfo->till - PL_reg_starttry),
4884                                       PL_colors[5]));
4885
4886                 sayNO_SILENT;           /* Cannot match: too short. */
4887             }
4888             PL_reginput = locinput;     /* put where regtry can find it */
4889             sayYES;                     /* Success! */
4890
4891         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
4892             DEBUG_EXECUTE_r(
4893             PerlIO_printf(Perl_debug_log,
4894                 "%*s  %ssubpattern success...%s\n",
4895                 REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
4896             PL_reginput = locinput;     /* put where regtry can find it */
4897             sayYES;                     /* Success! */
4898
4899 #undef  ST
4900 #define ST st->u.ifmatch
4901
4902         case SUSPEND:   /* (?>A) */
4903             ST.wanted = 1;
4904             PL_reginput = locinput;
4905             goto do_ifmatch;
4906
4907         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
4908             ST.wanted = 0;
4909             goto ifmatch_trivial_fail_test;
4910
4911         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
4912             ST.wanted = 1;
4913           ifmatch_trivial_fail_test:
4914             if (scan->flags) {
4915                 char * const s = HOPBACKc(locinput, scan->flags);
4916                 if (!s) {
4917                     /* trivial fail */
4918                     if (logical) {
4919                         logical = 0;
4920                         sw = 1 - (bool)ST.wanted;
4921                     }
4922                     else if (ST.wanted)
4923                         sayNO;
4924                     next = scan + ARG(scan);
4925                     if (next == scan)
4926                         next = NULL;
4927                     break;
4928                 }
4929                 PL_reginput = s;
4930             }
4931             else
4932                 PL_reginput = locinput;
4933
4934           do_ifmatch:
4935             ST.me = scan;
4936             ST.logical = logical;
4937             /* execute body of (?...A) */
4938             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
4939             /* NOTREACHED */
4940
4941         case IFMATCH_A_fail: /* body of (?...A) failed */
4942             ST.wanted = !ST.wanted;
4943             /* FALL THROUGH */
4944
4945         case IFMATCH_A: /* body of (?...A) succeeded */
4946             if (ST.logical) {
4947                 sw = (bool)ST.wanted;
4948             }
4949             else if (!ST.wanted)
4950                 sayNO;
4951
4952             if (OP(ST.me) == SUSPEND)
4953                 locinput = PL_reginput;
4954             else {
4955                 locinput = PL_reginput = st->locinput;
4956                 nextchr = UCHARAT(locinput);
4957             }
4958             scan = ST.me + ARG(ST.me);
4959             if (scan == ST.me)
4960                 scan = NULL;
4961             continue; /* execute B */
4962
4963 #undef ST
4964
4965         case LONGJMP:
4966             next = scan + ARG(scan);
4967             if (next == scan)
4968                 next = NULL;
4969             break;
4970         case COMMIT:
4971             reginfo->cutpoint = PL_regeol;
4972             /* FALLTHROUGH */
4973         case PRUNE:
4974             PL_reginput = locinput;
4975             if (!scan->flags)
4976                 sv_yes_mark = sv_commit = (SV*)rexi->data->data[ ARG( scan ) ];
4977             PUSH_STATE_GOTO(COMMIT_next,next);
4978             /* NOTREACHED */
4979         case COMMIT_next_fail:
4980             no_final = 1;
4981             /* FALLTHROUGH */
4982         case OPFAIL:
4983             sayNO;
4984             /* NOTREACHED */
4985
4986 #define ST st->u.mark
4987         case MARKPOINT:
4988             ST.prev_mark = mark_state;
4989             ST.mark_name = sv_commit = sv_yes_mark
4990                 = (SV*)rexi->data->data[ ARG( scan ) ];
4991             mark_state = st;
4992             ST.mark_loc = PL_reginput = locinput;
4993             PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
4994             /* NOTREACHED */
4995         case MARKPOINT_next:
4996             mark_state = ST.prev_mark;
4997             sayYES;
4998             /* NOTREACHED */
4999         case MARKPOINT_next_fail:
5000             if (popmark && sv_eq(ST.mark_name,popmark))
5001             {
5002                 if (ST.mark_loc > startpoint)
5003                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5004                 popmark = NULL; /* we found our mark */
5005                 sv_commit = ST.mark_name;
5006
5007                 DEBUG_EXECUTE_r({
5008                         PerlIO_printf(Perl_debug_log,
5009                             "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
5010                             REPORT_CODE_OFF+depth*2, "",
5011                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
5012                 });
5013             }
5014             mark_state = ST.prev_mark;
5015             sv_yes_mark = mark_state ?
5016                 mark_state->u.mark.mark_name : NULL;
5017             sayNO;
5018             /* NOTREACHED */
5019         case SKIP:
5020             PL_reginput = locinput;
5021             if (scan->flags) {
5022                 /* (*SKIP) : if we fail we cut here*/
5023                 ST.mark_name = NULL;
5024                 ST.mark_loc = locinput;
5025                 PUSH_STATE_GOTO(SKIP_next,next);
5026             } else {
5027                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was,
5028                    otherwise do nothing.  Meaning we need to scan
5029                  */
5030                 regmatch_state *cur = mark_state;
5031                 SV *find = (SV*)rexi->data->data[ ARG( scan ) ];
5032
5033                 while (cur) {
5034                     if ( sv_eq( cur->u.mark.mark_name,
5035                                 find ) )
5036                     {
5037                         ST.mark_name = find;
5038                         PUSH_STATE_GOTO( SKIP_next, next );
5039                     }
5040                     cur = cur->u.mark.prev_mark;
5041                 }
5042             }
5043             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
5044             break;
5045         case SKIP_next_fail:
5046             if (ST.mark_name) {
5047                 /* (*CUT:NAME) - Set up to search for the name as we
5048                    collapse the stack*/
5049                 popmark = ST.mark_name;
5050             } else {
5051                 /* (*CUT) - No name, we cut here.*/
5052                 if (ST.mark_loc > startpoint)
5053                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5054                 /* but we set sv_commit to latest mark_name if there
5055                    is one so they can test to see how things lead to this
5056                    cut */
5057                 if (mark_state)
5058                     sv_commit=mark_state->u.mark.mark_name;
5059             }
5060             no_final = 1;
5061             sayNO;
5062             /* NOTREACHED */
5063 #undef ST
5064         case FOLDCHAR:
5065             n = ARG(scan);
5066             if ( n == (U32)what_len_TRICKYFOLD(locinput,do_utf8,ln) ) {
5067                 locinput += ln;
5068             } else if ( 0xDF == n && !do_utf8 && !UTF ) {
5069                 sayNO;
5070             } else  {
5071                 U8 folded[UTF8_MAXBYTES_CASE+1];
5072                 STRLEN foldlen;
5073                 const char * const l = locinput;
5074                 char *e = PL_regeol;
5075                 to_uni_fold(n, folded, &foldlen);
5076
5077                 if (ibcmp_utf8((const char*) folded, 0,  foldlen, 1,
5078                                l, &e, 0,  do_utf8)) {
5079                         sayNO;
5080                 }
5081                 locinput = e;
5082             }
5083             nextchr = UCHARAT(locinput);
5084             break;
5085         case LNBREAK:
5086             if ((n=is_LNBREAK(locinput,do_utf8))) {
5087                 locinput += n;
5088                 nextchr = UCHARAT(locinput);
5089             } else
5090                 sayNO;
5091             break;
5092
5093 #define CASE_CLASS(nAmE)                              \
5094         case nAmE:                                    \
5095             if ((n=is_##nAmE(locinput,do_utf8))) {    \
5096                 locinput += n;                        \
5097                 nextchr = UCHARAT(locinput);          \
5098             } else                                    \
5099                 sayNO;                                \
5100             break;                                    \
5101         case N##nAmE:                                 \
5102             if ((n=is_##nAmE(locinput,do_utf8))) {    \
5103                 sayNO;                                \
5104             } else {                                  \
5105                 locinput += UTF8SKIP(locinput);       \
5106                 nextchr = UCHARAT(locinput);          \
5107             }                                         \
5108             break
5109
5110         CASE_CLASS(VERTWS);
5111         CASE_CLASS(HORIZWS);
5112 #undef CASE_CLASS
5113
5114         default:
5115             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
5116                           PTR2UV(scan), OP(scan));
5117             Perl_croak(aTHX_ "regexp memory corruption");
5118
5119         } /* end switch */
5120
5121         /* switch break jumps here */
5122         scan = next; /* prepare to execute the next op and ... */
5123         continue;    /* ... jump back to the top, reusing st */
5124         /* NOTREACHED */
5125
5126       push_yes_state:
5127         /* push a state that backtracks on success */
5128         st->u.yes.prev_yes_state = yes_state;
5129         yes_state = st;
5130         /* FALL THROUGH */
5131       push_state:
5132         /* push a new regex state, then continue at scan  */
5133         {
5134             regmatch_state *newst;
5135
5136             DEBUG_STACK_r({
5137                 regmatch_state *cur = st;
5138                 regmatch_state *curyes = yes_state;
5139                 int curd = depth;
5140                 regmatch_slab *slab = PL_regmatch_slab;
5141                 for (;curd > -1;cur--,curd--) {
5142                     if (cur < SLAB_FIRST(slab)) {
5143                         slab = slab->prev;
5144                         cur = SLAB_LAST(slab);
5145                     }
5146                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
5147                         REPORT_CODE_OFF + 2 + depth * 2,"",
5148                         curd, PL_reg_name[cur->resume_state],
5149                         (curyes == cur) ? "yes" : ""
5150                     );
5151                     if (curyes == cur)
5152                         curyes = cur->u.yes.prev_yes_state;
5153                 }
5154             } else
5155                 DEBUG_STATE_pp("push")
5156             );
5157             depth++;
5158             st->locinput = locinput;
5159             newst = st+1;
5160             if (newst >  SLAB_LAST(PL_regmatch_slab))
5161                 newst = S_push_slab(aTHX);
5162             PL_regmatch_state = newst;
5163
5164             locinput = PL_reginput;
5165             nextchr = UCHARAT(locinput);
5166             st = newst;
5167             continue;
5168             /* NOTREACHED */
5169         }
5170     }
5171
5172     /*
5173     * We get here only if there's trouble -- normally "case END" is
5174     * the terminating point.
5175     */
5176     Perl_croak(aTHX_ "corrupted regexp pointers");
5177     /*NOTREACHED*/
5178     sayNO;
5179
5180 yes:
5181     if (yes_state) {
5182         /* we have successfully completed a subexpression, but we must now
5183          * pop to the state marked by yes_state and continue from there */
5184         assert(st != yes_state);
5185 #ifdef DEBUGGING
5186         while (st != yes_state) {
5187             st--;
5188             if (st < SLAB_FIRST(PL_regmatch_slab)) {
5189                 PL_regmatch_slab = PL_regmatch_slab->prev;
5190                 st = SLAB_LAST(PL_regmatch_slab);
5191             }
5192             DEBUG_STATE_r({
5193                 if (no_final) {
5194                     DEBUG_STATE_pp("pop (no final)");
5195                 } else {
5196                     DEBUG_STATE_pp("pop (yes)");
5197                 }
5198             });
5199             depth--;
5200         }
5201 #else
5202         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
5203             || yes_state > SLAB_LAST(PL_regmatch_slab))
5204         {
5205             /* not in this slab, pop slab */
5206             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
5207             PL_regmatch_slab = PL_regmatch_slab->prev;
5208             st = SLAB_LAST(PL_regmatch_slab);
5209         }
5210         depth -= (st - yes_state);
5211 #endif
5212         st = yes_state;
5213         yes_state = st->u.yes.prev_yes_state;
5214         PL_regmatch_state = st;
5215
5216         if (no_final) {
5217             locinput= st->locinput;
5218             nextchr = UCHARAT(locinput);
5219         }
5220         state_num = st->resume_state + no_final;
5221         goto reenter_switch;
5222     }
5223
5224     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
5225                           PL_colors[4], PL_colors[5]));
5226
5227     if (PL_reg_eval_set) {
5228         /* each successfully executed (?{...}) block does the equivalent of
5229          *   local $^R = do {...}
5230          * When popping the save stack, all these locals would be undone;
5231          * bypass this by setting the outermost saved $^R to the latest
5232          * value */
5233         if (oreplsv != GvSV(PL_replgv))
5234             sv_setsv(oreplsv, GvSV(PL_replgv));
5235     }
5236     result = 1;
5237     goto final_exit;
5238
5239 no:
5240     DEBUG_EXECUTE_r(
5241         PerlIO_printf(Perl_debug_log,
5242             "%*s  %sfailed...%s\n",
5243             REPORT_CODE_OFF+depth*2, "",
5244             PL_colors[4], PL_colors[5])
5245         );
5246
5247 no_silent:
5248     if (no_final) {
5249         if (yes_state) {
5250             goto yes;
5251         } else {
5252             goto final_exit;
5253         }
5254     }
5255     if (depth) {
5256         /* there's a previous state to backtrack to */
5257         st--;
5258         if (st < SLAB_FIRST(PL_regmatch_slab)) {
5259             PL_regmatch_slab = PL_regmatch_slab->prev;
5260             st = SLAB_LAST(PL_regmatch_slab);
5261         }
5262         PL_regmatch_state = st;
5263         locinput= st->locinput;
5264         nextchr = UCHARAT(locinput);
5265
5266         DEBUG_STATE_pp("pop");
5267         depth--;
5268         if (yes_state == st)
5269             yes_state = st->u.yes.prev_yes_state;
5270
5271         state_num = st->resume_state + 1; /* failure = success + 1 */
5272         goto reenter_switch;
5273     }
5274     result = 0;
5275
5276   final_exit:
5277     if (rex->intflags & PREGf_VERBARG_SEEN) {
5278         SV *sv_err = get_sv("REGERROR", 1);
5279         SV *sv_mrk = get_sv("REGMARK", 1);
5280         if (result) {
5281             sv_commit = &PL_sv_no;
5282             if (!sv_yes_mark)
5283                 sv_yes_mark = &PL_sv_yes;
5284         } else {
5285             if (!sv_commit)
5286                 sv_commit = &PL_sv_yes;
5287             sv_yes_mark = &PL_sv_no;
5288         }
5289         sv_setsv(sv_err, sv_commit);
5290         sv_setsv(sv_mrk, sv_yes_mark);
5291     }
5292
5293     /* clean up; in particular, free all slabs above current one */
5294     LEAVE_SCOPE(oldsave);
5295
5296     return result;
5297 }
5298
5299 /*
5300  - regrepeat - repeatedly match something simple, report how many
5301  */
5302 /*
5303  * [This routine now assumes that it will only match on things of length 1.
5304  * That was true before, but now we assume scan - reginput is the count,
5305  * rather than incrementing count on every character.  [Er, except utf8.]]
5306  */
5307 STATIC I32
5308 S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
5309 {
5310     dVAR;
5311     register char *scan;
5312     register I32 c;
5313     register char *loceol = PL_regeol;
5314     register I32 hardcount = 0;
5315     register bool do_utf8 = PL_reg_match_utf8;
5316 #ifndef DEBUGGING
5317     PERL_UNUSED_ARG(depth);
5318 #endif
5319
5320     scan = PL_reginput;
5321     if (max == REG_INFTY)
5322         max = I32_MAX;
5323     else if (max < loceol - scan)
5324         loceol = scan + max;
5325     switch (OP(p)) {
5326     case REG_ANY:
5327         if (do_utf8) {
5328             loceol = PL_regeol;
5329             while (scan < loceol && hardcount < max && *scan != '\n') {
5330                 scan += UTF8SKIP(scan);
5331                 hardcount++;
5332             }
5333         } else {
5334             while (scan < loceol && *scan != '\n')
5335                 scan++;
5336         }
5337         break;
5338     case SANY:
5339         if (do_utf8) {
5340             loceol = PL_regeol;
5341             while (scan < loceol && hardcount < max) {
5342                 scan += UTF8SKIP(scan);
5343                 hardcount++;
5344             }
5345         }
5346         else
5347             scan = loceol;
5348         break;
5349     case CANY:
5350         scan = loceol;
5351         break;
5352     case EXACT:         /* length of string is 1 */
5353         c = (U8)*STRING(p);
5354         while (scan < loceol && UCHARAT(scan) == c)
5355             scan++;
5356         break;
5357     case EXACTF:        /* length of string is 1 */
5358         c = (U8)*STRING(p);
5359         while (scan < loceol &&
5360                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
5361             scan++;
5362         break;
5363     case EXACTFL:       /* length of string is 1 */
5364         PL_reg_flags |= RF_tainted;
5365         c = (U8)*STRING(p);
5366         while (scan < loceol &&
5367                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
5368             scan++;
5369         break;
5370     case ANYOF:
5371         if (do_utf8) {
5372             loceol = PL_regeol;
5373             while (hardcount < max && scan < loceol &&
5374                    reginclass(prog, p, (U8*)scan, 0, do_utf8)) {
5375                 scan += UTF8SKIP(scan);
5376                 hardcount++;
5377             }
5378         } else {
5379             while (scan < loceol && REGINCLASS(prog, p, (U8*)scan))
5380                 scan++;
5381         }
5382         break;
5383     case ALNUM:
5384         if (do_utf8) {
5385             loceol = PL_regeol;
5386             LOAD_UTF8_CHARCLASS_ALNUM();
5387             while (hardcount < max && scan < loceol &&
5388                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5389                 scan += UTF8SKIP(scan);
5390                 hardcount++;
5391             }
5392         } else {
5393             while (scan < loceol && isALNUM(*scan))
5394                 scan++;
5395         }
5396         break;
5397     case ALNUML:
5398         PL_reg_flags |= RF_tainted;
5399         if (do_utf8) {
5400             loceol = PL_regeol;
5401             while (hardcount < max && scan < loceol &&
5402                    isALNUM_LC_utf8((U8*)scan)) {
5403                 scan += UTF8SKIP(scan);
5404                 hardcount++;
5405             }
5406         } else {
5407             while (scan < loceol && isALNUM_LC(*scan))
5408                 scan++;
5409         }
5410         break;
5411     case NALNUM:
5412         if (do_utf8) {
5413             loceol = PL_regeol;
5414             LOAD_UTF8_CHARCLASS_ALNUM();
5415             while (hardcount < max && scan < loceol &&
5416                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5417                 scan += UTF8SKIP(scan);
5418                 hardcount++;
5419             }
5420         } else {
5421             while (scan < loceol && !isALNUM(*scan))
5422                 scan++;
5423         }
5424         break;
5425     case NALNUML:
5426         PL_reg_flags |= RF_tainted;
5427         if (do_utf8) {
5428             loceol = PL_regeol;
5429             while (hardcount < max && scan < loceol &&
5430                    !isALNUM_LC_utf8((U8*)scan)) {
5431                 scan += UTF8SKIP(scan);
5432                 hardcount++;
5433             }
5434         } else {
5435             while (scan < loceol && !isALNUM_LC(*scan))
5436                 scan++;
5437         }
5438         break;
5439     case SPACE:
5440         if (do_utf8) {
5441             loceol = PL_regeol;
5442             LOAD_UTF8_CHARCLASS_SPACE();
5443             while (hardcount < max && scan < loceol &&
5444                    (*scan == ' ' ||
5445                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5446                 scan += UTF8SKIP(scan);
5447                 hardcount++;
5448             }
5449         } else {
5450             while (scan < loceol && isSPACE(*scan))
5451                 scan++;
5452         }
5453         break;
5454     case SPACEL:
5455         PL_reg_flags |= RF_tainted;
5456         if (do_utf8) {
5457             loceol = PL_regeol;
5458             while (hardcount < max && scan < loceol &&
5459                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5460                 scan += UTF8SKIP(scan);
5461                 hardcount++;
5462             }
5463         } else {
5464             while (scan < loceol && isSPACE_LC(*scan))
5465                 scan++;
5466         }
5467         break;
5468     case NSPACE:
5469         if (do_utf8) {
5470             loceol = PL_regeol;
5471             LOAD_UTF8_CHARCLASS_SPACE();
5472             while (hardcount < max && scan < loceol &&
5473                    !(*scan == ' ' ||
5474                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5475                 scan += UTF8SKIP(scan);
5476                 hardcount++;
5477             }
5478         } else {
5479             while (scan < loceol && !isSPACE(*scan))
5480                 scan++;
5481         }
5482         break;
5483     case NSPACEL:
5484         PL_reg_flags |= RF_tainted;
5485         if (do_utf8) {
5486             loceol = PL_regeol;
5487             while (hardcount < max && scan < loceol &&
5488                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5489                 scan += UTF8SKIP(scan);
5490                 hardcount++;
5491             }
5492         } else {
5493             while (scan < loceol && !isSPACE_LC(*scan))
5494                 scan++;
5495         }
5496         break;
5497     case DIGIT:
5498         if (do_utf8) {
5499             loceol = PL_regeol;
5500             LOAD_UTF8_CHARCLASS_DIGIT();
5501             while (hardcount < max && scan < loceol &&
5502                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5503                 scan += UTF8SKIP(scan);
5504                 hardcount++;
5505             }
5506         } else {
5507             while (scan < loceol && isDIGIT(*scan))
5508                 scan++;
5509         }
5510         break;
5511     case NDIGIT:
5512         if (do_utf8) {
5513             loceol = PL_regeol;
5514             LOAD_UTF8_CHARCLASS_DIGIT();
5515             while (hardcount < max && scan < loceol &&
5516                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5517                 scan += UTF8SKIP(scan);
5518                 hardcount++;
5519             }
5520         } else {
5521             while (scan < loceol && !isDIGIT(*scan))
5522                 scan++;
5523         }
5524     case LNBREAK:
5525         if (do_utf8) {
5526             loceol = PL_regeol;
5527             while (hardcount < max && scan < loceol && (c=is_LNBREAK_utf8(scan))) {
5528                 scan += c;
5529                 hardcount++;
5530             }
5531         } else {
5532             /*
5533               LNBREAK can match two latin chars, which is ok,
5534               because we have a null terminated string, but we
5535               have to use hardcount in this situation
5536             */
5537             while (scan < loceol && (c=is_LNBREAK_latin1(scan)))  {
5538                 scan+=c;
5539                 hardcount++;
5540             }
5541         }
5542         break;
5543     case HORIZWS:
5544         if (do_utf8) {
5545             loceol = PL_regeol;
5546             while (hardcount < max && scan < loceol && (c=is_HORIZWS_utf8(scan))) {
5547                 scan += c;
5548                 hardcount++;
5549             }
5550         } else {
5551             while (scan < loceol && is_HORIZWS_latin1(scan))
5552                 scan++;
5553         }
5554         break;
5555     case NHORIZWS:
5556         if (do_utf8) {
5557             loceol = PL_regeol;
5558             while (hardcount < max && scan < loceol && !is_HORIZWS_utf8(scan)) {
5559                 scan += UTF8SKIP(scan);
5560                 hardcount++;
5561             }
5562         } else {
5563             while (scan < loceol && !is_HORIZWS_latin1(scan))
5564                 scan++;
5565
5566         }
5567         break;
5568     case VERTWS:
5569         if (do_utf8) {
5570             loceol = PL_regeol;
5571             while (hardcount < max && scan < loceol && (c=is_VERTWS_utf8(scan))) {
5572                 scan += c;
5573                 hardcount++;
5574             }
5575         } else {
5576             while (scan < loceol && is_VERTWS_latin1(scan))
5577                 scan++;
5578
5579         }
5580         break;
5581     case NVERTWS:
5582         if (do_utf8) {
5583             loceol = PL_regeol;
5584             while (hardcount < max && scan < loceol && !is_VERTWS_utf8(scan)) {
5585                 scan += UTF8SKIP(scan);
5586                 hardcount++;
5587             }
5588         } else {
5589             while (scan < loceol && !is_VERTWS_latin1(scan))
5590                 scan++;
5591
5592         }
5593         break;
5594
5595     default:            /* Called on something of 0 width. */
5596         break;          /* So match right here or not at all. */
5597     }
5598
5599     if (hardcount)
5600         c = hardcount;
5601     else
5602         c = scan - PL_reginput;
5603     PL_reginput = scan;
5604
5605     DEBUG_r({
5606         GET_RE_DEBUG_FLAGS_DECL;
5607         DEBUG_EXECUTE_r({
5608             SV * const prop = sv_newmortal();
5609             regprop(prog, prop, p);
5610             PerlIO_printf(Perl_debug_log,
5611                         "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
5612                         REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
5613         });
5614     });
5615
5616     return(c);
5617 }
5618
5619
5620 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
5621 /*
5622 - regclass_swash - prepare the utf8 swash
5623 */
5624
5625 SV *
5626 Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
5627 {
5628     dVAR;
5629     SV *sw  = NULL;
5630     SV *si  = NULL;
5631     SV *alt = NULL;
5632     RXi_GET_DECL(prog,progi);
5633     const struct reg_data * const data = prog ? progi->data : NULL;
5634
5635     if (data && data->count) {
5636         const U32 n = ARG(node);
5637
5638         if (data->what[n] == 's') {
5639             SV * const rv = (SV*)data->data[n];
5640             AV * const av = (AV*)SvRV((SV*)rv);
5641             SV **const ary = AvARRAY(av);
5642             SV **a, **b;
5643
5644             /* See the end of regcomp.c:S_regclass() for
5645              * documentation of these array elements. */
5646
5647             si = *ary;
5648             a  = SvROK(ary[1]) ? &ary[1] : NULL;
5649             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : NULL;
5650
5651             if (a)
5652                 sw = *a;
5653             else if (si && doinit) {
5654                 sw = swash_init("utf8", "", si, 1, 0);
5655                 (void)av_store(av, 1, sw);
5656             }
5657             if (b)
5658                 alt = *b;
5659         }
5660     }
5661
5662     if (listsvp)
5663         *listsvp = si;
5664     if (altsvp)
5665         *altsvp  = alt;
5666
5667     return sw;
5668 }
5669 #endif
5670
5671 /*
5672  - reginclass - determine if a character falls into a character class
5673
5674   The n is the ANYOF regnode, the p is the target string, lenp
5675   is pointer to the maximum length of how far to go in the p
5676   (if the lenp is zero, UTF8SKIP(p) is used),
5677   do_utf8 tells whether the target string is in UTF-8.
5678
5679  */
5680
5681 STATIC bool
5682 S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
5683 {
5684     dVAR;
5685     const char flags = ANYOF_FLAGS(n);
5686     bool match = FALSE;
5687     UV c = *p;
5688     STRLEN len = 0;
5689     STRLEN plen;
5690
5691     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
5692         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
5693                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
5694                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
5695         if (len == (STRLEN)-1)
5696             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
5697     }
5698
5699     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
5700     if (do_utf8 || (flags & ANYOF_UNICODE)) {
5701         if (lenp)
5702             *lenp = 0;
5703         if (do_utf8 && !ANYOF_RUNTIME(n)) {
5704             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
5705                 match = TRUE;
5706         }
5707         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
5708             match = TRUE;
5709         if (!match) {
5710             AV *av;
5711             SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
5712
5713             if (sw) {
5714                 if (swash_fetch(sw, p, do_utf8))
5715                     match = TRUE;
5716                 else if (flags & ANYOF_FOLD) {
5717                     if (!match && lenp && av) {
5718                         I32 i;
5719                         for (i = 0; i <= av_len(av); i++) {
5720                             SV* const sv = *av_fetch(av, i, FALSE);
5721                             STRLEN len;
5722                             const char * const s = SvPV_const(sv, len);
5723
5724                             if (len <= plen && memEQ(s, (char*)p, len)) {
5725                                 *lenp = len;
5726                                 match = TRUE;
5727                                 break;
5728                             }
5729                         }
5730                     }
5731                     if (!match) {
5732                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
5733                         STRLEN tmplen;
5734
5735                         to_utf8_fold(p, tmpbuf, &tmplen);
5736                         if (swash_fetch(sw, tmpbuf, do_utf8))
5737                             match = TRUE;
5738                     }
5739                 }
5740             }
5741         }
5742         if (match && lenp && *lenp == 0)
5743             *lenp = UNISKIP(NATIVE_TO_UNI(c));
5744     }
5745     if (!match && c < 256) {
5746         if (ANYOF_BITMAP_TEST(n, c))
5747             match = TRUE;
5748         else if (flags & ANYOF_FOLD) {
5749             U8 f;
5750
5751             if (flags & ANYOF_LOCALE) {
5752                 PL_reg_flags |= RF_tainted;
5753                 f = PL_fold_locale[c];
5754             }
5755             else
5756                 f = PL_fold[c];
5757             if (f != c && ANYOF_BITMAP_TEST(n, f))
5758                 match = TRUE;
5759         }
5760
5761         if (!match && (flags & ANYOF_CLASS)) {
5762             PL_reg_flags |= RF_tainted;
5763             if (
5764                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
5765                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
5766                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
5767                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
5768                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
5769                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
5770                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
5771                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
5772                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
5773                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
5774                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
5775                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
5776                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
5777                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
5778                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
5779                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
5780                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
5781                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
5782                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
5783                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
5784                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
5785                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
5786                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
5787                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
5788                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
5789                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
5790                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
5791                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
5792                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
5793                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
5794                 ) /* How's that for a conditional? */
5795             {
5796                 match = TRUE;
5797             }
5798         }
5799     }
5800
5801     return (flags & ANYOF_INVERT) ? !match : match;
5802 }
5803
5804 STATIC U8 *
5805 S_reghop3(U8 *s, I32 off, const U8* lim)
5806 {
5807     dVAR;
5808     if (off >= 0) {
5809         while (off-- && s < lim) {
5810             /* XXX could check well-formedness here */
5811             s += UTF8SKIP(s);
5812         }
5813     }
5814     else {
5815         while (off++ && s > lim) {
5816             s--;
5817             if (UTF8_IS_CONTINUED(*s)) {
5818                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5819                     s--;
5820             }
5821             /* XXX could check well-formedness here */
5822         }
5823     }
5824     return s;
5825 }
5826
5827 #ifdef XXX_dmq
5828 /* there are a bunch of places where we use two reghop3's that should
5829    be replaced with this routine. but since thats not done yet
5830    we ifdef it out - dmq
5831 */
5832 STATIC U8 *
5833 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
5834 {
5835     dVAR;
5836     if (off >= 0) {
5837         while (off-- && s < rlim) {
5838             /* XXX could check well-formedness here */
5839             s += UTF8SKIP(s);
5840         }
5841     }
5842     else {
5843         while (off++ && s > llim) {
5844             s--;
5845             if (UTF8_IS_CONTINUED(*s)) {
5846                 while (s > llim && UTF8_IS_CONTINUATION(*s))
5847                     s--;
5848             }
5849             /* XXX could check well-formedness here */
5850         }
5851     }
5852     return s;
5853 }
5854 #endif
5855
5856 STATIC U8 *
5857 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
5858 {
5859     dVAR;
5860     if (off >= 0) {
5861         while (off-- && s < lim) {
5862             /* XXX could check well-formedness here */
5863             s += UTF8SKIP(s);
5864         }
5865         if (off >= 0)
5866             return NULL;
5867     }
5868     else {
5869         while (off++ && s > lim) {
5870             s--;
5871             if (UTF8_IS_CONTINUED(*s)) {
5872                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5873                     s--;
5874             }
5875             /* XXX could check well-formedness here */
5876         }
5877         if (off <= 0)
5878             return NULL;
5879     }
5880     return s;
5881 }
5882
5883 static void
5884 restore_pos(pTHX_ void *arg)
5885 {
5886     dVAR;
5887     regexp * const rex = (regexp *)arg;
5888     if (PL_reg_eval_set) {
5889         if (PL_reg_oldsaved) {
5890             rex->subbeg = PL_reg_oldsaved;
5891             rex->sublen = PL_reg_oldsavedlen;
5892 #ifdef PERL_OLD_COPY_ON_WRITE
5893             rex->saved_copy = PL_nrs;
5894 #endif
5895             RXp_MATCH_COPIED_on(rex);
5896         }
5897         PL_reg_magic->mg_len = PL_reg_oldpos;
5898         PL_reg_eval_set = 0;
5899         PL_curpm = PL_reg_oldcurpm;
5900     }
5901 }
5902
5903 STATIC void
5904 S_to_utf8_substr(pTHX_ register regexp *prog)
5905 {
5906     int i = 1;
5907     do {
5908         if (prog->substrs->data[i].substr
5909             && !prog->substrs->data[i].utf8_substr) {
5910             SV* const sv = newSVsv(prog->substrs->data[i].substr);
5911             prog->substrs->data[i].utf8_substr = sv;
5912             sv_utf8_upgrade(sv);
5913             if (SvVALID(prog->substrs->data[i].substr)) {
5914                 const U8 flags = BmFLAGS(prog->substrs->data[i].substr);
5915                 if (flags & FBMcf_TAIL) {
5916                     /* Trim the trailing \n that fbm_compile added last
5917                        time.  */
5918                     SvCUR_set(sv, SvCUR(sv) - 1);
5919                     /* Whilst this makes the SV technically "invalid" (as its
5920                        buffer is no longer followed by "\0") when fbm_compile()
5921                        adds the "\n" back, a "\0" is restored.  */
5922                 }
5923                 fbm_compile(sv, flags);
5924             }
5925             if (prog->substrs->data[i].substr == prog->check_substr)
5926                 prog->check_utf8 = sv;
5927         }
5928     } while (i--);
5929 }
5930
5931 STATIC void
5932 S_to_byte_substr(pTHX_ register regexp *prog)
5933 {
5934     dVAR;
5935     int i = 1;
5936     do {
5937         if (prog->substrs->data[i].utf8_substr
5938             && !prog->substrs->data[i].substr) {
5939             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
5940             if (sv_utf8_downgrade(sv, TRUE)) {
5941                 if (SvVALID(prog->substrs->data[i].utf8_substr)) {
5942                     const U8 flags
5943                         = BmFLAGS(prog->substrs->data[i].utf8_substr);
5944                     if (flags & FBMcf_TAIL) {
5945                         /* Trim the trailing \n that fbm_compile added last
5946                            time.  */
5947                         SvCUR_set(sv, SvCUR(sv) - 1);
5948                     }
5949                     fbm_compile(sv, flags);
5950                 }
5951             } else {
5952                 SvREFCNT_dec(sv);
5953                 sv = &PL_sv_undef;
5954             }
5955             prog->substrs->data[i].substr = sv;
5956             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
5957                 prog->check_substr = sv;
5958         }
5959     } while (i--);
5960 }
5961
5962 /*
5963  * Local variables:
5964  * c-indentation-style: bsd
5965  * c-basic-offset: 4
5966  * indent-tabs-mode: t
5967  * End:
5968  *
5969  * ex: set ts=8 sts=4 sw=4 noet:
5970  */