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