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
  43 #  define PERL_NO_GET_CONTEXT
  44 #endif
  45
  46 /*SUPPRESS 112*/
  47 /*
  48  * pregcomp and pregexec -- regsub and regerror are not used in perl
  49  *
  50  *      Copyright (c) 1986 by University of Toronto.
  51  *      Written by Henry Spencer.  Not derived from licensed software.
  52  *
  53  *      Permission is granted to anyone to use this software for any
  54  *      purpose on any computer system, and to redistribute it freely,
  55  *      subject to the following restrictions:
  56  *
  57  *      1. The author is not responsible for the consequences of use of
  58  *              this software, no matter how awful, even if they arise
  59  *              from defects in it.
  60  *
  61  *      2. The origin of this software must not be misrepresented, either
  62  *              by explicit claim or by omission.
  63  *
  64  *      3. Altered versions must be plainly marked as such, and must not
  65  *              be misrepresented as being the original software.
  66  *
  67  ****    Alterations to Henry's code are...
  68  ****
  69  ****    Copyright (c) 1991-1999, Larry Wall
  70  ****
  71  ****    You may distribute under the terms of either the GNU General Public
  72  ****    License or the Artistic License, as specified in the README file.
  73  *
  74  * Beware that some of this code is subtly aware of the way operator
  75  * precedence is structured in regular expressions.  Serious changes in
  76  * regular-expression syntax might require a total rethink.
  77  */
  78 #include "EXTERN.h"
  79 #define PERL_IN_REGEXEC_C
  80 #include "perl.h"
  81
  82 #ifdef PERL_IN_XSUB_RE
  83 #  if defined(PERL_CAPI) || defined(PERL_OBJECT)
  84 #    include "XSUB.h"
  85 #  endif
  86 #endif
  87
  88 #include "regcomp.h"
  89
  90 #define RF_tainted      1               /* tainted information used? */
  91 #define RF_warned       2               /* warned about big count? */
  92 #define RF_evaled       4               /* Did an EVAL with setting? */
  93 #define RF_utf8         8               /* String contains multibyte chars? */
  94
  95 #define UTF (PL_reg_flags & RF_utf8)
  96
  97 #define RS_init         1               /* eval environment created */
  98 #define RS_set          2               /* replsv value is set */
  99
 100 #ifndef STATIC
 101 #define STATIC  static
 102 #endif
 103
 104 /*
 105  * Forwards.
 106  */
 107
 108 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c) : ANYOF_BITMAP_TEST(p,c))
 109 #define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
 110
 111 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 112 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 113
 114 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 115 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
 116 #define HOP(pos,off) (UTF ? reghop((U8*)pos, off) : (U8*)(pos + off))
 117 #define HOPMAYBE(pos,off) (UTF ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 118 #define HOPc(pos,off) ((char*)HOP(pos,off))
 119 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 120
 121 static void restore_pos(pTHXo_ void *arg);
 122
 123
 124 STATIC CHECKPOINT
 125 S_regcppush(pTHX_ I32 parenfloor)
 126 {
 127     dTHR;
 128     int retval = PL_savestack_ix;
 129     int i = (PL_regsize - parenfloor) * 4;
 130     int p;
 131
 132     SSCHECK(i + 5);
 133     for (p = PL_regsize; p > parenfloor; p--) {
 134         SSPUSHINT(PL_regendp[p]);
 135         SSPUSHINT(PL_regstartp[p]);
 136         SSPUSHPTR(PL_reg_start_tmp[p]);
 137         SSPUSHINT(p);
 138     }
 139     SSPUSHINT(PL_regsize);
 140     SSPUSHINT(*PL_reglastparen);
 141     SSPUSHPTR(PL_reginput);
 142     SSPUSHINT(i + 3);
 143     SSPUSHINT(SAVEt_REGCONTEXT);
 144     return retval;
 145 }
 146
 147 /* These are needed since we do not localize EVAL nodes: */
 148 #  define REGCP_SET  DEBUG_r(PerlIO_printf(Perl_debug_log,              \
 149                              "  Setting an EVAL scope, savestack=%i\n", \
 150                              PL_savestack_ix)); lastcp = PL_savestack_ix
 151
 152 #  define REGCP_UNWIND  DEBUG_r(lastcp != PL_savestack_ix ?             \
 153                                 PerlIO_printf(Perl_debug_log,           \
 154                                 "  Clearing an EVAL scope, savestack=%i..%i\n", \
 155                                 lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
 156
 157 STATIC char *
 158 S_regcppop(pTHX)
 159 {
 160     dTHR;
 161     I32 i = SSPOPINT;
 162     U32 paren = 0;
 163     char *input;
 164     I32 tmps;
 165     assert(i == SAVEt_REGCONTEXT);
 166     i = SSPOPINT;
 167     input = (char *) SSPOPPTR;
 168     *PL_reglastparen = SSPOPINT;
 169     PL_regsize = SSPOPINT;
 170     for (i -= 3; i > 0; i -= 4) {
 171         paren = (U32)SSPOPINT;
 172         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 173         PL_regstartp[paren] = SSPOPINT;
 174         tmps = SSPOPINT;
 175         if (paren <= *PL_reglastparen)
 176             PL_regendp[paren] = tmps;
 177         DEBUG_r(
 178             PerlIO_printf(Perl_debug_log,
 179                           "     restoring \\%d to %d(%d)..%d%s\n",
 180                           paren, PL_regstartp[paren],
 181                           PL_reg_start_tmp[paren] - PL_bostr,
 182                           PL_regendp[paren],
 183                           (paren > *PL_reglastparen ? "(no)" : ""));
 184         );
 185     }
 186     DEBUG_r(
 187         if (*PL_reglastparen + 1 <= PL_regnpar) {
 188             PerlIO_printf(Perl_debug_log,
 189                           "     restoring \\%d..\\%d to undef\n",
 190                           *PL_reglastparen + 1, PL_regnpar);
 191         }
 192     );
 193     for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
 194         if (paren > PL_regsize)
 195             PL_regstartp[paren] = -1;
 196         PL_regendp[paren] = -1;
 197     }
 198     return input;
 199 }
 200
 201 STATIC char *
 202 S_regcp_set_to(pTHX_ I32 ss)
 203 {
 204     dTHR;
 205     I32 tmp = PL_savestack_ix;
 206
 207     PL_savestack_ix = ss;
 208     regcppop();
 209     PL_savestack_ix = tmp;
 210     return Nullch;
 211 }
 212
 213 typedef struct re_cc_state
 214 {
 215     I32 ss;
 216     regnode *node;
 217     struct re_cc_state *prev;
 218     CURCUR *cc;
 219     regexp *re;
 220 } re_cc_state;
 221
 222 #define regcpblow(cp) LEAVE_SCOPE(cp)
 223
 224 /*
 225  * pregexec and friends
 226  */
 227
 228 /*
 229  - pregexec - match a regexp against a string
 230  */
 231 I32
 232 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 233          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 234 /* strend: pointer to null at end of string */
 235 /* strbeg: real beginning of string */
 236 /* minend: end of match must be >=minend after stringarg. */
 237 /* nosave: For optimizations. */
 238 {
 239     return
 240         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 241                       nosave ? 0 : REXEC_COPY_STR);
 242 }
 243
 244 STATIC void
 245 S_cache_re(pTHX_ regexp *prog)
 246 {
 247     dTHR;
 248     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
 249 #ifdef DEBUGGING
 250     PL_regprogram = prog->program;
 251 #endif
 252     PL_regnpar = prog->nparens;
 253     PL_regdata = prog->data;
 254     PL_reg_re = prog;
 255 }
 256
 257 /*
 258  * Need to implement the following flags for reg_anch:
 259  *
 260  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 261  * USE_INTUIT_ML
 262  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 263  * INTUIT_AUTORITATIVE_ML
 264  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 265  * INTUIT_ONCE_ML
 266  *
 267  * Another flag for this function: SECOND_TIME (so that float substrs
 268  * with giant delta may be not rechecked).
 269  */
 270
 271 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 272
 273 /* If SCREAM, then SvPVX(sv) should be compatible with strpos and strend.
 274    Otherwise, only SvCUR(sv) is used to get strbeg. */
 275
 276 /* XXXX We assume that strpos is strbeg unless sv. */
 277
 278 /* A failure to find a constant substring means that there is no need to make
 279    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 280    finding a substring too deep into the string means that less calls to
 281    regtry() should be needed. */
 282
 283 char *
 284 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 285                      char *strend, U32 flags, re_scream_pos_data *data)
 286 {
 287     register I32 start_shift;
 288     /* Should be nonnegative! */
 289     register I32 end_shift;
 290     register char *s;
 291     register SV *check;
 292     char *t;
 293     I32 ml_anch;
 294     char *tmp;
 295     register char *other_last = Nullch;
 296
 297     DEBUG_r( if (!PL_colorset) reginitcolors() );
 298     DEBUG_r(PerlIO_printf(Perl_debug_log,
 299                       "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n",
 300                       PL_colors[4],PL_colors[5],PL_colors[0],
 301                       prog->precomp,
 302                       PL_colors[1],
 303                       (strlen(prog->precomp) > 60 ? "..." : ""),
 304                       PL_colors[0],
 305                       (strend - strpos > 60 ? 60 : strend - strpos),
 306                       strpos, PL_colors[1],
 307                       (strend - strpos > 60 ? "..." : ""))
 308         );
 309
 310     if (prog->minlen > strend - strpos) {
 311         DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n"));
 312         goto fail;
 313     }
 314     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
 315         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
 316                      || ( (prog->reganch & ROPT_ANCH_BOL)
 317                           && !PL_multiline ) ); /* Check after \n? */
 318
 319         if ((prog->check_offset_min == prog->check_offset_max) && !ml_anch) {
 320             /* Substring at constant offset from beg-of-str... */
 321             I32 slen;
 322
 323             if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */
 324                  && (sv && (strpos + SvCUR(sv) != strend)) ) {
 325                 DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 326                 goto fail;
 327             }
 328             PL_regeol = strend;                 /* Used in HOP() */
 329             s = HOPc(strpos, prog->check_offset_min);
 330             if (SvTAIL(prog->check_substr)) {
 331                 slen = SvCUR(prog->check_substr);       /* >= 1 */
 332
 333                 if ( strend - s > slen || strend - s < slen - 1
 334                      || (strend - s == slen && strend[-1] != '\n')) {
 335                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 336                     goto fail_finish;
 337                 }
 338                 /* Now should match s[0..slen-2] */
 339                 slen--;
 340                 if (slen && (*SvPVX(prog->check_substr) != *s
 341                              || (slen > 1
 342                                  && memNE(SvPVX(prog->check_substr), s, slen)))) {
 343                   report_neq:
 344                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 345                     goto fail_finish;
 346                 }
 347             }
 348             else if (*SvPVX(prog->check_substr) != *s
 349                      || ((slen = SvCUR(prog->check_substr)) > 1
 350                          && memNE(SvPVX(prog->check_substr), s, slen)))
 351                 goto report_neq;
 352             goto success_at_start;
 353         }
 354         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 355         s = strpos;
 356         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 357         /* Should be nonnegative! */
 358         end_shift = prog->minlen - start_shift -
 359             CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
 360         if (!ml_anch) {
 361             I32 end = prog->check_offset_max + CHR_SVLEN(prog->check_substr)
 362                                          - (SvTAIL(prog->check_substr) != 0);
 363             I32 eshift = strend - s - end;
 364
 365             if (end_shift < eshift)
 366                 end_shift = eshift;
 367         }
 368     }
 369     else {                              /* Can match at random position */
 370         ml_anch = 0;
 371         s = strpos;
 372         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 373         /* Should be nonnegative! */
 374         end_shift = prog->minlen - start_shift -
 375             CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
 376     }
 377
 378 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
 379     if (end_shift < 0)
 380         Perl_croak(aTHX_ "panic: end_shift");
 381 #endif
 382
 383     check = prog->check_substr;
 384   restart:
 385     /* Find a possible match in the region s..strend by looking for
 386        the "check" substring in the region corrected by start/end_shift. */
 387     if (flags & REXEC_SCREAM) {
 388         char *strbeg = SvPVX(sv);       /* XXXX Assume PV_force() on SCREAM! */
 389         I32 p = -1;                     /* Internal iterator of scream. */
 390         I32 *pp = data ? data->scream_pos : &p;
 391
 392         if (PL_screamfirst[BmRARE(check)] >= 0
 393             || ( BmRARE(check) == '\n'
 394                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 395                  && SvTAIL(check) ))
 396             s = screaminstr(sv, check,
 397                             start_shift + (s - strbeg), end_shift, pp, 0);
 398         else
 399             goto fail_finish;
 400         if (data)
 401             *data->scream_olds = s;
 402     }
 403     else
 404         s = fbm_instr((unsigned char*)s + start_shift,
 405                       (unsigned char*)strend - end_shift,
 406                       check, PL_multiline ? FBMrf_MULTILINE : 0);
 407
 408     /* Update the count-of-usability, remove useless subpatterns,
 409         unshift s.  */
 410
 411     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s %s substr `%s%.*s%s'%s%s",
 412                           (s ? "Found" : "Did not find"),
 413                           ((check == prog->anchored_substr) ? "anchored" : "floating"),
 414                           PL_colors[0],
 415                           SvCUR(check) - (SvTAIL(check)!=0), SvPVX(check),
 416                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
 417                           (s ? " at offset " : "...\n") ) );
 418
 419     if (!s)
 420         goto fail_finish;
 421
 422     /* Finish the diagnostic message */
 423     DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - strpos)) );
 424
 425     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 426        Start with the other substr.
 427        XXXX no SCREAM optimization yet - and a very coarse implementation
 428        XXXX /ttx+/ results in anchored=`ttx', floating=`x'.  floating will
 429                 *always* match.  Probably should be marked during compile...
 430        Probably it is right to do no SCREAM here...
 431      */
 432
 433     if (prog->float_substr && prog->anchored_substr) {
 434         /* Take into account the anchored substring. */
 435         /* XXXX May be hopelessly wrong for UTF... */
 436         if (!other_last)
 437             other_last = strpos - 1;
 438         if (check == prog->float_substr) {
 439                 char *last = s - start_shift, *last1, *last2;
 440                 char *s1 = s;
 441
 442                 tmp = PL_bostr;
 443                 t = s - prog->check_offset_max;
 444                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 445                     && (!(prog->reganch & ROPT_UTF8)
 446                         || (PL_bostr = strpos, /* Used in regcopmaybe() */
 447                             (t = reghopmaybe_c(s, -(prog->check_offset_max)))
 448                             && t > strpos)))
 449                     ;
 450                 else
 451                     t = strpos;
 452                 t += prog->anchored_offset;
 453                 if (t <= other_last)
 454                     t = other_last + 1;
 455                 PL_bostr = tmp;
 456                 last2 = last1 = strend - prog->minlen;
 457                 if (last < last1)
 458                     last1 = last;
 459  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 460                 /* On end-of-str: see comment below. */
 461                 s = fbm_instr((unsigned char*)t,
 462                               (unsigned char*)last1 + prog->anchored_offset
 463                                  + SvCUR(prog->anchored_substr)
 464                                  - (SvTAIL(prog->anchored_substr)!=0),
 465                               prog->anchored_substr, PL_multiline ? FBMrf_MULTILINE : 0);
 466                 DEBUG_r(PerlIO_printf(Perl_debug_log, "%s anchored substr `%s%.*s%s'%s",
 467                         (s ? "Found" : "Contradicts"),
 468                         PL_colors[0],
 469                           SvCUR(prog->anchored_substr)
 470                           - (SvTAIL(prog->anchored_substr)!=0),
 471                           SvPVX(prog->anchored_substr),
 472                           PL_colors[1], (SvTAIL(prog->anchored_substr) ? "$" : "")));
 473                 if (!s) {
 474                     if (last1 >= last2) {
 475                         DEBUG_r(PerlIO_printf(Perl_debug_log,
 476                                                 ", giving up...\n"));
 477                         goto fail_finish;
 478                     }
 479                     DEBUG_r(PerlIO_printf(Perl_debug_log,
 480                         ", trying floating at offset %ld...\n",
 481                         (long)(s1 + 1 - strpos)));
 482                     PL_regeol = strend;                 /* Used in HOP() */
 483                     other_last = last1 + prog->anchored_offset;
 484                     s = HOPc(last, 1);
 485                     goto restart;
 486                 }
 487                 else {
 488                     DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 489                           (long)(s - strpos)));
 490                     t = s - prog->anchored_offset;
 491                     other_last = s - 1;
 492                     if (t == strpos)
 493                         goto try_at_start;
 494                     s = s1;
 495                     goto try_at_offset;
 496                 }
 497         }
 498         else {          /* Take into account the floating substring. */
 499                 char *last, *last1;
 500                 char *s1 = s;
 501
 502                 t = s - start_shift;
 503                 last1 = last = strend - prog->minlen + prog->float_min_offset;
 504                 if (last - t > prog->float_max_offset)
 505                     last = t + prog->float_max_offset;
 506                 s = t + prog->float_min_offset;
 507                 if (s <= other_last)
 508                     s = other_last + 1;
 509  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 510                 /* fbm_instr() takes into account exact value of end-of-str
 511                    if the check is SvTAIL(ed).  Since false positives are OK,
 512                    and end-of-str is not later than strend we are OK. */
 513                 s = fbm_instr((unsigned char*)s,
 514                               (unsigned char*)last + SvCUR(prog->float_substr)
 515                                   - (SvTAIL(prog->float_substr)!=0),
 516                               prog->float_substr, PL_multiline ? FBMrf_MULTILINE : 0);
 517                 DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
 518                         (s ? "Found" : "Contradicts"),
 519                         PL_colors[0],
 520                           SvCUR(prog->float_substr)
 521                           - (SvTAIL(prog->float_substr)!=0),
 522                           SvPVX(prog->float_substr),
 523                           PL_colors[1], (SvTAIL(prog->float_substr) ? "$" : "")));
 524                 if (!s) {
 525                     if (last1 == last) {
 526                         DEBUG_r(PerlIO_printf(Perl_debug_log,
 527                                                 ", giving up...\n"));
 528                         goto fail_finish;
 529                     }
 530                     DEBUG_r(PerlIO_printf(Perl_debug_log,
 531                         ", trying anchored starting at offset %ld...\n",
 532                         (long)(s1 + 1 - strpos)));
 533                     other_last = last;
 534                     PL_regeol = strend;                 /* Used in HOP() */
 535                     s = HOPc(t, 1);
 536                     goto restart;
 537                 }
 538                 else {
 539                     DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 540                           (long)(s - strpos)));
 541                     other_last = s - 1;
 542                     if (t == strpos)
 543                         goto try_at_start;
 544                     s = s1;
 545                     goto try_at_offset;
 546                 }
 547         }
 548     }
 549
 550     t = s - prog->check_offset_max;
 551     tmp = PL_bostr;
 552     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 553         && (!(prog->reganch & ROPT_UTF8)
 554             || (PL_bostr = strpos, /* Used in regcopmaybe() */
 555                 ((t = reghopmaybe_c(s, -(prog->check_offset_max)))
 556                  && t > strpos)))) {
 557         PL_bostr = tmp;
 558         /* Fixed substring is found far enough so that the match
 559            cannot start at strpos. */
 560       try_at_offset:
 561         if (ml_anch && t[-1] != '\n') {
 562           find_anchor:          /* Eventually fbm_*() should handle this */
 563             while (t < strend - prog->minlen) {
 564                 if (*t == '\n') {
 565                     if (t < s - prog->check_offset_min) {
 566                         s = t + 1;
 567                         DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 568                             PL_colors[0],PL_colors[1], (long)(s - strpos)));
 569                         goto set_useful;
 570                     }
 571                     DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting at offset %ld...\n",
 572                         PL_colors[0],PL_colors[1], (long)(t + 1 - strpos)));
 573                     s = t + 1;
 574                     goto restart;
 575                 }
 576                 t++;
 577             }
 578             DEBUG_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 579                         PL_colors[0],PL_colors[1]));
 580             goto fail_finish;
 581         }
 582         s = t;
 583       set_useful:
 584         ++BmUSEFUL(prog->check_substr); /* hooray/5 */
 585     }
 586     else {
 587         PL_bostr = tmp;
 588         /* The found string does not prohibit matching at beg-of-str
 589            - no optimization of calling REx engine can be performed,
 590            unless it was an MBOL and we are not after MBOL. */
 591       try_at_start:
 592         /* Even in this situation we may use MBOL flag if strpos is offset
 593            wrt the start of the string. */
 594         if (ml_anch && sv
 595             && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n') {
 596             t = strpos;
 597             goto find_anchor;
 598         }
 599       success_at_start:
 600         if (!(prog->reganch & ROPT_NAUGHTY)
 601             && --BmUSEFUL(prog->check_substr) < 0
 602             && prog->check_substr == prog->float_substr) { /* boo */
 603             /* If flags & SOMETHING - do not do it many times on the same match */
 604             SvREFCNT_dec(prog->check_substr);
 605             prog->check_substr = Nullsv;        /* disable */
 606             prog->float_substr = Nullsv;        /* clear */
 607             s = strpos;
 608             prog->reganch &= ~RE_USE_INTUIT;
 609         }
 610         else
 611             s = strpos;
 612     }
 613
 614     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sGuessed:%s match at offset %ld\n",
 615                           PL_colors[4], PL_colors[5], (long)(s - strpos)) );
 616     return s;
 617
 618   fail_finish:                          /* Substring not found */
 619     BmUSEFUL(prog->check_substr) += 5;  /* hooray */
 620   fail:
 621     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 622                           PL_colors[4],PL_colors[5]));
 623     return Nullch;
 624 }
 625
 626 /*
 627  - regexec_flags - match a regexp against a string
 628  */
 629 I32
 630 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 631               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 632 /* strend: pointer to null at end of string */
 633 /* strbeg: real beginning of string */
 634 /* minend: end of match must be >=minend after stringarg. */
 635 /* data: May be used for some additional optimizations. */
 636 /* nosave: For optimizations. */
 637 {
 638     dTHR;
 639     register char *s;
 640     register regnode *c;
 641     register char *startpos = stringarg;
 642     register I32 tmp;
 643     I32 minlen;         /* must match at least this many chars */
 644     I32 dontbother = 0; /* how many characters not to try at end */
 645     CURCUR cc;
 646     I32 start_shift = 0;                /* Offset of the start to find
 647                                          constant substr. */            /* CC */
 648     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
 649     I32 scream_pos = -1;                /* Internal iterator of scream. */
 650     char *scream_olds;
 651     SV* oreplsv = GvSV(PL_replgv);
 652
 653     cc.cur = 0;
 654     cc.oldcc = 0;
 655     PL_regcc = &cc;
 656
 657     cache_re(prog);
 658 #ifdef DEBUGGING
 659     PL_regnarrate = PL_debug & 512;
 660 #endif
 661
 662     /* Be paranoid... */
 663     if (prog == NULL || startpos == NULL) {
 664         Perl_croak(aTHX_ "NULL regexp parameter");
 665         return 0;
 666     }
 667
 668     minlen = prog->minlen;
 669     if (strend - startpos < minlen) goto phooey;
 670
 671     if (startpos == strbeg)     /* is ^ valid at stringarg? */
 672         PL_regprev = '\n';
 673     else {
 674         PL_regprev = (U32)stringarg[-1];
 675         if (!PL_multiline && PL_regprev == '\n')
 676             PL_regprev = '\0';          /* force ^ to NOT match */
 677     }
 678
 679     /* Check validity of program. */
 680     if (UCHARAT(prog->program) != REG_MAGIC) {
 681         Perl_croak(aTHX_ "corrupted regexp program");
 682     }
 683
 684     PL_reg_flags = 0;
 685     PL_reg_eval_set = 0;
 686     PL_reg_maxiter = 0;
 687
 688     if (prog->reganch & ROPT_UTF8)
 689         PL_reg_flags |= RF_utf8;
 690
 691     /* Mark beginning of line for ^ and lookbehind. */
 692     PL_regbol = startpos;
 693     PL_bostr  = strbeg;
 694     PL_reg_sv = sv;
 695
 696     /* Mark end of line for $ (and such) */
 697     PL_regeol = strend;
 698
 699     /* see how far we have to get to not match where we matched before */
 700     PL_regtill = startpos+minend;
 701
 702     /* We start without call_cc context.  */
 703     PL_reg_call_cc = 0;
 704
 705     /* If there is a "must appear" string, look for it. */
 706     s = startpos;
 707
 708     if (prog->reganch & ROPT_GPOS_SEEN) {
 709         MAGIC *mg;
 710
 711         if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG
 712             && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
 713             PL_reg_ganch = strbeg + mg->mg_len;
 714         else
 715             PL_reg_ganch = startpos;
 716         if (prog->reganch & ROPT_ANCH_GPOS) {
 717             if (s > PL_reg_ganch)
 718                 goto phooey;
 719             s = PL_reg_ganch;
 720         }
 721     }
 722
 723     if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
 724         re_scream_pos_data d;
 725
 726         d.scream_olds = &scream_olds;
 727         d.scream_pos = &scream_pos;
 728         s = re_intuit_start(prog, sv, s, strend, flags, &d);
 729         if (!s)
 730             goto phooey;        /* not present */
 731     }
 732
 733     DEBUG_r( if (!PL_colorset) reginitcolors() );
 734     DEBUG_r(PerlIO_printf(Perl_debug_log,
 735                       "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
 736                       PL_colors[4],PL_colors[5],PL_colors[0],
 737                       prog->precomp,
 738                       PL_colors[1],
 739                       (strlen(prog->precomp) > 60 ? "..." : ""),
 740                       PL_colors[0],
 741                       (strend - startpos > 60 ? 60 : strend - startpos),
 742                       startpos, PL_colors[1],
 743                       (strend - startpos > 60 ? "..." : ""))
 744         );
 745
 746     /* Simplest case:  anchored match need be tried only once. */
 747     /*  [unless only anchor is BOL and multiline is set] */
 748     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
 749         if (s == startpos && regtry(prog, startpos))
 750             goto got_it;
 751         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
 752                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
 753         {
 754             char *end;
 755
 756             if (minlen)
 757                 dontbother = minlen - 1;
 758             end = HOPc(strend, -dontbother) - 1;
 759             /* for multiline we only have to try after newlines */
 760             if (prog->check_substr) {
 761                 while (1) {
 762                     if (regtry(prog, s))
 763                         goto got_it;
 764                     if (s >= end)
 765                         goto phooey;
 766                     s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
 767                     if (!s)
 768                         goto phooey;
 769                 }
 770             } else {
 771                 if (s > startpos)
 772                     s--;
 773                 while (s < end) {
 774                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
 775                         if (regtry(prog, s))
 776                             goto got_it;
 777                     }
 778                 }
 779             }
 780         }
 781         goto phooey;
 782     } else if (prog->reganch & ROPT_ANCH_GPOS) {
 783         if (regtry(prog, PL_reg_ganch))
 784             goto got_it;
 785         goto phooey;
 786     }
 787
 788     /* Messy cases:  unanchored match. */
 789     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
 790         /* we have /x+whatever/ */
 791         /* it must be a one character string (XXXX Except UTF?) */
 792         char ch = SvPVX(prog->anchored_substr)[0];
 793         if (UTF) {
 794             while (s < strend) {
 795                 if (*s == ch) {
 796                     if (regtry(prog, s)) goto got_it;
 797                     s += UTF8SKIP(s);
 798                     while (s < strend && *s == ch)
 799                         s += UTF8SKIP(s);
 800                 }
 801                 s += UTF8SKIP(s);
 802             }
 803         }
 804         else {
 805             while (s < strend) {
 806                 if (*s == ch) {
 807                     if (regtry(prog, s)) goto got_it;
 808                     s++;
 809                     while (s < strend && *s == ch)
 810                         s++;
 811                 }
 812                 s++;
 813             }
 814         }
 815     }
 816     /*SUPPRESS 560*/
 817     else if (prog->anchored_substr != Nullsv
 818              || (prog->float_substr != Nullsv
 819                  && prog->float_max_offset < strend - s)) {
 820         SV *must = prog->anchored_substr
 821             ? prog->anchored_substr : prog->float_substr;
 822         I32 back_max =
 823             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
 824         I32 back_min =
 825             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
 826         I32 delta = back_max - back_min;
 827         char *last = HOPc(strend,       /* Cannot start after this */
 828                           -(I32)(CHR_SVLEN(must)
 829                                  - (SvTAIL(must) != 0) + back_min));
 830         char *last1;            /* Last position checked before */
 831
 832         if (s > PL_bostr)
 833             last1 = HOPc(s, -1);
 834         else
 835             last1 = s - 1;      /* bogus */
 836
 837         /* XXXX check_substr already used to find `s', can optimize if
 838            check_substr==must. */
 839         scream_pos = -1;
 840         dontbother = end_shift;
 841         strend = HOPc(strend, -dontbother);
 842         while ( (s <= last) &&
 843                 ((flags & REXEC_SCREAM)
 844                  ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg,
 845                                     end_shift, &scream_pos, 0))
 846                  : (s = fbm_instr((unsigned char*)HOP(s, back_min),
 847                                   (unsigned char*)strend, must,
 848                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
 849             if (HOPc(s, -back_max) > last1) {
 850                 last1 = HOPc(s, -back_min);
 851                 s = HOPc(s, -back_max);
 852             }
 853             else {
 854                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
 855
 856                 last1 = HOPc(s, -back_min);
 857                 s = t;
 858             }
 859             if (UTF) {
 860                 while (s <= last1) {
 861                     if (regtry(prog, s))
 862                         goto got_it;
 863                     s += UTF8SKIP(s);
 864                 }
 865             }
 866             else {
 867                 while (s <= last1) {
 868                     if (regtry(prog, s))
 869                         goto got_it;
 870                     s++;
 871                 }
 872             }
 873         }
 874         goto phooey;
 875     }
 876     else if (c = prog->regstclass) {
 877         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 878         char *cc;
 879
 880         if (minlen)
 881             dontbother = minlen - 1;
 882         strend = HOPc(strend, -dontbother);     /* don't bother with what can't match */
 883         tmp = 1;
 884         /* We know what class it must start with. */
 885         switch (OP(c)) {
 886         case ANYOFUTF8:
 887             cc = MASK(c);
 888             while (s < strend) {
 889                 if (REGINCLASSUTF8(c, (U8*)s)) {
 890                     if (tmp && regtry(prog, s))
 891                         goto got_it;
 892                     else
 893                         tmp = doevery;
 894                 }
 895                 else
 896                     tmp = 1;
 897                 s += UTF8SKIP(s);
 898             }
 899             break;
 900         case ANYOF:
 901             cc = MASK(c);
 902             while (s < strend) {
 903                 if (REGINCLASS(cc, *s)) {
 904                     if (tmp && regtry(prog, s))
 905                         goto got_it;
 906                     else
 907                         tmp = doevery;
 908                 }
 909                 else
 910                     tmp = 1;
 911                 s++;
 912             }
 913             break;
 914         case BOUNDL:
 915             PL_reg_flags |= RF_tainted;
 916             /* FALL THROUGH */
 917         case BOUND:
 918             if (minlen) {
 919                 dontbother++;
 920                 strend -= 1;
 921             }
 922             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 923             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 924             while (s < strend) {
 925                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
 926                     tmp = !tmp;
 927                     if (regtry(prog, s))
 928                         goto got_it;
 929                 }
 930                 s++;
 931             }
 932             if ((minlen || tmp) && regtry(prog,s))
 933                 goto got_it;
 934             break;
 935         case BOUNDLUTF8:
 936             PL_reg_flags |= RF_tainted;
 937             /* FALL THROUGH */
 938         case BOUNDUTF8:
 939             if (minlen) {
 940                 dontbother++;
 941                 strend = reghop_c(strend, -1);
 942             }
 943             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 944             tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 945             while (s < strend) {
 946                 if (tmp == !(OP(c) == BOUND ?
 947                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 948                              isALNUM_LC_utf8((U8*)s)))
 949                 {
 950                     tmp = !tmp;
 951                     if (regtry(prog, s))
 952                         goto got_it;
 953                 }
 954                 s += UTF8SKIP(s);
 955             }
 956             if ((minlen || tmp) && regtry(prog,s))
 957                 goto got_it;
 958             break;
 959         case NBOUNDL:
 960             PL_reg_flags |= RF_tainted;
 961             /* FALL THROUGH */
 962         case NBOUND:
 963             if (minlen) {
 964                 dontbother++;
 965                 strend -= 1;
 966             }
 967             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 968             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 969             while (s < strend) {
 970                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
 971                     tmp = !tmp;
 972                 else if (regtry(prog, s))
 973                     goto got_it;
 974                 s++;
 975             }
 976             if ((minlen || !tmp) && regtry(prog,s))
 977                 goto got_it;
 978             break;
 979         case NBOUNDLUTF8:
 980             PL_reg_flags |= RF_tainted;
 981             /* FALL THROUGH */
 982         case NBOUNDUTF8:
 983             if (minlen) {
 984                 dontbother++;
 985                 strend = reghop_c(strend, -1);
 986             }
 987             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 988             tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 989             while (s < strend) {
 990                 if (tmp == !(OP(c) == NBOUND ?
 991                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 992                              isALNUM_LC_utf8((U8*)s)))
 993                     tmp = !tmp;
 994                 else if (regtry(prog, s))
 995                     goto got_it;
 996                 s += UTF8SKIP(s);
 997             }
 998             if ((minlen || !tmp) && regtry(prog,s))
 999                 goto got_it;
1000             break;
1001         case ALNUM:
1002             while (s < strend) {
1003                 if (isALNUM(*s)) {
1004                     if (tmp && regtry(prog, s))
1005                         goto got_it;
1006                     else
1007                         tmp = doevery;
1008                 }
1009                 else
1010                     tmp = 1;
1011                 s++;
1012             }
1013             break;
1014         case ALNUMUTF8:
1015             while (s < strend) {
1016                 if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
1017                     if (tmp && regtry(prog, s))
1018                         goto got_it;
1019                     else
1020                         tmp = doevery;
1021                 }
1022                 else
1023                     tmp = 1;
1024                 s += UTF8SKIP(s);
1025             }
1026             break;
1027         case ALNUML:
1028             PL_reg_flags |= RF_tainted;
1029             while (s < strend) {
1030                 if (isALNUM_LC(*s)) {
1031                     if (tmp && regtry(prog, s))
1032                         goto got_it;
1033                     else
1034                         tmp = doevery;
1035                 }
1036                 else
1037                     tmp = 1;
1038                 s++;
1039             }
1040             break;
1041         case ALNUMLUTF8:
1042             PL_reg_flags |= RF_tainted;
1043             while (s < strend) {
1044                 if (isALNUM_LC_utf8((U8*)s)) {
1045                     if (tmp && regtry(prog, s))
1046                         goto got_it;
1047                     else
1048                         tmp = doevery;
1049                 }
1050                 else
1051                     tmp = 1;
1052                 s += UTF8SKIP(s);
1053             }
1054             break;
1055         case NALNUM:
1056             while (s < strend) {
1057                 if (!isALNUM(*s)) {
1058                     if (tmp && regtry(prog, s))
1059                         goto got_it;
1060                     else
1061                         tmp = doevery;
1062                 }
1063                 else
1064                     tmp = 1;
1065                 s++;
1066             }
1067             break;
1068         case NALNUMUTF8:
1069             while (s < strend) {
1070                 if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
1071                     if (tmp && regtry(prog, s))
1072                         goto got_it;
1073                     else
1074                         tmp = doevery;
1075                 }
1076                 else
1077                     tmp = 1;
1078                 s += UTF8SKIP(s);
1079             }
1080             break;
1081         case NALNUML:
1082             PL_reg_flags |= RF_tainted;
1083             while (s < strend) {
1084                 if (!isALNUM_LC(*s)) {
1085                     if (tmp && regtry(prog, s))
1086                         goto got_it;
1087                     else
1088                         tmp = doevery;
1089                 }
1090                 else
1091                     tmp = 1;
1092                 s++;
1093             }
1094             break;
1095         case NALNUMLUTF8:
1096             PL_reg_flags |= RF_tainted;
1097             while (s < strend) {
1098                 if (!isALNUM_LC_utf8((U8*)s)) {
1099                     if (tmp && regtry(prog, s))
1100                         goto got_it;
1101                     else
1102                         tmp = doevery;
1103                 }
1104                 else
1105                     tmp = 1;
1106                 s += UTF8SKIP(s);
1107             }
1108             break;
1109         case SPACE:
1110             while (s < strend) {
1111                 if (isSPACE(*s)) {
1112                     if (tmp && regtry(prog, s))
1113                         goto got_it;
1114                     else
1115                         tmp = doevery;
1116                 }
1117                 else
1118                     tmp = 1;
1119                 s++;
1120             }
1121             break;
1122         case SPACEUTF8:
1123             while (s < strend) {
1124                 if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
1125                     if (tmp && regtry(prog, s))
1126                         goto got_it;
1127                     else
1128                         tmp = doevery;
1129                 }
1130                 else
1131                     tmp = 1;
1132                 s += UTF8SKIP(s);
1133             }
1134             break;
1135         case SPACEL:
1136             PL_reg_flags |= RF_tainted;
1137             while (s < strend) {
1138                 if (isSPACE_LC(*s)) {
1139                     if (tmp && regtry(prog, s))
1140                         goto got_it;
1141                     else
1142                         tmp = doevery;
1143                 }
1144                 else
1145                     tmp = 1;
1146                 s++;
1147             }
1148             break;
1149         case SPACELUTF8:
1150             PL_reg_flags |= RF_tainted;
1151             while (s < strend) {
1152                 if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1153                     if (tmp && regtry(prog, s))
1154                         goto got_it;
1155                     else
1156                         tmp = doevery;
1157                 }
1158                 else
1159                     tmp = 1;
1160                 s += UTF8SKIP(s);
1161             }
1162             break;
1163         case NSPACE:
1164             while (s < strend) {
1165                 if (!isSPACE(*s)) {
1166                     if (tmp && regtry(prog, s))
1167                         goto got_it;
1168                     else
1169                         tmp = doevery;
1170                 }
1171                 else
1172                     tmp = 1;
1173                 s++;
1174             }
1175             break;
1176         case NSPACEUTF8:
1177             while (s < strend) {
1178                 if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
1179                     if (tmp && regtry(prog, s))
1180                         goto got_it;
1181                     else
1182                         tmp = doevery;
1183                 }
1184                 else
1185                     tmp = 1;
1186                 s += UTF8SKIP(s);
1187             }
1188             break;
1189         case NSPACEL:
1190             PL_reg_flags |= RF_tainted;
1191             while (s < strend) {
1192                 if (!isSPACE_LC(*s)) {
1193                     if (tmp && regtry(prog, s))
1194                         goto got_it;
1195                     else
1196                         tmp = doevery;
1197                 }
1198                 else
1199                     tmp = 1;
1200                 s++;
1201             }
1202             break;
1203         case NSPACELUTF8:
1204             PL_reg_flags |= RF_tainted;
1205             while (s < strend) {
1206                 if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1207                     if (tmp && regtry(prog, s))
1208                         goto got_it;
1209                     else
1210                         tmp = doevery;
1211                 }
1212                 else
1213                     tmp = 1;
1214                 s += UTF8SKIP(s);
1215             }
1216             break;
1217         case DIGIT:
1218             while (s < strend) {
1219                 if (isDIGIT(*s)) {
1220                     if (tmp && regtry(prog, s))
1221                         goto got_it;
1222                     else
1223                         tmp = doevery;
1224                 }
1225                 else
1226                     tmp = 1;
1227                 s++;
1228             }
1229             break;
1230         case DIGITUTF8:
1231             while (s < strend) {
1232                 if (swash_fetch(PL_utf8_digit,(U8*)s)) {
1233                     if (tmp && regtry(prog, s))
1234                         goto got_it;
1235                     else
1236                         tmp = doevery;
1237                 }
1238                 else
1239                     tmp = 1;
1240                 s += UTF8SKIP(s);
1241             }
1242             break;
1243         case DIGITL:
1244             PL_reg_flags |= RF_tainted;
1245             while (s < strend) {
1246                 if (isDIGIT_LC(*s)) {
1247                     if (tmp && regtry(prog, s))
1248                         goto got_it;
1249                     else
1250                         tmp = doevery;
1251                 }
1252                 else
1253                     tmp = 1;
1254                 s++;
1255             }
1256             break;
1257         case DIGITLUTF8:
1258             PL_reg_flags |= RF_tainted;
1259             while (s < strend) {
1260                 if (isDIGIT_LC_utf8((U8*)s)) {
1261                     if (tmp && regtry(prog, s))
1262                         goto got_it;
1263                     else
1264                         tmp = doevery;
1265                 }
1266                 else
1267                     tmp = 1;
1268                 s += UTF8SKIP(s);
1269             }
1270             break;
1271         case NDIGIT:
1272             while (s < strend) {
1273                 if (!isDIGIT(*s)) {
1274                     if (tmp && regtry(prog, s))
1275                         goto got_it;
1276                     else
1277                         tmp = doevery;
1278                 }
1279                 else
1280                     tmp = 1;
1281                 s++;
1282             }
1283             break;
1284         case NDIGITUTF8:
1285             while (s < strend) {
1286                 if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
1287                     if (tmp && regtry(prog, s))
1288                         goto got_it;
1289                     else
1290                         tmp = doevery;
1291                 }
1292                 else
1293                     tmp = 1;
1294                 s += UTF8SKIP(s);
1295             }
1296             break;
1297         case NDIGITL:
1298             PL_reg_flags |= RF_tainted;
1299             while (s < strend) {
1300                 if (!isDIGIT_LC(*s)) {
1301                     if (tmp && regtry(prog, s))
1302                         goto got_it;
1303                     else
1304                         tmp = doevery;
1305                 }
1306                 else
1307                     tmp = 1;
1308                 s++;
1309             }
1310             break;
1311         case NDIGITLUTF8:
1312             PL_reg_flags |= RF_tainted;
1313             while (s < strend) {
1314                 if (!isDIGIT_LC_utf8((U8*)s)) {
1315                     if (tmp && regtry(prog, s))
1316                         goto got_it;
1317                     else
1318                         tmp = doevery;
1319                 }
1320                 else
1321                     tmp = 1;
1322                 s += UTF8SKIP(s);
1323             }
1324             break;
1325         }
1326     }
1327     else {
1328         dontbother = 0;
1329         if (prog->float_substr != Nullsv) {     /* Trim the end. */
1330             char *last;
1331             I32 oldpos = scream_pos;
1332
1333             if (flags & REXEC_SCREAM) {
1334                 last = screaminstr(sv, prog->float_substr, s - strbeg,
1335                                    end_shift, &scream_pos, 1); /* last one */
1336                 if (!last)
1337                     last = scream_olds; /* Only one occurence. */
1338             }
1339             else {
1340                 STRLEN len;
1341                 char *little = SvPV(prog->float_substr, len);
1342
1343                 if (SvTAIL(prog->float_substr)) {
1344                     if (memEQ(strend - len + 1, little, len - 1))
1345                         last = strend - len + 1;
1346                     else if (!PL_multiline)
1347                         last = memEQ(strend - len, little, len)
1348                             ? strend - len : Nullch;
1349                     else
1350                         goto find_last;
1351                 } else {
1352                   find_last:
1353                     if (len)
1354                         last = rninstr(s, strend, little, little + len);
1355                     else
1356                         last = strend;  /* matching `$' */
1357                 }
1358             }
1359             if (last == NULL) goto phooey; /* Should not happen! */
1360             dontbother = strend - last + prog->float_min_offset;
1361         }
1362         if (minlen && (dontbother < minlen))
1363             dontbother = minlen - 1;
1364         strend -= dontbother;              /* this one's always in bytes! */
1365         /* We don't know much -- general case. */
1366         if (UTF) {
1367             for (;;) {
1368                 if (regtry(prog, s))
1369                     goto got_it;
1370                 if (s >= strend)
1371                     break;
1372                 s += UTF8SKIP(s);
1373             };
1374         }
1375         else {
1376             do {
1377                 if (regtry(prog, s))
1378                     goto got_it;
1379             } while (s++ < strend);
1380         }
1381     }
1382
1383     /* Failure. */
1384     goto phooey;
1385
1386 got_it:
1387     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1388
1389     if (PL_reg_eval_set) {
1390         /* Preserve the current value of $^R */
1391         if (oreplsv != GvSV(PL_replgv))
1392             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1393                                                   restored, the value remains
1394                                                   the same. */
1395         restore_pos(aTHXo_ 0);
1396     }
1397
1398     /* make sure $`, $&, $', and $digit will work later */
1399     if ( !(flags & REXEC_NOT_FIRST) ) {
1400         if (RX_MATCH_COPIED(prog)) {
1401             Safefree(prog->subbeg);
1402             RX_MATCH_COPIED_off(prog);
1403         }
1404         if (flags & REXEC_COPY_STR) {
1405             I32 i = PL_regeol - startpos + (stringarg - strbeg);
1406
1407             s = savepvn(strbeg, i);
1408             prog->subbeg = s;
1409             prog->sublen = i;
1410             RX_MATCH_COPIED_on(prog);
1411         }
1412         else {
1413             prog->subbeg = strbeg;
1414             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
1415         }
1416     }
1417
1418     return 1;
1419
1420 phooey:
1421     if (PL_reg_eval_set)
1422         restore_pos(aTHXo_ 0);
1423     return 0;
1424 }
1425
1426 /*
1427  - regtry - try match at specific point
1428  */
1429 STATIC I32                      /* 0 failure, 1 success */
1430 S_regtry(pTHX_ regexp *prog, char *startpos)
1431 {
1432     dTHR;
1433     register I32 i;
1434     register I32 *sp;
1435     register I32 *ep;
1436     CHECKPOINT lastcp;
1437
1438     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1439         MAGIC *mg;
1440
1441         PL_reg_eval_set = RS_init;
1442         DEBUG_r(DEBUG_s(
1443             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
1444                           PL_stack_sp - PL_stack_base);
1445             ));
1446         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
1447         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1448         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1449         SAVETMPS;
1450         /* Apparently this is not needed, judging by wantarray. */
1451         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
1452            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1453
1454         if (PL_reg_sv) {
1455             /* Make $_ available to executed code. */
1456             if (PL_reg_sv != DEFSV) {
1457                 /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
1458                 SAVESPTR(DEFSV);
1459                 DEFSV = PL_reg_sv;
1460             }
1461
1462             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
1463                   && (mg = mg_find(PL_reg_sv, 'g')))) {
1464                 /* prepare for quick setting of pos */
1465                 sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0);
1466                 mg = mg_find(PL_reg_sv, 'g');
1467                 mg->mg_len = -1;
1468             }
1469             PL_reg_magic    = mg;
1470             PL_reg_oldpos   = mg->mg_len;
1471             SAVEDESTRUCTOR(restore_pos, 0);
1472         }
1473         if (!PL_reg_curpm)
1474             New(22,PL_reg_curpm, 1, PMOP);
1475         PL_reg_curpm->op_pmregexp = prog;
1476         PL_reg_oldcurpm = PL_curpm;
1477         PL_curpm = PL_reg_curpm;
1478         if (RX_MATCH_COPIED(prog)) {
1479             /*  Here is a serious problem: we cannot rewrite subbeg,
1480                 since it may be needed if this match fails.  Thus
1481                 $` inside (?{}) could fail... */
1482             PL_reg_oldsaved = prog->subbeg;
1483             PL_reg_oldsavedlen = prog->sublen;
1484             RX_MATCH_COPIED_off(prog);
1485         }
1486         else
1487             PL_reg_oldsaved = Nullch;
1488         prog->subbeg = PL_bostr;
1489         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
1490     }
1491     prog->startp[0] = startpos - PL_bostr;
1492     PL_reginput = startpos;
1493     PL_regstartp = prog->startp;
1494     PL_regendp = prog->endp;
1495     PL_reglastparen = &prog->lastparen;
1496     prog->lastparen = 0;
1497     PL_regsize = 0;
1498     DEBUG_r(PL_reg_starttry = startpos);
1499     if (PL_reg_start_tmpl <= prog->nparens) {
1500         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1501         if(PL_reg_start_tmp)
1502             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1503         else
1504             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1505     }
1506
1507     /* XXXX What this code is doing here?!!!  There should be no need
1508        to do this again and again, PL_reglastparen should take care of
1509        this!  */
1510     sp = prog->startp;
1511     ep = prog->endp;
1512     if (prog->nparens) {
1513         for (i = prog->nparens; i >= 1; i--) {
1514             *++sp = -1;
1515             *++ep = -1;
1516         }
1517     }
1518     REGCP_SET;
1519     if (regmatch(prog->program + 1)) {
1520         prog->endp[0] = PL_reginput - PL_bostr;
1521         return 1;
1522     }
1523     REGCP_UNWIND;
1524     return 0;
1525 }
1526
1527 /*
1528  - regmatch - main matching routine
1529  *
1530  * Conceptually the strategy is simple:  check to see whether the current
1531  * node matches, call self recursively to see whether the rest matches,
1532  * and then act accordingly.  In practice we make some effort to avoid
1533  * recursion, in particular by going through "ordinary" nodes (that don't
1534  * need to know whether the rest of the match failed) by a loop instead of
1535  * by recursion.
1536  */
1537 /* [lwall] I've hoisted the register declarations to the outer block in order to
1538  * maybe save a little bit of pushing and popping on the stack.  It also takes
1539  * advantage of machines that use a register save mask on subroutine entry.
1540  */
1541 STATIC I32                      /* 0 failure, 1 success */
1542 S_regmatch(pTHX_ regnode *prog)
1543 {
1544     dTHR;
1545     register regnode *scan;     /* Current node. */
1546     regnode *next;              /* Next node. */
1547     regnode *inner;             /* Next node in internal branch. */
1548     register I32 nextchr;       /* renamed nextchr - nextchar colides with
1549                                    function of same name */
1550     register I32 n;             /* no or next */
1551     register I32 ln;            /* len or last */
1552     register char *s;           /* operand or save */
1553     register char *locinput = PL_reginput;
1554     register I32 c1, c2, paren; /* case fold search, parenth */
1555     int minmod = 0, sw = 0, logical = 0;
1556 #ifdef DEBUGGING
1557     PL_regindent++;
1558 #endif
1559
1560     /* Note that nextchr is a byte even in UTF */
1561     nextchr = UCHARAT(locinput);
1562     scan = prog;
1563     while (scan != NULL) {
1564 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
1565 #ifdef DEBUGGING
1566 #  define sayYES goto yes
1567 #  define sayNO goto no
1568 #  define saySAME(x) if (x) goto yes; else goto no
1569 #  define REPORT_CODE_OFF 24
1570 #else
1571 #  define sayYES return 1
1572 #  define sayNO return 0
1573 #  define saySAME(x) return x
1574 #endif
1575         DEBUG_r( {
1576             SV *prop = sv_newmortal();
1577             int docolor = *PL_colors[0];
1578             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
1579             int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
1580             /* The part of the string before starttry has one color
1581                (pref0_len chars), between starttry and current
1582                position another one (pref_len - pref0_len chars),
1583                after the current position the third one.
1584                We assume that pref0_len <= pref_len, otherwise we
1585                decrease pref0_len.  */
1586             int pref_len = (locinput - PL_bostr > (5 + taill) - l
1587                             ? (5 + taill) - l : locinput - PL_bostr);
1588             int pref0_len = pref_len  - (locinput - PL_reg_starttry);
1589
1590             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
1591                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
1592                       ? (5 + taill) - pref_len : PL_regeol - locinput);
1593             if (pref0_len < 0)
1594                 pref0_len = 0;
1595             if (pref0_len > pref_len)
1596                 pref0_len = pref_len;
1597             regprop(prop, scan);
1598             PerlIO_printf(Perl_debug_log,
1599                           "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
1600                           locinput - PL_bostr,
1601                           PL_colors[4], pref0_len,
1602                           locinput - pref_len, PL_colors[5],
1603                           PL_colors[2], pref_len - pref0_len,
1604                           locinput - pref_len + pref0_len, PL_colors[3],
1605                           (docolor ? "" : "> <"),
1606                           PL_colors[0], l, locinput, PL_colors[1],
1607                           15 - l - pref_len + 1,
1608                           "",
1609                           scan - PL_regprogram, PL_regindent*2, "",
1610                           SvPVX(prop));
1611         } );
1612
1613         next = scan + NEXT_OFF(scan);
1614         if (next == scan)
1615             next = NULL;
1616
1617         switch (OP(scan)) {
1618         case BOL:
1619             if (locinput == PL_bostr
1620                 ? PL_regprev == '\n'
1621                 : (PL_multiline &&
1622                    (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1623             {
1624                 /* regtill = regbol; */
1625                 break;
1626             }
1627             sayNO;
1628         case MBOL:
1629             if (locinput == PL_bostr
1630                 ? PL_regprev == '\n'
1631                 : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1632             {
1633                 break;
1634             }
1635             sayNO;
1636         case SBOL:
1637             if (locinput == PL_regbol && PL_regprev == '\n')
1638                 break;
1639             sayNO;
1640         case GPOS:
1641             if (locinput == PL_reg_ganch)
1642                 break;
1643             sayNO;
1644         case EOL:
1645             if (PL_multiline)
1646                 goto meol;
1647             else
1648                 goto seol;
1649         case MEOL:
1650           meol:
1651             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1652                 sayNO;
1653             break;
1654         case SEOL:
1655           seol:
1656             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1657                 sayNO;
1658             if (PL_regeol - locinput > 1)
1659                 sayNO;
1660             break;
1661         case EOS:
1662             if (PL_regeol != locinput)
1663                 sayNO;
1664             break;
1665         case SANYUTF8:
1666             if (nextchr & 0x80) {
1667                 locinput += PL_utf8skip[nextchr];
1668                 if (locinput > PL_regeol)
1669                     sayNO;
1670                 nextchr = UCHARAT(locinput);
1671                 break;
1672             }
1673             if (!nextchr && locinput >= PL_regeol)
1674                 sayNO;
1675             nextchr = UCHARAT(++locinput);
1676             break;
1677         case SANY:
1678             if (!nextchr && locinput >= PL_regeol)
1679                 sayNO;
1680             nextchr = UCHARAT(++locinput);
1681             break;
1682         case ANYUTF8:
1683             if (nextchr & 0x80) {
1684                 locinput += PL_utf8skip[nextchr];
1685                 if (locinput > PL_regeol)
1686                     sayNO;
1687                 nextchr = UCHARAT(locinput);
1688                 break;
1689             }
1690             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1691                 sayNO;
1692             nextchr = UCHARAT(++locinput);
1693             break;
1694         case REG_ANY:
1695             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1696                 sayNO;
1697             nextchr = UCHARAT(++locinput);
1698             break;
1699         case EXACT:
1700             s = STRING(scan);
1701             ln = STR_LEN(scan);
1702             /* Inline the first character, for speed. */
1703             if (UCHARAT(s) != nextchr)
1704                 sayNO;
1705             if (PL_regeol - locinput < ln)
1706                 sayNO;
1707             if (ln > 1 && memNE(s, locinput, ln))
1708                 sayNO;
1709             locinput += ln;
1710             nextchr = UCHARAT(locinput);
1711             break;
1712         case EXACTFL:
1713             PL_reg_flags |= RF_tainted;
1714             /* FALL THROUGH */
1715         case EXACTF:
1716             s = STRING(scan);
1717             ln = STR_LEN(scan);
1718
1719             if (UTF) {
1720                 char *l = locinput;
1721                 char *e = s + ln;
1722                 c1 = OP(scan) == EXACTF;
1723                 while (s < e) {
1724                     if (l >= PL_regeol)
1725                         sayNO;
1726                     if (utf8_to_uv((U8*)s, 0) != (c1 ?
1727                                                   toLOWER_utf8((U8*)l) :
1728                                                   toLOWER_LC_utf8((U8*)l)))
1729                     {
1730                         sayNO;
1731                     }
1732                     s += UTF8SKIP(s);
1733                     l += UTF8SKIP(l);
1734                 }
1735                 locinput = l;
1736                 nextchr = UCHARAT(locinput);
1737                 break;
1738             }
1739
1740             /* Inline the first character, for speed. */
1741             if (UCHARAT(s) != nextchr &&
1742                 UCHARAT(s) != ((OP(scan) == EXACTF)
1743                                ? PL_fold : PL_fold_locale)[nextchr])
1744                 sayNO;
1745             if (PL_regeol - locinput < ln)
1746                 sayNO;
1747             if (ln > 1 && (OP(scan) == EXACTF
1748                            ? ibcmp(s, locinput, ln)
1749                            : ibcmp_locale(s, locinput, ln)))
1750                 sayNO;
1751             locinput += ln;
1752             nextchr = UCHARAT(locinput);
1753             break;
1754         case ANYOFUTF8:
1755             s = MASK(scan);
1756             if (!REGINCLASSUTF8(scan, (U8*)locinput))
1757                 sayNO;
1758             if (locinput >= PL_regeol)
1759                 sayNO;
1760             locinput += PL_utf8skip[nextchr];
1761             nextchr = UCHARAT(locinput);
1762             break;
1763         case ANYOF:
1764             s = MASK(scan);
1765             if (nextchr < 0)
1766                 nextchr = UCHARAT(locinput);
1767             if (!REGINCLASS(s, nextchr))
1768                 sayNO;
1769             if (!nextchr && locinput >= PL_regeol)
1770                 sayNO;
1771             nextchr = UCHARAT(++locinput);
1772             break;
1773         case ALNUML:
1774             PL_reg_flags |= RF_tainted;
1775             /* FALL THROUGH */
1776         case ALNUM:
1777             if (!nextchr)
1778                 sayNO;
1779             if (!(OP(scan) == ALNUM
1780                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1781                 sayNO;
1782             nextchr = UCHARAT(++locinput);
1783             break;
1784         case ALNUMLUTF8:
1785             PL_reg_flags |= RF_tainted;
1786             /* FALL THROUGH */
1787         case ALNUMUTF8:
1788             if (!nextchr)
1789                 sayNO;
1790             if (nextchr & 0x80) {
1791                 if (!(OP(scan) == ALNUMUTF8
1792                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1793                       : isALNUM_LC_utf8((U8*)locinput)))
1794                 {
1795                     sayNO;
1796                 }
1797                 locinput += PL_utf8skip[nextchr];
1798                 nextchr = UCHARAT(locinput);
1799                 break;
1800             }
1801             if (!(OP(scan) == ALNUMUTF8
1802                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1803                 sayNO;
1804             nextchr = UCHARAT(++locinput);
1805             break;
1806         case NALNUML:
1807             PL_reg_flags |= RF_tainted;
1808             /* FALL THROUGH */
1809         case NALNUM:
1810             if (!nextchr && locinput >= PL_regeol)
1811                 sayNO;
1812             if (OP(scan) == NALNUM
1813                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1814                 sayNO;
1815             nextchr = UCHARAT(++locinput);
1816             break;
1817         case NALNUMLUTF8:
1818             PL_reg_flags |= RF_tainted;
1819             /* FALL THROUGH */
1820         case NALNUMUTF8:
1821             if (!nextchr && locinput >= PL_regeol)
1822                 sayNO;
1823             if (nextchr & 0x80) {
1824                 if (OP(scan) == NALNUMUTF8
1825                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1826                     : isALNUM_LC_utf8((U8*)locinput))
1827                 {
1828                     sayNO;
1829                 }
1830                 locinput += PL_utf8skip[nextchr];
1831                 nextchr = UCHARAT(locinput);
1832                 break;
1833             }
1834             if (OP(scan) == NALNUMUTF8
1835                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1836                 sayNO;
1837             nextchr = UCHARAT(++locinput);
1838             break;
1839         case BOUNDL:
1840         case NBOUNDL:
1841             PL_reg_flags |= RF_tainted;
1842             /* FALL THROUGH */
1843         case BOUND:
1844         case NBOUND:
1845             /* was last char in word? */
1846             ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
1847             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
1848                 ln = isALNUM(ln);
1849                 n = isALNUM(nextchr);
1850             }
1851             else {
1852                 ln = isALNUM_LC(ln);
1853                 n = isALNUM_LC(nextchr);
1854             }
1855             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
1856                 sayNO;
1857             break;
1858         case BOUNDLUTF8:
1859         case NBOUNDLUTF8:
1860             PL_reg_flags |= RF_tainted;
1861             /* FALL THROUGH */
1862         case BOUNDUTF8:
1863         case NBOUNDUTF8:
1864             /* was last char in word? */
1865             ln = (locinput != PL_regbol)
1866                 ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
1867             if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
1868                 ln = isALNUM_uni(ln);
1869                 n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
1870             }
1871             else {
1872                 ln = isALNUM_LC_uni(ln);
1873                 n = isALNUM_LC_utf8((U8*)locinput);
1874             }
1875             if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
1876                 sayNO;
1877             break;
1878         case SPACEL:
1879             PL_reg_flags |= RF_tainted;
1880             /* FALL THROUGH */
1881         case SPACE:
1882             if (!nextchr && locinput >= PL_regeol)
1883                 sayNO;
1884             if (!(OP(scan) == SPACE
1885                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1886                 sayNO;
1887             nextchr = UCHARAT(++locinput);
1888             break;
1889         case SPACELUTF8:
1890             PL_reg_flags |= RF_tainted;
1891             /* FALL THROUGH */
1892         case SPACEUTF8:
1893             if (!nextchr && locinput >= PL_regeol)
1894                 sayNO;
1895             if (nextchr & 0x80) {
1896                 if (!(OP(scan) == SPACEUTF8
1897                       ? swash_fetch(PL_utf8_space,(U8*)locinput)
1898                       : isSPACE_LC_utf8((U8*)locinput)))
1899                 {
1900                     sayNO;
1901                 }
1902                 locinput += PL_utf8skip[nextchr];
1903                 nextchr = UCHARAT(locinput);
1904                 break;
1905             }
1906             if (!(OP(scan) == SPACEUTF8
1907                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1908                 sayNO;
1909             nextchr = UCHARAT(++locinput);
1910             break;
1911         case NSPACEL:
1912             PL_reg_flags |= RF_tainted;
1913             /* FALL THROUGH */
1914         case NSPACE:
1915             if (!nextchr)
1916                 sayNO;
1917             if (OP(scan) == SPACE
1918                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1919                 sayNO;
1920             nextchr = UCHARAT(++locinput);
1921             break;
1922         case NSPACELUTF8:
1923             PL_reg_flags |= RF_tainted;
1924             /* FALL THROUGH */
1925         case NSPACEUTF8:
1926             if (!nextchr)
1927                 sayNO;
1928             if (nextchr & 0x80) {
1929                 if (OP(scan) == NSPACEUTF8
1930                     ? swash_fetch(PL_utf8_space,(U8*)locinput)
1931                     : isSPACE_LC_utf8((U8*)locinput))
1932                 {
1933                     sayNO;
1934                 }
1935                 locinput += PL_utf8skip[nextchr];
1936                 nextchr = UCHARAT(locinput);
1937                 break;
1938             }
1939             if (OP(scan) == NSPACEUTF8
1940                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1941                 sayNO;
1942             nextchr = UCHARAT(++locinput);
1943             break;
1944         case DIGITL:
1945             PL_reg_flags |= RF_tainted;
1946             /* FALL THROUGH */
1947         case DIGIT:
1948             if (!nextchr && locinput >= PL_regeol)
1949                 sayNO;
1950             if (!(OP(scan) == DIGIT
1951                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
1952                 sayNO;
1953             nextchr = UCHARAT(++locinput);
1954             break;
1955         case DIGITLUTF8:
1956             PL_reg_flags |= RF_tainted;
1957             /* FALL THROUGH */
1958         case DIGITUTF8:
1959             if (!nextchr)
1960                 sayNO;
1961             if (nextchr & 0x80) {
1962                 if (OP(scan) == NDIGITUTF8
1963                     ? swash_fetch(PL_utf8_digit,(U8*)locinput)
1964                     : isDIGIT_LC_utf8((U8*)locinput))
1965                 {
1966                     sayNO;
1967                 }
1968                 locinput += PL_utf8skip[nextchr];
1969                 nextchr = UCHARAT(locinput);
1970                 break;
1971             }
1972             if (!isDIGIT(nextchr))
1973                 sayNO;
1974             nextchr = UCHARAT(++locinput);
1975             break;
1976         case NDIGITL:
1977             PL_reg_flags |= RF_tainted;
1978             /* FALL THROUGH */
1979         case NDIGIT:
1980             if (!nextchr)
1981                 sayNO;
1982             if (OP(scan) == DIGIT
1983                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
1984                 sayNO;
1985             nextchr = UCHARAT(++locinput);
1986             break;
1987         case NDIGITLUTF8:
1988             PL_reg_flags |= RF_tainted;
1989             /* FALL THROUGH */
1990         case NDIGITUTF8:
1991             if (!nextchr && locinput >= PL_regeol)
1992                 sayNO;
1993             if (nextchr & 0x80) {
1994                 if (swash_fetch(PL_utf8_digit,(U8*)locinput))
1995                     sayNO;
1996                 locinput += PL_utf8skip[nextchr];
1997                 nextchr = UCHARAT(locinput);
1998                 break;
1999             }
2000             if (isDIGIT(nextchr))
2001                 sayNO;
2002             nextchr = UCHARAT(++locinput);
2003             break;
2004         case CLUMP:
2005             if (locinput >= PL_regeol || swash_fetch(PL_utf8_mark,(U8*)locinput))
2006                 sayNO;
2007             locinput += PL_utf8skip[nextchr];
2008             while (locinput < PL_regeol && swash_fetch(PL_utf8_mark,(U8*)locinput))
2009                 locinput += UTF8SKIP(locinput);
2010             if (locinput > PL_regeol)
2011                 sayNO;
2012             nextchr = UCHARAT(locinput);
2013             break;
2014         case REFFL:
2015             PL_reg_flags |= RF_tainted;
2016             /* FALL THROUGH */
2017         case REF:
2018         case REFF:
2019             n = ARG(scan);  /* which paren pair */
2020             ln = PL_regstartp[n];
2021             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2022             if (*PL_reglastparen < n || ln == -1)
2023                 sayNO;                  /* Do not match unless seen CLOSEn. */
2024             if (ln == PL_regendp[n])
2025                 break;
2026
2027             s = PL_bostr + ln;
2028             if (UTF && OP(scan) != REF) {       /* REF can do byte comparison */
2029                 char *l = locinput;
2030                 char *e = PL_bostr + PL_regendp[n];
2031                 /*
2032                  * Note that we can't do the "other character" lookup trick as
2033                  * in the 8-bit case (no pun intended) because in Unicode we
2034                  * have to map both upper and title case to lower case.
2035                  */
2036                 if (OP(scan) == REFF) {
2037                     while (s < e) {
2038                         if (l >= PL_regeol)
2039                             sayNO;
2040                         if (toLOWER_utf8((U8*)s) != toLOWER_utf8((U8*)l))
2041                             sayNO;
2042                         s += UTF8SKIP(s);
2043                         l += UTF8SKIP(l);
2044                     }
2045                 }
2046                 else {
2047                     while (s < e) {
2048                         if (l >= PL_regeol)
2049                             sayNO;
2050                         if (toLOWER_LC_utf8((U8*)s) != toLOWER_LC_utf8((U8*)l))
2051                             sayNO;
2052                         s += UTF8SKIP(s);
2053                         l += UTF8SKIP(l);
2054                     }
2055                 }
2056                 locinput = l;
2057                 nextchr = UCHARAT(locinput);
2058                 break;
2059             }
2060
2061             /* Inline the first character, for speed. */
2062             if (UCHARAT(s) != nextchr &&
2063                 (OP(scan) == REF ||
2064                  (UCHARAT(s) != ((OP(scan) == REFF
2065                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2066                 sayNO;
2067             ln = PL_regendp[n] - ln;
2068             if (locinput + ln > PL_regeol)
2069                 sayNO;
2070             if (ln > 1 && (OP(scan) == REF
2071                            ? memNE(s, locinput, ln)
2072                            : (OP(scan) == REFF
2073                               ? ibcmp(s, locinput, ln)
2074                               : ibcmp_locale(s, locinput, ln))))
2075                 sayNO;
2076             locinput += ln;
2077             nextchr = UCHARAT(locinput);
2078             break;
2079
2080         case NOTHING:
2081         case TAIL:
2082             break;
2083         case BACK:
2084             break;
2085         case EVAL:
2086         {
2087             dSP;
2088             OP_4tree *oop = PL_op;
2089             COP *ocurcop = PL_curcop;
2090             SV **ocurpad = PL_curpad;
2091             SV *ret;
2092
2093             n = ARG(scan);
2094             PL_op = (OP_4tree*)PL_regdata->data[n];
2095             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", PL_op) );
2096             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2097             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2098
2099             CALLRUNOPS(aTHX);                   /* Scalar context. */
2100             SPAGAIN;
2101             ret = POPs;
2102             PUTBACK;
2103
2104             PL_op = oop;
2105             PL_curpad = ocurpad;
2106             PL_curcop = ocurcop;
2107             if (logical) {
2108                 if (logical == 2) {     /* Postponed subexpression. */
2109                     regexp *re;
2110                     MAGIC *mg = Null(MAGIC*);
2111                     re_cc_state state;
2112                     CURCUR cctmp;
2113                     CHECKPOINT cp, lastcp;
2114
2115                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2116                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2117
2118                         if(SvMAGICAL(sv))
2119                             mg = mg_find(sv, 'r');
2120                     }
2121                     if (mg) {
2122                         re = (regexp *)mg->mg_obj;
2123                         (void)ReREFCNT_inc(re);
2124                     }
2125                     else {
2126                         STRLEN len;
2127                         char *t = SvPV(ret, len);
2128                         PMOP pm;
2129                         char *oprecomp = PL_regprecomp;
2130                         I32 osize = PL_regsize;
2131                         I32 onpar = PL_regnpar;
2132
2133                         pm.op_pmflags = 0;
2134                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2135                         if (!(SvFLAGS(ret)
2136                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2137                             sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0);
2138                         PL_regprecomp = oprecomp;
2139                         PL_regsize = osize;
2140                         PL_regnpar = onpar;
2141                     }
2142                     DEBUG_r(
2143                         PerlIO_printf(Perl_debug_log,
2144                                       "Entering embedded `%s%.60s%s%s'\n",
2145                                       PL_colors[0],
2146                                       re->precomp,
2147                                       PL_colors[1],
2148                                       (strlen(re->precomp) > 60 ? "..." : ""))
2149                         );
2150                     state.node = next;
2151                     state.prev = PL_reg_call_cc;
2152                     state.cc = PL_regcc;
2153                     state.re = PL_reg_re;
2154
2155                     cctmp.cur = 0;
2156                     cctmp.oldcc = 0;
2157                     PL_regcc = &cctmp;
2158
2159                     cp = regcppush(0);  /* Save *all* the positions. */
2160                     REGCP_SET;
2161                     cache_re(re);
2162                     state.ss = PL_savestack_ix;
2163                     *PL_reglastparen = 0;
2164                     PL_reg_call_cc = &state;
2165                     PL_reginput = locinput;
2166
2167                     /* XXXX This is too dramatic a measure... */
2168                     PL_reg_maxiter = 0;
2169
2170                     if (regmatch(re->program + 1)) {
2171                         ReREFCNT_dec(re);
2172                         regcpblow(cp);
2173                         sayYES;
2174                     }
2175                     DEBUG_r(
2176                         PerlIO_printf(Perl_debug_log,
2177                                       "%*s  failed...\n",
2178                                       REPORT_CODE_OFF+PL_regindent*2, "")
2179                         );
2180                     ReREFCNT_dec(re);
2181                     REGCP_UNWIND;
2182                     regcppop();
2183                     PL_reg_call_cc = state.prev;
2184                     PL_regcc = state.cc;
2185                     PL_reg_re = state.re;
2186                     cache_re(PL_reg_re);
2187
2188                     /* XXXX This is too dramatic a measure... */
2189                     PL_reg_maxiter = 0;
2190
2191                     sayNO;
2192                 }
2193                 sw = SvTRUE(ret);
2194                 logical = 0;
2195             }
2196             else
2197                 sv_setsv(save_scalar(PL_replgv), ret);
2198             break;
2199         }
2200         case OPEN:
2201             n = ARG(scan);  /* which paren pair */
2202             PL_reg_start_tmp[n] = locinput;
2203             if (n > PL_regsize)
2204                 PL_regsize = n;
2205             break;
2206         case CLOSE:
2207             n = ARG(scan);  /* which paren pair */
2208             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2209             PL_regendp[n] = locinput - PL_bostr;
2210             if (n > *PL_reglastparen)
2211                 *PL_reglastparen = n;
2212             break;
2213         case GROUPP:
2214             n = ARG(scan);  /* which paren pair */
2215             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2216             break;
2217         case IFTHEN:
2218             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2219             if (sw)
2220                 next = NEXTOPER(NEXTOPER(scan));
2221             else {
2222                 next = scan + ARG(scan);
2223                 if (OP(next) == IFTHEN) /* Fake one. */
2224                     next = NEXTOPER(NEXTOPER(next));
2225             }
2226             break;
2227         case LOGICAL:
2228             logical = scan->flags;
2229             break;
2230         case CURLYX: {
2231                 CURCUR cc;
2232                 CHECKPOINT cp = PL_savestack_ix;
2233
2234                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2235                     next += ARG(next);
2236                 cc.oldcc = PL_regcc;
2237                 PL_regcc = &cc;
2238                 cc.parenfloor = *PL_reglastparen;
2239                 cc.cur = -1;
2240                 cc.min = ARG1(scan);
2241                 cc.max  = ARG2(scan);
2242                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2243                 cc.next = next;
2244                 cc.minmod = minmod;
2245                 cc.lastloc = 0;
2246                 PL_reginput = locinput;
2247                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2248                 regcpblow(cp);
2249                 PL_regcc = cc.oldcc;
2250                 saySAME(n);
2251             }
2252             /* NOT REACHED */
2253         case WHILEM: {
2254                 /*
2255                  * This is really hard to understand, because after we match
2256                  * what we're trying to match, we must make sure the rest of
2257                  * the REx is going to match for sure, and to do that we have
2258                  * to go back UP the parse tree by recursing ever deeper.  And
2259                  * if it fails, we have to reset our parent's current state
2260                  * that we can try again after backing off.
2261                  */
2262
2263                 CHECKPOINT cp, lastcp;
2264                 CURCUR* cc = PL_regcc;
2265                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
2266
2267                 n = cc->cur + 1;        /* how many we know we matched */
2268                 PL_reginput = locinput;
2269
2270                 DEBUG_r(
2271                     PerlIO_printf(Perl_debug_log,
2272                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
2273                                   REPORT_CODE_OFF+PL_regindent*2, "",
2274                                   (long)n, (long)cc->min,
2275                                   (long)cc->max, (long)cc)
2276                     );
2277
2278                 /* If degenerate scan matches "", assume scan done. */
2279
2280                 if (locinput == cc->lastloc && n >= cc->min) {
2281                     PL_regcc = cc->oldcc;
2282                     ln = PL_regcc->cur;
2283                     DEBUG_r(
2284                         PerlIO_printf(Perl_debug_log,
2285                            "%*s  empty match detected, try continuation...\n",
2286                            REPORT_CODE_OFF+PL_regindent*2, "")
2287                         );
2288                     if (regmatch(cc->next))
2289                         sayYES;
2290                     DEBUG_r(
2291                         PerlIO_printf(Perl_debug_log,
2292                                       "%*s  failed...\n",
2293                                       REPORT_CODE_OFF+PL_regindent*2, "")
2294                         );
2295                     PL_regcc->cur = ln;
2296                     PL_regcc = cc;
2297                     sayNO;
2298                 }
2299
2300                 /* First just match a string of min scans. */
2301
2302                 if (n < cc->min) {
2303                     cc->cur = n;
2304                     cc->lastloc = locinput;
2305                     if (regmatch(cc->scan))
2306                         sayYES;
2307                     cc->cur = n - 1;
2308                     cc->lastloc = lastloc;
2309                     DEBUG_r(
2310                         PerlIO_printf(Perl_debug_log,
2311                                       "%*s  failed...\n",
2312                                       REPORT_CODE_OFF+PL_regindent*2, "")
2313                         );
2314                     sayNO;
2315                 }
2316
2317                 if (scan->flags) {
2318                     /* Check whether we already were at this position.
2319                         Postpone detection until we know the match is not
2320                         *that* much linear. */
2321                 if (!PL_reg_maxiter) {
2322                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
2323                     PL_reg_leftiter = PL_reg_maxiter;
2324                 }
2325                 if (PL_reg_leftiter-- == 0) {
2326                     I32 size = (PL_reg_maxiter + 7)/8;
2327                     if (PL_reg_poscache) {
2328                         if (PL_reg_poscache_size < size) {
2329                             Renew(PL_reg_poscache, size, char);
2330                             PL_reg_poscache_size = size;
2331                         }
2332                         Zero(PL_reg_poscache, size, char);
2333                     }
2334                     else {
2335                         PL_reg_poscache_size = size;
2336                         Newz(29, PL_reg_poscache, size, char);
2337                     }
2338                     DEBUG_r(
2339                         PerlIO_printf(Perl_debug_log,
2340               "%sDetected a super-linear match, switching on caching%s...\n",
2341                                       PL_colors[4], PL_colors[5])
2342                         );
2343                 }
2344                 if (PL_reg_leftiter < 0) {
2345                     I32 o = locinput - PL_bostr, b;
2346
2347                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
2348                     b = o % 8;
2349                     o /= 8;
2350                     if (PL_reg_poscache[o] & (1<<b)) {
2351                     DEBUG_r(
2352                         PerlIO_printf(Perl_debug_log,
2353                                       "%*s  already tried at this position...\n",
2354                                       REPORT_CODE_OFF+PL_regindent*2, "")
2355                         );
2356                         sayNO;
2357                     }
2358                     PL_reg_poscache[o] |= (1<<b);
2359                 }
2360                 }
2361
2362                 /* Prefer next over scan for minimal matching. */
2363
2364                 if (cc->minmod) {
2365                     PL_regcc = cc->oldcc;
2366                     ln = PL_regcc->cur;
2367                     cp = regcppush(cc->parenfloor);
2368                     REGCP_SET;
2369                     if (regmatch(cc->next)) {
2370                         regcpblow(cp);
2371                         sayYES; /* All done. */
2372                     }
2373                     REGCP_UNWIND;
2374                     regcppop();
2375                     PL_regcc->cur = ln;
2376                     PL_regcc = cc;
2377
2378                     if (n >= cc->max) { /* Maximum greed exceeded? */
2379                         if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
2380                             && !(PL_reg_flags & RF_warned)) {
2381                             PL_reg_flags |= RF_warned;
2382                             Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
2383                                  "Complex regular subexpression recursion",
2384                                  REG_INFTY - 1);
2385                         }
2386                         sayNO;
2387                     }
2388
2389                     DEBUG_r(
2390                         PerlIO_printf(Perl_debug_log,
2391                                       "%*s  trying longer...\n",
2392                                       REPORT_CODE_OFF+PL_regindent*2, "")
2393                         );
2394                     /* Try scanning more and see if it helps. */
2395                     PL_reginput = locinput;
2396                     cc->cur = n;
2397                     cc->lastloc = locinput;
2398                     cp = regcppush(cc->parenfloor);
2399                     REGCP_SET;
2400                     if (regmatch(cc->scan)) {
2401                         regcpblow(cp);
2402                         sayYES;
2403                     }
2404                     DEBUG_r(
2405                         PerlIO_printf(Perl_debug_log,
2406                                       "%*s  failed...\n",
2407                                       REPORT_CODE_OFF+PL_regindent*2, "")
2408                         );
2409                     REGCP_UNWIND;
2410                     regcppop();
2411                     cc->cur = n - 1;
2412                     cc->lastloc = lastloc;
2413                     sayNO;
2414                 }
2415
2416                 /* Prefer scan over next for maximal matching. */
2417
2418                 if (n < cc->max) {      /* More greed allowed? */
2419                     cp = regcppush(cc->parenfloor);
2420                     cc->cur = n;
2421                     cc->lastloc = locinput;
2422                     REGCP_SET;
2423                     if (regmatch(cc->scan)) {
2424                         regcpblow(cp);
2425                         sayYES;
2426                     }
2427                     REGCP_UNWIND;
2428                     regcppop();         /* Restore some previous $<digit>s? */
2429                     PL_reginput = locinput;
2430                     DEBUG_r(
2431                         PerlIO_printf(Perl_debug_log,
2432                                       "%*s  failed, try continuation...\n",
2433                                       REPORT_CODE_OFF+PL_regindent*2, "")
2434                         );
2435                 }
2436                 if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
2437                         && !(PL_reg_flags & RF_warned)) {
2438                     PL_reg_flags |= RF_warned;
2439                     Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
2440                          "Complex regular subexpression recursion",
2441                          REG_INFTY - 1);
2442                 }
2443
2444                 /* Failed deeper matches of scan, so see if this one works. */
2445                 PL_regcc = cc->oldcc;
2446                 ln = PL_regcc->cur;
2447                 if (regmatch(cc->next))
2448                     sayYES;
2449                 DEBUG_r(
2450                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
2451                                   REPORT_CODE_OFF+PL_regindent*2, "")
2452                     );
2453                 PL_regcc->cur = ln;
2454                 PL_regcc = cc;
2455                 cc->cur = n - 1;
2456                 cc->lastloc = lastloc;
2457                 sayNO;
2458             }
2459             /* NOT REACHED */
2460         case BRANCHJ:
2461             next = scan + ARG(scan);
2462             if (next == scan)
2463                 next = NULL;
2464             inner = NEXTOPER(NEXTOPER(scan));
2465             goto do_branch;
2466         case BRANCH:
2467             inner = NEXTOPER(scan);
2468           do_branch:
2469             {
2470                 CHECKPOINT lastcp;
2471                 c1 = OP(scan);
2472                 if (OP(next) != c1)     /* No choice. */
2473                     next = inner;       /* Avoid recursion. */
2474                 else {
2475                     int lastparen = *PL_reglastparen;
2476
2477                     REGCP_SET;
2478                     do {
2479                         PL_reginput = locinput;
2480                         if (regmatch(inner))
2481                             sayYES;
2482                         REGCP_UNWIND;
2483                         for (n = *PL_reglastparen; n > lastparen; n--)
2484                             PL_regendp[n] = -1;
2485                         *PL_reglastparen = n;
2486                         scan = next;
2487                         /*SUPPRESS 560*/
2488                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
2489                             next += n;
2490                         else
2491                             next = NULL;
2492                         inner = NEXTOPER(scan);
2493                         if (c1 == BRANCHJ) {
2494                             inner = NEXTOPER(inner);
2495                         }
2496                     } while (scan != NULL && OP(scan) == c1);
2497                     sayNO;
2498                     /* NOTREACHED */
2499                 }
2500             }
2501             break;
2502         case MINMOD:
2503             minmod = 1;
2504             break;
2505         case CURLYM:
2506         {
2507             I32 l = 0;
2508             CHECKPOINT lastcp;
2509
2510             /* We suppose that the next guy does not need
2511                backtracking: in particular, it is of constant length,
2512                and has no parenths to influence future backrefs. */
2513             ln = ARG1(scan);  /* min to match */
2514             n  = ARG2(scan);  /* max to match */
2515             paren = scan->flags;
2516             if (paren) {
2517                 if (paren > PL_regsize)
2518                     PL_regsize = paren;
2519                 if (paren > *PL_reglastparen)
2520                     *PL_reglastparen = paren;
2521             }
2522             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
2523             if (paren)
2524                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
2525             PL_reginput = locinput;
2526             if (minmod) {
2527                 minmod = 0;
2528                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
2529                     sayNO;
2530                 if (ln && l == 0 && n >= ln
2531                     /* In fact, this is tricky.  If paren, then the
2532                        fact that we did/didnot match may influence
2533                        future execution. */
2534                     && !(paren && ln == 0))
2535                     ln = n;
2536                 locinput = PL_reginput;
2537                 if (PL_regkind[(U8)OP(next)] == EXACT) {
2538                     c1 = (U8)*STRING(next);
2539                     if (OP(next) == EXACTF)
2540                         c2 = PL_fold[c1];
2541                     else if (OP(next) == EXACTFL)
2542                         c2 = PL_fold_locale[c1];
2543                     else
2544                         c2 = c1;
2545                 }
2546                 else
2547                     c1 = c2 = -1000;
2548                 REGCP_SET;
2549                 /* This may be improved if l == 0.  */
2550                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
2551                     /* If it could work, try it. */
2552                     if (c1 == -1000 ||
2553                         UCHARAT(PL_reginput) == c1 ||
2554                         UCHARAT(PL_reginput) == c2)
2555                     {
2556                         if (paren) {
2557                             if (n) {
2558                                 PL_regstartp[paren] =
2559                                     HOPc(PL_reginput, -l) - PL_bostr;
2560                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2561                             }
2562                             else
2563                                 PL_regendp[paren] = -1;
2564                         }
2565                         if (regmatch(next))
2566                             sayYES;
2567                         REGCP_UNWIND;
2568                     }
2569                     /* Couldn't or didn't -- move forward. */
2570                     PL_reginput = locinput;
2571                     if (regrepeat_hard(scan, 1, &l)) {
2572                         ln++;
2573                         locinput = PL_reginput;
2574                     }
2575                     else
2576                         sayNO;
2577                 }
2578             }
2579             else {
2580                 n = regrepeat_hard(scan, n, &l);
2581                 if (n != 0 && l == 0
2582                     /* In fact, this is tricky.  If paren, then the
2583                        fact that we did/didnot match may influence
2584                        future execution. */
2585                     && !(paren && ln == 0))
2586                     ln = n;
2587                 locinput = PL_reginput;
2588                 DEBUG_r(
2589                     PerlIO_printf(Perl_debug_log,
2590                                   "%*s  matched %ld times, len=%ld...\n",
2591                                   REPORT_CODE_OFF+PL_regindent*2, "", n, l)
2592                     );
2593                 if (n >= ln) {
2594                     if (PL_regkind[(U8)OP(next)] == EXACT) {
2595                         c1 = (U8)*STRING(next);
2596                         if (OP(next) == EXACTF)
2597                             c2 = PL_fold[c1];
2598                         else if (OP(next) == EXACTFL)
2599                             c2 = PL_fold_locale[c1];
2600                         else
2601                             c2 = c1;
2602                     }
2603                     else
2604                         c1 = c2 = -1000;
2605                 }
2606                 REGCP_SET;
2607                 while (n >= ln) {
2608                     /* If it could work, try it. */
2609                     if (c1 == -1000 ||
2610                         UCHARAT(PL_reginput) == c1 ||
2611                         UCHARAT(PL_reginput) == c2)
2612                     {
2613                         DEBUG_r(
2614                                 PerlIO_printf(Perl_debug_log,
2615                                               "%*s  trying tail with n=%ld...\n",
2616                                               REPORT_CODE_OFF+PL_regindent*2, "", n)
2617                             );
2618                         if (paren) {
2619                             if (n) {
2620                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
2621                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2622                             }
2623                             else
2624                                 PL_regendp[paren] = -1;
2625                         }
2626                         if (regmatch(next))
2627                             sayYES;
2628                         REGCP_UNWIND;
2629                     }
2630                     /* Couldn't or didn't -- back up. */
2631                     n--;
2632                     locinput = HOPc(locinput, -l);
2633                     PL_reginput = locinput;
2634                 }
2635             }
2636             sayNO;
2637             break;
2638         }
2639         case CURLYN:
2640             paren = scan->flags;        /* Which paren to set */
2641             if (paren > PL_regsize)
2642                 PL_regsize = paren;
2643             if (paren > *PL_reglastparen)
2644                 *PL_reglastparen = paren;
2645             ln = ARG1(scan);  /* min to match */
2646             n  = ARG2(scan);  /* max to match */
2647             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
2648             goto repeat;
2649         case CURLY:
2650             paren = 0;
2651             ln = ARG1(scan);  /* min to match */
2652             n  = ARG2(scan);  /* max to match */
2653             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
2654             goto repeat;
2655         case STAR:
2656             ln = 0;
2657             n = REG_INFTY;
2658             scan = NEXTOPER(scan);
2659             paren = 0;
2660             goto repeat;
2661         case PLUS:
2662             ln = 1;
2663             n = REG_INFTY;
2664             scan = NEXTOPER(scan);
2665             paren = 0;
2666           repeat:
2667             /*
2668             * Lookahead to avoid useless match attempts
2669             * when we know what character comes next.
2670             */
2671             if (PL_regkind[(U8)OP(next)] == EXACT) {
2672                 c1 = (U8)*STRING(next);
2673                 if (OP(next) == EXACTF)
2674                     c2 = PL_fold[c1];
2675                 else if (OP(next) == EXACTFL)
2676                     c2 = PL_fold_locale[c1];
2677                 else
2678                     c2 = c1;
2679             }
2680             else
2681                 c1 = c2 = -1000;
2682             PL_reginput = locinput;
2683             if (minmod) {
2684                 CHECKPOINT lastcp;
2685                 minmod = 0;
2686                 if (ln && regrepeat(scan, ln) < ln)
2687                     sayNO;
2688                 locinput = PL_reginput;
2689                 REGCP_SET;
2690                 if (c1 != -1000) {
2691                     char *e = locinput + n - ln; /* Should not check after this */
2692                     char *old = locinput;
2693
2694                     if (e >= PL_regeol || (n == REG_INFTY))
2695                         e = PL_regeol - 1;
2696                     while (1) {
2697                         /* Find place 'next' could work */
2698                         if (c1 == c2) {
2699                             while (locinput <= e && *locinput != c1)
2700                                 locinput++;
2701                         } else {
2702                             while (locinput <= e
2703                                    && *locinput != c1
2704                                    && *locinput != c2)
2705                                 locinput++;
2706                         }
2707                         if (locinput > e)
2708                             sayNO;
2709                         /* PL_reginput == old now */
2710                         if (locinput != old) {
2711                             ln = 1;     /* Did some */
2712                             if (regrepeat(scan, locinput - old) <
2713                                  locinput - old)
2714                                 sayNO;
2715                         }
2716                         /* PL_reginput == locinput now */
2717                         if (paren) {
2718                             if (ln) {
2719                                 PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr;
2720                                 PL_regendp[paren] = locinput - PL_bostr;
2721                             }
2722                             else
2723                                 PL_regendp[paren] = -1;
2724                         }
2725                         if (regmatch(next))
2726                             sayYES;
2727                         PL_reginput = locinput; /* Could be reset... */
2728                         REGCP_UNWIND;
2729                         /* Couldn't or didn't -- move forward. */
2730                         old = locinput++;
2731                     }
2732                 }
2733                 else
2734                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
2735                     /* If it could work, try it. */
2736                     if (c1 == -1000 ||
2737                         UCHARAT(PL_reginput) == c1 ||
2738                         UCHARAT(PL_reginput) == c2)
2739                     {
2740                         if (paren) {
2741                             if (n) {
2742                                 PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
2743                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2744                             }
2745                             else
2746                                 PL_regendp[paren] = -1;
2747                         }
2748                         if (regmatch(next))
2749                             sayYES;
2750                         REGCP_UNWIND;
2751                     }
2752                     /* Couldn't or didn't -- move forward. */
2753                     PL_reginput = locinput;
2754                     if (regrepeat(scan, 1)) {
2755                         ln++;
2756                         locinput = PL_reginput;
2757                     }
2758                     else
2759                         sayNO;
2760                 }
2761             }
2762             else {
2763                 CHECKPOINT lastcp;
2764                 n = regrepeat(scan, n);
2765                 locinput = PL_reginput;
2766                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
2767                     (!PL_multiline  || OP(next) == SEOL))
2768                     ln = n;                     /* why back off? */
2769                 REGCP_SET;
2770                 if (paren) {
2771                     while (n >= ln) {
2772                         /* If it could work, try it. */
2773                         if (c1 == -1000 ||
2774                             UCHARAT(PL_reginput) == c1 ||
2775                             UCHARAT(PL_reginput) == c2)
2776                             {
2777                                 if (paren && n) {
2778                                     if (n) {
2779                                         PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
2780                                         PL_regendp[paren] = PL_reginput - PL_bostr;
2781                                     }
2782                                     else
2783                                         PL_regendp[paren] = -1;
2784                                 }
2785                                 if (regmatch(next))
2786                                     sayYES;
2787                                 REGCP_UNWIND;
2788                             }
2789                         /* Couldn't or didn't -- back up. */
2790                         n--;
2791                         PL_reginput = locinput = HOPc(locinput, -1);
2792                     }
2793                 }
2794                 else {
2795                     while (n >= ln) {
2796                         /* If it could work, try it. */
2797                         if (c1 == -1000 ||
2798                             UCHARAT(PL_reginput) == c1 ||
2799                             UCHARAT(PL_reginput) == c2)
2800                             {
2801                                 if (regmatch(next))
2802                                     sayYES;
2803                                 REGCP_UNWIND;
2804                             }
2805                         /* Couldn't or didn't -- back up. */
2806                         n--;
2807                         PL_reginput = locinput = HOPc(locinput, -1);
2808                     }
2809                 }
2810             }
2811             sayNO;
2812             break;
2813         case END:
2814             if (PL_reg_call_cc) {
2815                 re_cc_state *cur_call_cc = PL_reg_call_cc;
2816                 CURCUR *cctmp = PL_regcc;
2817                 regexp *re = PL_reg_re;
2818                 CHECKPOINT cp, lastcp;
2819
2820                 cp = regcppush(0);      /* Save *all* the positions. */
2821                 REGCP_SET;
2822                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
2823                                                     the caller. */
2824                 PL_reginput = locinput; /* Make position available to
2825                                            the callcc. */
2826                 cache_re(PL_reg_call_cc->re);
2827                 PL_regcc = PL_reg_call_cc->cc;
2828                 PL_reg_call_cc = PL_reg_call_cc->prev;
2829                 if (regmatch(cur_call_cc->node)) {
2830                     PL_reg_call_cc = cur_call_cc;
2831                     regcpblow(cp);
2832                     sayYES;
2833                 }
2834                 REGCP_UNWIND;
2835                 regcppop();
2836                 PL_reg_call_cc = cur_call_cc;
2837                 PL_regcc = cctmp;
2838                 PL_reg_re = re;
2839                 cache_re(re);
2840
2841                 DEBUG_r(
2842                     PerlIO_printf(Perl_debug_log,
2843                                   "%*s  continuation failed...\n",
2844                                   REPORT_CODE_OFF+PL_regindent*2, "")
2845                     );
2846                 sayNO;
2847             }
2848             if (locinput < PL_regtill)
2849                 sayNO;                  /* Cannot match: too short. */
2850             /* Fall through */
2851         case SUCCEED:
2852             PL_reginput = locinput;     /* put where regtry can find it */
2853             sayYES;                     /* Success! */
2854         case SUSPEND:
2855             n = 1;
2856             PL_reginput = locinput;
2857             goto do_ifmatch;
2858         case UNLESSM:
2859             n = 0;
2860             if (scan->flags) {
2861                 if (UTF) {              /* XXXX This is absolutely
2862                                            broken, we read before
2863                                            start of string. */
2864                     s = HOPMAYBEc(locinput, -scan->flags);
2865                     if (!s)
2866                         goto say_yes;
2867                     PL_reginput = s;
2868                 }
2869                 else {
2870                     if (locinput < PL_bostr + scan->flags)
2871                         goto say_yes;
2872                     PL_reginput = locinput - scan->flags;
2873                     goto do_ifmatch;
2874                 }
2875             }
2876             else
2877                 PL_reginput = locinput;
2878             goto do_ifmatch;
2879         case IFMATCH:
2880             n = 1;
2881             if (scan->flags) {
2882                 if (UTF) {              /* XXXX This is absolutely
2883                                            broken, we read before
2884                                            start of string. */
2885                     s = HOPMAYBEc(locinput, -scan->flags);
2886                     if (!s || s < PL_bostr)
2887                         goto say_no;
2888                     PL_reginput = s;
2889                 }
2890                 else {
2891                     if (locinput < PL_bostr + scan->flags)
2892                         goto say_no;
2893                     PL_reginput = locinput - scan->flags;
2894                     goto do_ifmatch;
2895                 }
2896             }
2897             else
2898                 PL_reginput = locinput;
2899
2900           do_ifmatch:
2901             inner = NEXTOPER(NEXTOPER(scan));
2902             if (regmatch(inner) != n) {
2903               say_no:
2904                 if (logical) {
2905                     logical = 0;
2906                     sw = 0;
2907                     goto do_longjump;
2908                 }
2909                 else
2910                     sayNO;
2911             }
2912           say_yes:
2913             if (logical) {
2914                 logical = 0;
2915                 sw = 1;
2916             }
2917             if (OP(scan) == SUSPEND) {
2918                 locinput = PL_reginput;
2919                 nextchr = UCHARAT(locinput);
2920             }
2921             /* FALL THROUGH. */
2922         case LONGJMP:
2923           do_longjump:
2924             next = scan + ARG(scan);
2925             if (next == scan)
2926                 next = NULL;
2927             break;
2928         default:
2929             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
2930                           (unsigned long)scan, OP(scan));
2931             Perl_croak(aTHX_ "regexp memory corruption");
2932         }
2933         scan = next;
2934     }
2935
2936     /*
2937     * We get here only if there's trouble -- normally "case END" is
2938     * the terminating point.
2939     */
2940     Perl_croak(aTHX_ "corrupted regexp pointers");
2941     /*NOTREACHED*/
2942     sayNO;
2943
2944 yes:
2945 #ifdef DEBUGGING
2946     PL_regindent--;
2947 #endif
2948     return 1;
2949
2950 no:
2951 #ifdef DEBUGGING
2952     PL_regindent--;
2953 #endif
2954     return 0;
2955 }
2956
2957 /*
2958  - regrepeat - repeatedly match something simple, report how many
2959  */
2960 /*
2961  * [This routine now assumes that it will only match on things of length 1.
2962  * That was true before, but now we assume scan - reginput is the count,
2963  * rather than incrementing count on every character.  [Er, except utf8.]]
2964  */
2965 STATIC I32
2966 S_regrepeat(pTHX_ regnode *p, I32 max)
2967 {
2968     dTHR;
2969     register char *scan;
2970     register char *opnd;
2971     register I32 c;
2972     register char *loceol = PL_regeol;
2973     register I32 hardcount = 0;
2974
2975     scan = PL_reginput;
2976     if (max != REG_INFTY && max < loceol - scan)
2977       loceol = scan + max;
2978     switch (OP(p)) {
2979     case REG_ANY:
2980         while (scan < loceol && *scan != '\n')
2981             scan++;
2982         break;
2983     case SANY:
2984         scan = loceol;
2985         break;
2986     case ANYUTF8:
2987         loceol = PL_regeol;
2988         while (scan < loceol && *scan != '\n') {
2989             scan += UTF8SKIP(scan);
2990             hardcount++;
2991         }
2992         break;
2993     case SANYUTF8:
2994         loceol = PL_regeol;
2995         while (scan < loceol) {
2996             scan += UTF8SKIP(scan);
2997             hardcount++;
2998         }
2999         break;
3000     case EXACT:         /* length of string is 1 */
3001         c = (U8)*STRING(p);
3002         while (scan < loceol && UCHARAT(scan) == c)
3003             scan++;
3004         break;
3005     case EXACTF:        /* length of string is 1 */
3006         c = (U8)*STRING(p);
3007         while (scan < loceol &&
3008                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3009             scan++;
3010         break;
3011     case EXACTFL:       /* length of string is 1 */
3012         PL_reg_flags |= RF_tainted;
3013         c = (U8)*STRING(p);
3014         while (scan < loceol &&
3015                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3016             scan++;
3017         break;
3018     case ANYOFUTF8:
3019         loceol = PL_regeol;
3020         while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
3021             scan += UTF8SKIP(scan);
3022             hardcount++;
3023         }
3024         break;
3025     case ANYOF:
3026         opnd = MASK(p);
3027         while (scan < loceol && REGINCLASS(opnd, *scan))
3028             scan++;
3029         break;
3030     case ALNUM:
3031         while (scan < loceol && isALNUM(*scan))
3032             scan++;
3033         break;
3034     case ALNUMUTF8:
3035         loceol = PL_regeol;
3036         while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3037             scan += UTF8SKIP(scan);
3038             hardcount++;
3039         }
3040         break;
3041     case ALNUML:
3042         PL_reg_flags |= RF_tainted;
3043         while (scan < loceol && isALNUM_LC(*scan))
3044             scan++;
3045         break;
3046     case ALNUMLUTF8:
3047         PL_reg_flags |= RF_tainted;
3048         loceol = PL_regeol;
3049         while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
3050             scan += UTF8SKIP(scan);
3051             hardcount++;
3052         }
3053         break;
3054         break;
3055     case NALNUM:
3056         while (scan < loceol && !isALNUM(*scan))
3057             scan++;
3058         break;
3059     case NALNUMUTF8:
3060         loceol = PL_regeol;
3061         while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3062             scan += UTF8SKIP(scan);
3063             hardcount++;
3064         }
3065         break;
3066     case NALNUML:
3067         PL_reg_flags |= RF_tainted;
3068         while (scan < loceol && !isALNUM_LC(*scan))
3069             scan++;
3070         break;
3071     case NALNUMLUTF8:
3072         PL_reg_flags |= RF_tainted;
3073         loceol = PL_regeol;
3074         while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
3075             scan += UTF8SKIP(scan);
3076             hardcount++;
3077         }
3078         break;
3079     case SPACE:
3080         while (scan < loceol && isSPACE(*scan))
3081             scan++;
3082         break;
3083     case SPACEUTF8:
3084         loceol = PL_regeol;
3085         while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3086             scan += UTF8SKIP(scan);
3087             hardcount++;
3088         }
3089         break;
3090     case SPACEL:
3091         PL_reg_flags |= RF_tainted;
3092         while (scan < loceol && isSPACE_LC(*scan))
3093             scan++;
3094         break;
3095     case SPACELUTF8:
3096         PL_reg_flags |= RF_tainted;
3097         loceol = PL_regeol;
3098         while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3099             scan += UTF8SKIP(scan);
3100             hardcount++;
3101         }
3102         break;
3103     case NSPACE:
3104         while (scan < loceol && !isSPACE(*scan))
3105             scan++;
3106         break;
3107     case NSPACEUTF8:
3108         loceol = PL_regeol;
3109         while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3110             scan += UTF8SKIP(scan);
3111             hardcount++;
3112         }
3113         break;
3114     case NSPACEL:
3115         PL_reg_flags |= RF_tainted;
3116         while (scan < loceol && !isSPACE_LC(*scan))
3117             scan++;
3118         break;
3119     case NSPACELUTF8:
3120         PL_reg_flags |= RF_tainted;
3121         loceol = PL_regeol;
3122         while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3123             scan += UTF8SKIP(scan);
3124             hardcount++;
3125         }
3126         break;
3127     case DIGIT:
3128         while (scan < loceol && isDIGIT(*scan))
3129             scan++;
3130         break;
3131     case DIGITUTF8:
3132         loceol = PL_regeol;
3133         while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
3134             scan += UTF8SKIP(scan);
3135             hardcount++;
3136         }
3137         break;
3138         break;
3139     case NDIGIT:
3140         while (scan < loceol && !isDIGIT(*scan))
3141             scan++;
3142         break;
3143     case NDIGITUTF8:
3144         loceol = PL_regeol;
3145         while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
3146             scan += UTF8SKIP(scan);
3147             hardcount++;
3148         }
3149         break;
3150     default:            /* Called on something of 0 width. */
3151         break;          /* So match right here or not at all. */
3152     }
3153
3154     if (hardcount)
3155         c = hardcount;
3156     else
3157         c = scan - PL_reginput;
3158     PL_reginput = scan;
3159
3160     DEBUG_r(
3161         {
3162                 SV *prop = sv_newmortal();
3163
3164                 regprop(prop, p);
3165                 PerlIO_printf(Perl_debug_log,
3166                               "%*s  %s can match %ld times out of %ld...\n",
3167                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
3168         });
3169
3170     return(c);
3171 }
3172
3173 /*
3174  - regrepeat_hard - repeatedly match something, report total lenth and length
3175  *
3176  * The repeater is supposed to have constant length.
3177  */
3178
3179 STATIC I32
3180 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
3181 {
3182     dTHR;
3183     register char *scan;
3184     register char *start;
3185     register char *loceol = PL_regeol;
3186     I32 l = 0;
3187     I32 count = 0, res = 1;
3188
3189     if (!max)
3190         return 0;
3191
3192     start = PL_reginput;
3193     if (UTF) {
3194         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3195             if (!count++) {
3196                 l = 0;
3197                 while (start < PL_reginput) {
3198                     l++;
3199                     start += UTF8SKIP(start);
3200                 }
3201                 *lp = l;
3202                 if (l == 0)
3203                     return max;
3204             }
3205             if (count == max)
3206                 return count;
3207         }
3208     }
3209     else {
3210         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3211             if (!count++) {
3212                 *lp = l = PL_reginput - start;
3213                 if (max != REG_INFTY && l*max < loceol - scan)
3214                     loceol = scan + l*max;
3215                 if (l == 0)
3216                     return max;
3217             }
3218         }
3219     }
3220     if (!res)
3221         PL_reginput = scan;
3222
3223     return count;
3224 }
3225
3226 /*
3227  - reginclass - determine if a character falls into a character class
3228  */
3229
3230 STATIC bool
3231 S_reginclass(pTHX_ register char *p, register I32 c)
3232 {
3233     dTHR;
3234     char flags = ANYOF_FLAGS(p);
3235     bool match = FALSE;
3236
3237     c &= 0xFF;
3238     if (ANYOF_BITMAP_TEST(p, c))
3239         match = TRUE;
3240     else if (flags & ANYOF_FOLD) {
3241         I32 cf;
3242         if (flags & ANYOF_LOCALE) {
3243             PL_reg_flags |= RF_tainted;
3244             cf = PL_fold_locale[c];
3245         }
3246         else
3247             cf = PL_fold[c];
3248         if (ANYOF_BITMAP_TEST(p, cf))
3249             match = TRUE;
3250     }
3251
3252     if (!match && (flags & ANYOF_CLASS)) {
3253         PL_reg_flags |= RF_tainted;
3254         if (
3255             (ANYOF_CLASS_TEST(p, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
3256             (ANYOF_CLASS_TEST(p, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
3257             (ANYOF_CLASS_TEST(p, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
3258             (ANYOF_CLASS_TEST(p, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
3259             (ANYOF_CLASS_TEST(p, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
3260             (ANYOF_CLASS_TEST(p, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
3261             (ANYOF_CLASS_TEST(p, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
3262             (ANYOF_CLASS_TEST(p, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
3263             (ANYOF_CLASS_TEST(p, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
3264             (ANYOF_CLASS_TEST(p, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
3265             (ANYOF_CLASS_TEST(p, ANYOF_ASCII)   &&  isASCII(c))     ||
3266             (ANYOF_CLASS_TEST(p, ANYOF_NASCII)  && !isASCII(c))     ||
3267             (ANYOF_CLASS_TEST(p, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
3268             (ANYOF_CLASS_TEST(p, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
3269             (ANYOF_CLASS_TEST(p, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
3270             (ANYOF_CLASS_TEST(p, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
3271             (ANYOF_CLASS_TEST(p, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
3272             (ANYOF_CLASS_TEST(p, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
3273             (ANYOF_CLASS_TEST(p, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
3274             (ANYOF_CLASS_TEST(p, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
3275             (ANYOF_CLASS_TEST(p, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
3276             (ANYOF_CLASS_TEST(p, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
3277             (ANYOF_CLASS_TEST(p, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
3278             (ANYOF_CLASS_TEST(p, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
3279             (ANYOF_CLASS_TEST(p, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
3280             (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c))
3281             ) /* How's that for a conditional? */
3282         {
3283             match = TRUE;
3284         }
3285     }
3286
3287     return (flags & ANYOF_INVERT) ? !match : match;
3288 }
3289
3290 STATIC bool
3291 S_reginclassutf8(pTHX_ regnode *f, U8 *p)
3292 {
3293     dTHR;
3294     char flags = ARG1(f);
3295     bool match = FALSE;
3296     SV *sv = (SV*)PL_regdata->data[ARG2(f)];
3297
3298     if (swash_fetch(sv, p))
3299         match = TRUE;
3300     else if (flags & ANYOF_FOLD) {
3301         I32 cf;
3302         U8 tmpbuf[10];
3303         if (flags & ANYOF_LOCALE) {
3304             PL_reg_flags |= RF_tainted;
3305             uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
3306         }
3307         else
3308             uv_to_utf8(tmpbuf, toLOWER_utf8(p));
3309         if (swash_fetch(sv, tmpbuf))
3310             match = TRUE;
3311     }
3312
3313     /* UTF8 combined with ANYOF_CLASS is ill-defined. */
3314
3315     return (flags & ANYOF_INVERT) ? !match : match;
3316 }
3317
3318 STATIC U8 *
3319 S_reghop(pTHX_ U8 *s, I32 off)
3320 {
3321     dTHR;
3322     if (off >= 0) {
3323         while (off-- && s < (U8*)PL_regeol)
3324             s += UTF8SKIP(s);
3325     }
3326     else {
3327         while (off++) {
3328             if (s > (U8*)PL_bostr) {
3329                 s--;
3330                 if (*s & 0x80) {
3331                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3332                         s--;
3333                 }               /* XXX could check well-formedness here */
3334             }
3335         }
3336     }
3337     return s;
3338 }
3339
3340 STATIC U8 *
3341 S_reghopmaybe(pTHX_ U8* s, I32 off)
3342 {
3343     dTHR;
3344     if (off >= 0) {
3345         while (off-- && s < (U8*)PL_regeol)
3346             s += UTF8SKIP(s);
3347         if (off >= 0)
3348             return 0;
3349     }
3350     else {
3351         while (off++) {
3352             if (s > (U8*)PL_bostr) {
3353                 s--;
3354                 if (*s & 0x80) {
3355                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3356                         s--;
3357                 }               /* XXX could check well-formedness here */
3358             }
3359             else
3360                 break;
3361         }
3362         if (off <= 0)
3363             return 0;
3364     }
3365     return s;
3366 }
3367
3368 #ifdef PERL_OBJECT
3369 #define NO_XSLOCKS
3370 #include "XSUB.h"
3371 #endif
3372
3373 static void
3374 restore_pos(pTHXo_ void *arg)
3375 {
3376     dTHR;
3377     if (PL_reg_eval_set) {
3378         if (PL_reg_oldsaved) {
3379             PL_reg_re->subbeg = PL_reg_oldsaved;
3380             PL_reg_re->sublen = PL_reg_oldsavedlen;
3381             RX_MATCH_COPIED_on(PL_reg_re);
3382         }
3383         PL_reg_magic->mg_len = PL_reg_oldpos;
3384         PL_reg_eval_set = 0;
3385         PL_curpm = PL_reg_oldcurpm;
3386     }
3387 }
3388