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