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