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