regexec.c

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