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     I32 start_shift = 0;                /* Offset of the start to find
 646                                          constant substr. */            /* CC */
 647     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
 648     I32 scream_pos = -1;                /* Internal iterator of scream. */
 649     char *scream_olds;
 650     SV* oreplsv = GvSV(PL_replgv);
 651
 652     PL_regcc = 0;
 653
 654     cache_re(prog);
 655 #ifdef DEBUGGING
 656     PL_regnarrate = PL_debug & 512;
 657 #endif
 658
 659     /* Be paranoid... */
 660     if (prog == NULL || startpos == NULL) {
 661         Perl_croak(aTHX_ "NULL regexp parameter");
 662         return 0;
 663     }
 664
 665     minlen = prog->minlen;
 666     if (strend - startpos < minlen) goto phooey;
 667
 668     if (startpos == strbeg)     /* is ^ valid at stringarg? */
 669         PL_regprev = '\n';
 670     else {
 671         PL_regprev = (U32)stringarg[-1];
 672         if (!PL_multiline && PL_regprev == '\n')
 673             PL_regprev = '\0';          /* force ^ to NOT match */
 674     }
 675
 676     /* Check validity of program. */
 677     if (UCHARAT(prog->program) != REG_MAGIC) {
 678         Perl_croak(aTHX_ "corrupted regexp program");
 679     }
 680
 681     PL_reg_flags = 0;
 682     PL_reg_eval_set = 0;
 683     PL_reg_maxiter = 0;
 684
 685     if (prog->reganch & ROPT_UTF8)
 686         PL_reg_flags |= RF_utf8;
 687
 688     /* Mark beginning of line for ^ and lookbehind. */
 689     PL_regbol = startpos;
 690     PL_bostr  = strbeg;
 691     PL_reg_sv = sv;
 692
 693     /* Mark end of line for $ (and such) */
 694     PL_regeol = strend;
 695
 696     /* see how far we have to get to not match where we matched before */
 697     PL_regtill = startpos+minend;
 698
 699     /* We start without call_cc context.  */
 700     PL_reg_call_cc = 0;
 701
 702     /* If there is a "must appear" string, look for it. */
 703     s = startpos;
 704
 705     if (prog->reganch & ROPT_GPOS_SEEN) {
 706         MAGIC *mg;
 707
 708         if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG
 709             && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
 710             PL_reg_ganch = strbeg + mg->mg_len;
 711         else
 712             PL_reg_ganch = startpos;
 713         if (prog->reganch & ROPT_ANCH_GPOS) {
 714             if (s > PL_reg_ganch)
 715                 goto phooey;
 716             s = PL_reg_ganch;
 717         }
 718     }
 719
 720     if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
 721         re_scream_pos_data d;
 722
 723         d.scream_olds = &scream_olds;
 724         d.scream_pos = &scream_pos;
 725         s = re_intuit_start(prog, sv, s, strend, flags, &d);
 726         if (!s)
 727             goto phooey;        /* not present */
 728     }
 729
 730     DEBUG_r( if (!PL_colorset) reginitcolors() );
 731     DEBUG_r(PerlIO_printf(Perl_debug_log,
 732                       "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
 733                       PL_colors[4],PL_colors[5],PL_colors[0],
 734                       prog->precomp,
 735                       PL_colors[1],
 736                       (strlen(prog->precomp) > 60 ? "..." : ""),
 737                       PL_colors[0],
 738                       (strend - startpos > 60 ? 60 : strend - startpos),
 739                       startpos, PL_colors[1],
 740                       (strend - startpos > 60 ? "..." : ""))
 741         );
 742
 743     /* Simplest case:  anchored match need be tried only once. */
 744     /*  [unless only anchor is BOL and multiline is set] */
 745     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
 746         if (s == startpos && regtry(prog, startpos))
 747             goto got_it;
 748         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
 749                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
 750         {
 751             char *end;
 752
 753             if (minlen)
 754                 dontbother = minlen - 1;
 755             end = HOPc(strend, -dontbother) - 1;
 756             /* for multiline we only have to try after newlines */
 757             if (prog->check_substr) {
 758                 while (1) {
 759                     if (regtry(prog, s))
 760                         goto got_it;
 761                     if (s >= end)
 762                         goto phooey;
 763                     s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
 764                     if (!s)
 765                         goto phooey;
 766                 }
 767             } else {
 768                 if (s > startpos)
 769                     s--;
 770                 while (s < end) {
 771                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
 772                         if (regtry(prog, s))
 773                             goto got_it;
 774                     }
 775                 }
 776             }
 777         }
 778         goto phooey;
 779     } else if (prog->reganch & ROPT_ANCH_GPOS) {
 780         if (regtry(prog, PL_reg_ganch))
 781             goto got_it;
 782         goto phooey;
 783     }
 784
 785     /* Messy cases:  unanchored match. */
 786     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
 787         /* we have /x+whatever/ */
 788         /* it must be a one character string (XXXX Except UTF?) */
 789         char ch = SvPVX(prog->anchored_substr)[0];
 790         if (UTF) {
 791             while (s < strend) {
 792                 if (*s == ch) {
 793                     if (regtry(prog, s)) goto got_it;
 794                     s += UTF8SKIP(s);
 795                     while (s < strend && *s == ch)
 796                         s += UTF8SKIP(s);
 797                 }
 798                 s += UTF8SKIP(s);
 799             }
 800         }
 801         else {
 802             while (s < strend) {
 803                 if (*s == ch) {
 804                     if (regtry(prog, s)) goto got_it;
 805                     s++;
 806                     while (s < strend && *s == ch)
 807                         s++;
 808                 }
 809                 s++;
 810             }
 811         }
 812     }
 813     /*SUPPRESS 560*/
 814     else if (prog->anchored_substr != Nullsv
 815              || (prog->float_substr != Nullsv
 816                  && prog->float_max_offset < strend - s)) {
 817         SV *must = prog->anchored_substr
 818             ? prog->anchored_substr : prog->float_substr;
 819         I32 back_max =
 820             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
 821         I32 back_min =
 822             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
 823         I32 delta = back_max - back_min;
 824         char *last = HOPc(strend,       /* Cannot start after this */
 825                           -(I32)(CHR_SVLEN(must)
 826                                  - (SvTAIL(must) != 0) + back_min));
 827         char *last1;            /* Last position checked before */
 828
 829         if (s > PL_bostr)
 830             last1 = HOPc(s, -1);
 831         else
 832             last1 = s - 1;      /* bogus */
 833
 834         /* XXXX check_substr already used to find `s', can optimize if
 835            check_substr==must. */
 836         scream_pos = -1;
 837         dontbother = end_shift;
 838         strend = HOPc(strend, -dontbother);
 839         while ( (s <= last) &&
 840                 ((flags & REXEC_SCREAM)
 841                  ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg,
 842                                     end_shift, &scream_pos, 0))
 843                  : (s = fbm_instr((unsigned char*)HOP(s, back_min),
 844                                   (unsigned char*)strend, must,
 845                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
 846             if (HOPc(s, -back_max) > last1) {
 847                 last1 = HOPc(s, -back_min);
 848                 s = HOPc(s, -back_max);
 849             }
 850             else {
 851                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
 852
 853                 last1 = HOPc(s, -back_min);
 854                 s = t;
 855             }
 856             if (UTF) {
 857                 while (s <= last1) {
 858                     if (regtry(prog, s))
 859                         goto got_it;
 860                     s += UTF8SKIP(s);
 861                 }
 862             }
 863             else {
 864                 while (s <= last1) {
 865                     if (regtry(prog, s))
 866                         goto got_it;
 867                     s++;
 868                 }
 869             }
 870         }
 871         goto phooey;
 872     }
 873     else if (c = prog->regstclass) {
 874         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 875         char *cc;
 876
 877         if (minlen)
 878             dontbother = minlen - 1;
 879         strend = HOPc(strend, -dontbother);     /* don't bother with what can't match */
 880         tmp = 1;
 881         /* We know what class it must start with. */
 882         switch (OP(c)) {
 883         case ANYOFUTF8:
 884             cc = MASK(c);
 885             while (s < strend) {
 886                 if (REGINCLASSUTF8(c, (U8*)s)) {
 887                     if (tmp && regtry(prog, s))
 888                         goto got_it;
 889                     else
 890                         tmp = doevery;
 891                 }
 892                 else
 893                     tmp = 1;
 894                 s += UTF8SKIP(s);
 895             }
 896             break;
 897         case ANYOF:
 898             cc = MASK(c);
 899             while (s < strend) {
 900                 if (REGINCLASS(cc, *s)) {
 901                     if (tmp && regtry(prog, s))
 902                         goto got_it;
 903                     else
 904                         tmp = doevery;
 905                 }
 906                 else
 907                     tmp = 1;
 908                 s++;
 909             }
 910             break;
 911         case BOUNDL:
 912             PL_reg_flags |= RF_tainted;
 913             /* FALL THROUGH */
 914         case BOUND:
 915             if (minlen) {
 916                 dontbother++;
 917                 strend -= 1;
 918             }
 919             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 920             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 921             while (s < strend) {
 922                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
 923                     tmp = !tmp;
 924                     if (regtry(prog, s))
 925                         goto got_it;
 926                 }
 927                 s++;
 928             }
 929             if ((minlen || tmp) && regtry(prog,s))
 930                 goto got_it;
 931             break;
 932         case BOUNDLUTF8:
 933             PL_reg_flags |= RF_tainted;
 934             /* FALL THROUGH */
 935         case BOUNDUTF8:
 936             if (minlen) {
 937                 dontbother++;
 938                 strend = reghop_c(strend, -1);
 939             }
 940             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 941             tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 942             while (s < strend) {
 943                 if (tmp == !(OP(c) == BOUND ?
 944                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 945                              isALNUM_LC_utf8((U8*)s)))
 946                 {
 947                     tmp = !tmp;
 948                     if (regtry(prog, s))
 949                         goto got_it;
 950                 }
 951                 s += UTF8SKIP(s);
 952             }
 953             if ((minlen || tmp) && regtry(prog,s))
 954                 goto got_it;
 955             break;
 956         case NBOUNDL:
 957             PL_reg_flags |= RF_tainted;
 958             /* FALL THROUGH */
 959         case NBOUND:
 960             if (minlen) {
 961                 dontbother++;
 962                 strend -= 1;
 963             }
 964             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 965             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 966             while (s < strend) {
 967                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
 968                     tmp = !tmp;
 969                 else if (regtry(prog, s))
 970                     goto got_it;
 971                 s++;
 972             }
 973             if ((minlen || !tmp) && regtry(prog,s))
 974                 goto got_it;
 975             break;
 976         case NBOUNDLUTF8:
 977             PL_reg_flags |= RF_tainted;
 978             /* FALL THROUGH */
 979         case NBOUNDUTF8:
 980             if (minlen) {
 981                 dontbother++;
 982                 strend = reghop_c(strend, -1);
 983             }
 984             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 985             tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 986             while (s < strend) {
 987                 if (tmp == !(OP(c) == NBOUND ?
 988                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 989                              isALNUM_LC_utf8((U8*)s)))
 990                     tmp = !tmp;
 991                 else if (regtry(prog, s))
 992                     goto got_it;
 993                 s += UTF8SKIP(s);
 994             }
 995             if ((minlen || !tmp) && regtry(prog,s))
 996                 goto got_it;
 997             break;
 998         case ALNUM:
 999             while (s < strend) {
1000                 if (isALNUM(*s)) {
1001                     if (tmp && regtry(prog, s))
1002                         goto got_it;
1003                     else
1004                         tmp = doevery;
1005                 }
1006                 else
1007                     tmp = 1;
1008                 s++;
1009             }
1010             break;
1011         case ALNUMUTF8:
1012             while (s < strend) {
1013                 if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
1014                     if (tmp && regtry(prog, s))
1015                         goto got_it;
1016                     else
1017                         tmp = doevery;
1018                 }
1019                 else
1020                     tmp = 1;
1021                 s += UTF8SKIP(s);
1022             }
1023             break;
1024         case ALNUML:
1025             PL_reg_flags |= RF_tainted;
1026             while (s < strend) {
1027                 if (isALNUM_LC(*s)) {
1028                     if (tmp && regtry(prog, s))
1029                         goto got_it;
1030                     else
1031                         tmp = doevery;
1032                 }
1033                 else
1034                     tmp = 1;
1035                 s++;
1036             }
1037             break;
1038         case ALNUMLUTF8:
1039             PL_reg_flags |= RF_tainted;
1040             while (s < strend) {
1041                 if (isALNUM_LC_utf8((U8*)s)) {
1042                     if (tmp && regtry(prog, s))
1043                         goto got_it;
1044                     else
1045                         tmp = doevery;
1046                 }
1047                 else
1048                     tmp = 1;
1049                 s += UTF8SKIP(s);
1050             }
1051             break;
1052         case NALNUM:
1053             while (s < strend) {
1054                 if (!isALNUM(*s)) {
1055                     if (tmp && regtry(prog, s))
1056                         goto got_it;
1057                     else
1058                         tmp = doevery;
1059                 }
1060                 else
1061                     tmp = 1;
1062                 s++;
1063             }
1064             break;
1065         case NALNUMUTF8:
1066             while (s < strend) {
1067                 if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
1068                     if (tmp && regtry(prog, s))
1069                         goto got_it;
1070                     else
1071                         tmp = doevery;
1072                 }
1073                 else
1074                     tmp = 1;
1075                 s += UTF8SKIP(s);
1076             }
1077             break;
1078         case NALNUML:
1079             PL_reg_flags |= RF_tainted;
1080             while (s < strend) {
1081                 if (!isALNUM_LC(*s)) {
1082                     if (tmp && regtry(prog, s))
1083                         goto got_it;
1084                     else
1085                         tmp = doevery;
1086                 }
1087                 else
1088                     tmp = 1;
1089                 s++;
1090             }
1091             break;
1092         case NALNUMLUTF8:
1093             PL_reg_flags |= RF_tainted;
1094             while (s < strend) {
1095                 if (!isALNUM_LC_utf8((U8*)s)) {
1096                     if (tmp && regtry(prog, s))
1097                         goto got_it;
1098                     else
1099                         tmp = doevery;
1100                 }
1101                 else
1102                     tmp = 1;
1103                 s += UTF8SKIP(s);
1104             }
1105             break;
1106         case SPACE:
1107             while (s < strend) {
1108                 if (isSPACE(*s)) {
1109                     if (tmp && regtry(prog, s))
1110                         goto got_it;
1111                     else
1112                         tmp = doevery;
1113                 }
1114                 else
1115                     tmp = 1;
1116                 s++;
1117             }
1118             break;
1119         case SPACEUTF8:
1120             while (s < strend) {
1121                 if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
1122                     if (tmp && regtry(prog, s))
1123                         goto got_it;
1124                     else
1125                         tmp = doevery;
1126                 }
1127                 else
1128                     tmp = 1;
1129                 s += UTF8SKIP(s);
1130             }
1131             break;
1132         case SPACEL:
1133             PL_reg_flags |= RF_tainted;
1134             while (s < strend) {
1135                 if (isSPACE_LC(*s)) {
1136                     if (tmp && regtry(prog, s))
1137                         goto got_it;
1138                     else
1139                         tmp = doevery;
1140                 }
1141                 else
1142                     tmp = 1;
1143                 s++;
1144             }
1145             break;
1146         case SPACELUTF8:
1147             PL_reg_flags |= RF_tainted;
1148             while (s < strend) {
1149                 if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1150                     if (tmp && regtry(prog, s))
1151                         goto got_it;
1152                     else
1153                         tmp = doevery;
1154                 }
1155                 else
1156                     tmp = 1;
1157                 s += UTF8SKIP(s);
1158             }
1159             break;
1160         case NSPACE:
1161             while (s < strend) {
1162                 if (!isSPACE(*s)) {
1163                     if (tmp && regtry(prog, s))
1164                         goto got_it;
1165                     else
1166                         tmp = doevery;
1167                 }
1168                 else
1169                     tmp = 1;
1170                 s++;
1171             }
1172             break;
1173         case NSPACEUTF8:
1174             while (s < strend) {
1175                 if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
1176                     if (tmp && regtry(prog, s))
1177                         goto got_it;
1178                     else
1179                         tmp = doevery;
1180                 }
1181                 else
1182                     tmp = 1;
1183                 s += UTF8SKIP(s);
1184             }
1185             break;
1186         case NSPACEL:
1187             PL_reg_flags |= RF_tainted;
1188             while (s < strend) {
1189                 if (!isSPACE_LC(*s)) {
1190                     if (tmp && regtry(prog, s))
1191                         goto got_it;
1192                     else
1193                         tmp = doevery;
1194                 }
1195                 else
1196                     tmp = 1;
1197                 s++;
1198             }
1199             break;
1200         case NSPACELUTF8:
1201             PL_reg_flags |= RF_tainted;
1202             while (s < strend) {
1203                 if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1204                     if (tmp && regtry(prog, s))
1205                         goto got_it;
1206                     else
1207                         tmp = doevery;
1208                 }
1209                 else
1210                     tmp = 1;
1211                 s += UTF8SKIP(s);
1212             }
1213             break;
1214         case DIGIT:
1215             while (s < strend) {
1216                 if (isDIGIT(*s)) {
1217                     if (tmp && regtry(prog, s))
1218                         goto got_it;
1219                     else
1220                         tmp = doevery;
1221                 }
1222                 else
1223                     tmp = 1;
1224                 s++;
1225             }
1226             break;
1227         case DIGITUTF8:
1228             while (s < strend) {
1229                 if (swash_fetch(PL_utf8_digit,(U8*)s)) {
1230                     if (tmp && regtry(prog, s))
1231                         goto got_it;
1232                     else
1233                         tmp = doevery;
1234                 }
1235                 else
1236                     tmp = 1;
1237                 s += UTF8SKIP(s);
1238             }
1239             break;
1240         case DIGITL:
1241             PL_reg_flags |= RF_tainted;
1242             while (s < strend) {
1243                 if (isDIGIT_LC(*s)) {
1244                     if (tmp && regtry(prog, s))
1245                         goto got_it;
1246                     else
1247                         tmp = doevery;
1248                 }
1249                 else
1250                     tmp = 1;
1251                 s++;
1252             }
1253             break;
1254         case DIGITLUTF8:
1255             PL_reg_flags |= RF_tainted;
1256             while (s < strend) {
1257                 if (isDIGIT_LC_utf8((U8*)s)) {
1258                     if (tmp && regtry(prog, s))
1259                         goto got_it;
1260                     else
1261                         tmp = doevery;
1262                 }
1263                 else
1264                     tmp = 1;
1265                 s += UTF8SKIP(s);
1266             }
1267             break;
1268         case NDIGIT:
1269             while (s < strend) {
1270                 if (!isDIGIT(*s)) {
1271                     if (tmp && regtry(prog, s))
1272                         goto got_it;
1273                     else
1274                         tmp = doevery;
1275                 }
1276                 else
1277                     tmp = 1;
1278                 s++;
1279             }
1280             break;
1281         case NDIGITUTF8:
1282             while (s < strend) {
1283                 if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
1284                     if (tmp && regtry(prog, s))
1285                         goto got_it;
1286                     else
1287                         tmp = doevery;
1288                 }
1289                 else
1290                     tmp = 1;
1291                 s += UTF8SKIP(s);
1292             }
1293             break;
1294         case NDIGITL:
1295             PL_reg_flags |= RF_tainted;
1296             while (s < strend) {
1297                 if (!isDIGIT_LC(*s)) {
1298                     if (tmp && regtry(prog, s))
1299                         goto got_it;
1300                     else
1301                         tmp = doevery;
1302                 }
1303                 else
1304                     tmp = 1;
1305                 s++;
1306             }
1307             break;
1308         case NDIGITLUTF8:
1309             PL_reg_flags |= RF_tainted;
1310             while (s < strend) {
1311                 if (!isDIGIT_LC_utf8((U8*)s)) {
1312                     if (tmp && regtry(prog, s))
1313                         goto got_it;
1314                     else
1315                         tmp = doevery;
1316                 }
1317                 else
1318                     tmp = 1;
1319                 s += UTF8SKIP(s);
1320             }
1321             break;
1322         }
1323     }
1324     else {
1325         dontbother = 0;
1326         if (prog->float_substr != Nullsv) {     /* Trim the end. */
1327             char *last;
1328             I32 oldpos = scream_pos;
1329
1330             if (flags & REXEC_SCREAM) {
1331                 last = screaminstr(sv, prog->float_substr, s - strbeg,
1332                                    end_shift, &scream_pos, 1); /* last one */
1333                 if (!last)
1334                     last = scream_olds; /* Only one occurence. */
1335             }
1336             else {
1337                 STRLEN len;
1338                 char *little = SvPV(prog->float_substr, len);
1339
1340                 if (SvTAIL(prog->float_substr)) {
1341                     if (memEQ(strend - len + 1, little, len - 1))
1342                         last = strend - len + 1;
1343                     else if (!PL_multiline)
1344                         last = memEQ(strend - len, little, len)
1345                             ? strend - len : Nullch;
1346                     else
1347                         goto find_last;
1348                 } else {
1349                   find_last:
1350                     if (len)
1351                         last = rninstr(s, strend, little, little + len);
1352                     else
1353                         last = strend;  /* matching `$' */
1354                 }
1355             }
1356             if (last == NULL) goto phooey; /* Should not happen! */
1357             dontbother = strend - last + prog->float_min_offset;
1358         }
1359         if (minlen && (dontbother < minlen))
1360             dontbother = minlen - 1;
1361         strend -= dontbother;              /* this one's always in bytes! */
1362         /* We don't know much -- general case. */
1363         if (UTF) {
1364             for (;;) {
1365                 if (regtry(prog, s))
1366                     goto got_it;
1367                 if (s >= strend)
1368                     break;
1369                 s += UTF8SKIP(s);
1370             };
1371         }
1372         else {
1373             do {
1374                 if (regtry(prog, s))
1375                     goto got_it;
1376             } while (s++ < strend);
1377         }
1378     }
1379
1380     /* Failure. */
1381     goto phooey;
1382
1383 got_it:
1384     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1385
1386     if (PL_reg_eval_set) {
1387         /* Preserve the current value of $^R */
1388         if (oreplsv != GvSV(PL_replgv))
1389             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1390                                                   restored, the value remains
1391                                                   the same. */
1392         restore_pos(aTHXo_ 0);
1393     }
1394
1395     /* make sure $`, $&, $', and $digit will work later */
1396     if ( !(flags & REXEC_NOT_FIRST) ) {
1397         if (RX_MATCH_COPIED(prog)) {
1398             Safefree(prog->subbeg);
1399             RX_MATCH_COPIED_off(prog);
1400         }
1401         if (flags & REXEC_COPY_STR) {
1402             I32 i = PL_regeol - startpos + (stringarg - strbeg);
1403
1404             s = savepvn(strbeg, i);
1405             prog->subbeg = s;
1406             prog->sublen = i;
1407             RX_MATCH_COPIED_on(prog);
1408         }
1409         else {
1410             prog->subbeg = strbeg;
1411             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
1412         }
1413     }
1414
1415     return 1;
1416
1417 phooey:
1418     if (PL_reg_eval_set)
1419         restore_pos(aTHXo_ 0);
1420     return 0;
1421 }
1422
1423 /*
1424  - regtry - try match at specific point
1425  */
1426 STATIC I32                      /* 0 failure, 1 success */
1427 S_regtry(pTHX_ regexp *prog, char *startpos)
1428 {
1429     dTHR;
1430     register I32 i;
1431     register I32 *sp;
1432     register I32 *ep;
1433     CHECKPOINT lastcp;
1434
1435     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1436         MAGIC *mg;
1437
1438         PL_reg_eval_set = RS_init;
1439         DEBUG_r(DEBUG_s(
1440             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
1441                           PL_stack_sp - PL_stack_base);
1442             ));
1443         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
1444         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1445         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1446         SAVETMPS;
1447         /* Apparently this is not needed, judging by wantarray. */
1448         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
1449            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1450
1451         if (PL_reg_sv) {
1452             /* Make $_ available to executed code. */
1453             if (PL_reg_sv != DEFSV) {
1454                 /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
1455                 SAVESPTR(DEFSV);
1456                 DEFSV = PL_reg_sv;
1457             }
1458
1459             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
1460                   && (mg = mg_find(PL_reg_sv, 'g')))) {
1461                 /* prepare for quick setting of pos */
1462                 sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0);
1463                 mg = mg_find(PL_reg_sv, 'g');
1464                 mg->mg_len = -1;
1465             }
1466             PL_reg_magic    = mg;
1467             PL_reg_oldpos   = mg->mg_len;
1468             SAVEDESTRUCTOR(restore_pos, 0);
1469         }
1470         if (!PL_reg_curpm)
1471             New(22,PL_reg_curpm, 1, PMOP);
1472         PL_reg_curpm->op_pmregexp = prog;
1473         PL_reg_oldcurpm = PL_curpm;
1474         PL_curpm = PL_reg_curpm;
1475         if (RX_MATCH_COPIED(prog)) {
1476             /*  Here is a serious problem: we cannot rewrite subbeg,
1477                 since it may be needed if this match fails.  Thus
1478                 $` inside (?{}) could fail... */
1479             PL_reg_oldsaved = prog->subbeg;
1480             PL_reg_oldsavedlen = prog->sublen;
1481             RX_MATCH_COPIED_off(prog);
1482         }
1483         else
1484             PL_reg_oldsaved = Nullch;
1485         prog->subbeg = PL_bostr;
1486         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
1487     }
1488     prog->startp[0] = startpos - PL_bostr;
1489     PL_reginput = startpos;
1490     PL_regstartp = prog->startp;
1491     PL_regendp = prog->endp;
1492     PL_reglastparen = &prog->lastparen;
1493     prog->lastparen = 0;
1494     PL_regsize = 0;
1495     DEBUG_r(PL_reg_starttry = startpos);
1496     if (PL_reg_start_tmpl <= prog->nparens) {
1497         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1498         if(PL_reg_start_tmp)
1499             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1500         else
1501             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1502     }
1503
1504     /* XXXX What this code is doing here?!!!  There should be no need
1505        to do this again and again, PL_reglastparen should take care of
1506        this!  */
1507     sp = prog->startp;
1508     ep = prog->endp;
1509     if (prog->nparens) {
1510         for (i = prog->nparens; i >= 1; i--) {
1511             *++sp = -1;
1512             *++ep = -1;
1513         }
1514     }
1515     REGCP_SET;
1516     if (regmatch(prog->program + 1)) {
1517         prog->endp[0] = PL_reginput - PL_bostr;
1518         return 1;
1519     }
1520     REGCP_UNWIND;
1521     return 0;
1522 }
1523
1524 /*
1525  - regmatch - main matching routine
1526  *
1527  * Conceptually the strategy is simple:  check to see whether the current
1528  * node matches, call self recursively to see whether the rest matches,
1529  * and then act accordingly.  In practice we make some effort to avoid
1530  * recursion, in particular by going through "ordinary" nodes (that don't
1531  * need to know whether the rest of the match failed) by a loop instead of
1532  * by recursion.
1533  */
1534 /* [lwall] I've hoisted the register declarations to the outer block in order to
1535  * maybe save a little bit of pushing and popping on the stack.  It also takes
1536  * advantage of machines that use a register save mask on subroutine entry.
1537  */
1538 STATIC I32                      /* 0 failure, 1 success */
1539 S_regmatch(pTHX_ regnode *prog)
1540 {
1541     dTHR;
1542     register regnode *scan;     /* Current node. */
1543     regnode *next;              /* Next node. */
1544     regnode *inner;             /* Next node in internal branch. */
1545     register I32 nextchr;       /* renamed nextchr - nextchar colides with
1546                                    function of same name */
1547     register I32 n;             /* no or next */
1548     register I32 ln;            /* len or last */
1549     register char *s;           /* operand or save */
1550     register char *locinput = PL_reginput;
1551     register I32 c1, c2, paren; /* case fold search, parenth */
1552     int minmod = 0, sw = 0, logical = 0;
1553 #ifdef DEBUGGING
1554     PL_regindent++;
1555 #endif
1556
1557     /* Note that nextchr is a byte even in UTF */
1558     nextchr = UCHARAT(locinput);
1559     scan = prog;
1560     while (scan != NULL) {
1561 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
1562 #ifdef DEBUGGING
1563 #  define sayYES goto yes
1564 #  define sayNO goto no
1565 #  define saySAME(x) if (x) goto yes; else goto no
1566 #  define REPORT_CODE_OFF 24
1567 #else
1568 #  define sayYES return 1
1569 #  define sayNO return 0
1570 #  define saySAME(x) return x
1571 #endif
1572         DEBUG_r( {
1573             SV *prop = sv_newmortal();
1574             int docolor = *PL_colors[0];
1575             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
1576             int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
1577             /* The part of the string before starttry has one color
1578                (pref0_len chars), between starttry and current
1579                position another one (pref_len - pref0_len chars),
1580                after the current position the third one.
1581                We assume that pref0_len <= pref_len, otherwise we
1582                decrease pref0_len.  */
1583             int pref_len = (locinput - PL_bostr > (5 + taill) - l
1584                             ? (5 + taill) - l : locinput - PL_bostr);
1585             int pref0_len = pref_len  - (locinput - PL_reg_starttry);
1586
1587             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
1588                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
1589                       ? (5 + taill) - pref_len : PL_regeol - locinput);
1590             if (pref0_len < 0)
1591                 pref0_len = 0;
1592             if (pref0_len > pref_len)
1593                 pref0_len = pref_len;
1594             regprop(prop, scan);
1595             PerlIO_printf(Perl_debug_log,
1596                           "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
1597                           locinput - PL_bostr,
1598                           PL_colors[4], pref0_len,
1599                           locinput - pref_len, PL_colors[5],
1600                           PL_colors[2], pref_len - pref0_len,
1601                           locinput - pref_len + pref0_len, PL_colors[3],
1602                           (docolor ? "" : "> <"),
1603                           PL_colors[0], l, locinput, PL_colors[1],
1604                           15 - l - pref_len + 1,
1605                           "",
1606                           scan - PL_regprogram, PL_regindent*2, "",
1607                           SvPVX(prop));
1608         } );
1609
1610         next = scan + NEXT_OFF(scan);
1611         if (next == scan)
1612             next = NULL;
1613
1614         switch (OP(scan)) {
1615         case BOL:
1616             if (locinput == PL_bostr
1617                 ? PL_regprev == '\n'
1618                 : (PL_multiline &&
1619                    (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1620             {
1621                 /* regtill = regbol; */
1622                 break;
1623             }
1624             sayNO;
1625         case MBOL:
1626             if (locinput == PL_bostr
1627                 ? PL_regprev == '\n'
1628                 : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1629             {
1630                 break;
1631             }
1632             sayNO;
1633         case SBOL:
1634             if (locinput == PL_regbol && PL_regprev == '\n')
1635                 break;
1636             sayNO;
1637         case GPOS:
1638             if (locinput == PL_reg_ganch)
1639                 break;
1640             sayNO;
1641         case EOL:
1642             if (PL_multiline)
1643                 goto meol;
1644             else
1645                 goto seol;
1646         case MEOL:
1647           meol:
1648             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1649                 sayNO;
1650             break;
1651         case SEOL:
1652           seol:
1653             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1654                 sayNO;
1655             if (PL_regeol - locinput > 1)
1656                 sayNO;
1657             break;
1658         case EOS:
1659             if (PL_regeol != locinput)
1660                 sayNO;
1661             break;
1662         case SANYUTF8:
1663             if (nextchr & 0x80) {
1664                 locinput += PL_utf8skip[nextchr];
1665                 if (locinput > PL_regeol)
1666                     sayNO;
1667                 nextchr = UCHARAT(locinput);
1668                 break;
1669             }
1670             if (!nextchr && locinput >= PL_regeol)
1671                 sayNO;
1672             nextchr = UCHARAT(++locinput);
1673             break;
1674         case SANY:
1675             if (!nextchr && locinput >= PL_regeol)
1676                 sayNO;
1677             nextchr = UCHARAT(++locinput);
1678             break;
1679         case ANYUTF8:
1680             if (nextchr & 0x80) {
1681                 locinput += PL_utf8skip[nextchr];
1682                 if (locinput > PL_regeol)
1683                     sayNO;
1684                 nextchr = UCHARAT(locinput);
1685                 break;
1686             }
1687             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1688                 sayNO;
1689             nextchr = UCHARAT(++locinput);
1690             break;
1691         case REG_ANY:
1692             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1693                 sayNO;
1694             nextchr = UCHARAT(++locinput);
1695             break;
1696         case EXACT:
1697             s = STRING(scan);
1698             ln = STR_LEN(scan);
1699             /* Inline the first character, for speed. */
1700             if (UCHARAT(s) != nextchr)
1701                 sayNO;
1702             if (PL_regeol - locinput < ln)
1703                 sayNO;
1704             if (ln > 1 && memNE(s, locinput, ln))
1705                 sayNO;
1706             locinput += ln;
1707             nextchr = UCHARAT(locinput);
1708             break;
1709         case EXACTFL:
1710             PL_reg_flags |= RF_tainted;
1711             /* FALL THROUGH */
1712         case EXACTF:
1713             s = STRING(scan);
1714             ln = STR_LEN(scan);
1715
1716             if (UTF) {
1717                 char *l = locinput;
1718                 char *e = s + ln;
1719                 c1 = OP(scan) == EXACTF;
1720                 while (s < e) {
1721                     if (l >= PL_regeol)
1722                         sayNO;
1723                     if (utf8_to_uv((U8*)s, 0) != (c1 ?
1724                                                   toLOWER_utf8((U8*)l) :
1725                                                   toLOWER_LC_utf8((U8*)l)))
1726                     {
1727                         sayNO;
1728                     }
1729                     s += UTF8SKIP(s);
1730                     l += UTF8SKIP(l);
1731                 }
1732                 locinput = l;
1733                 nextchr = UCHARAT(locinput);
1734                 break;
1735             }
1736
1737             /* Inline the first character, for speed. */
1738             if (UCHARAT(s) != nextchr &&
1739                 UCHARAT(s) != ((OP(scan) == EXACTF)
1740                                ? PL_fold : PL_fold_locale)[nextchr])
1741                 sayNO;
1742             if (PL_regeol - locinput < ln)
1743                 sayNO;
1744             if (ln > 1 && (OP(scan) == EXACTF
1745                            ? ibcmp(s, locinput, ln)
1746                            : ibcmp_locale(s, locinput, ln)))
1747                 sayNO;
1748             locinput += ln;
1749             nextchr = UCHARAT(locinput);
1750             break;
1751         case ANYOFUTF8:
1752             s = MASK(scan);
1753             if (!REGINCLASSUTF8(scan, (U8*)locinput))
1754                 sayNO;
1755             if (locinput >= PL_regeol)
1756                 sayNO;
1757             locinput += PL_utf8skip[nextchr];
1758             nextchr = UCHARAT(locinput);
1759             break;
1760         case ANYOF:
1761             s = MASK(scan);
1762             if (nextchr < 0)
1763                 nextchr = UCHARAT(locinput);
1764             if (!REGINCLASS(s, nextchr))
1765                 sayNO;
1766             if (!nextchr && locinput >= PL_regeol)
1767                 sayNO;
1768             nextchr = UCHARAT(++locinput);
1769             break;
1770         case ALNUML:
1771             PL_reg_flags |= RF_tainted;
1772             /* FALL THROUGH */
1773         case ALNUM:
1774             if (!nextchr)
1775                 sayNO;
1776             if (!(OP(scan) == ALNUM
1777                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1778                 sayNO;
1779             nextchr = UCHARAT(++locinput);
1780             break;
1781         case ALNUMLUTF8:
1782             PL_reg_flags |= RF_tainted;
1783             /* FALL THROUGH */
1784         case ALNUMUTF8:
1785             if (!nextchr)
1786                 sayNO;
1787             if (nextchr & 0x80) {
1788                 if (!(OP(scan) == ALNUMUTF8
1789                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1790                       : isALNUM_LC_utf8((U8*)locinput)))
1791                 {
1792                     sayNO;
1793                 }
1794                 locinput += PL_utf8skip[nextchr];
1795                 nextchr = UCHARAT(locinput);
1796                 break;
1797             }
1798             if (!(OP(scan) == ALNUMUTF8
1799                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1800                 sayNO;
1801             nextchr = UCHARAT(++locinput);
1802             break;
1803         case NALNUML:
1804             PL_reg_flags |= RF_tainted;
1805             /* FALL THROUGH */
1806         case NALNUM:
1807             if (!nextchr && locinput >= PL_regeol)
1808                 sayNO;
1809             if (OP(scan) == NALNUM
1810                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1811                 sayNO;
1812             nextchr = UCHARAT(++locinput);
1813             break;
1814         case NALNUMLUTF8:
1815             PL_reg_flags |= RF_tainted;
1816             /* FALL THROUGH */
1817         case NALNUMUTF8:
1818             if (!nextchr && locinput >= PL_regeol)
1819                 sayNO;
1820             if (nextchr & 0x80) {
1821                 if (OP(scan) == NALNUMUTF8
1822                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1823                     : isALNUM_LC_utf8((U8*)locinput))
1824                 {
1825                     sayNO;
1826                 }
1827                 locinput += PL_utf8skip[nextchr];
1828                 nextchr = UCHARAT(locinput);
1829                 break;
1830             }
1831             if (OP(scan) == NALNUMUTF8
1832                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1833                 sayNO;
1834             nextchr = UCHARAT(++locinput);
1835             break;
1836         case BOUNDL:
1837         case NBOUNDL:
1838             PL_reg_flags |= RF_tainted;
1839             /* FALL THROUGH */
1840         case BOUND:
1841         case NBOUND:
1842             /* was last char in word? */
1843             ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
1844             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
1845                 ln = isALNUM(ln);
1846                 n = isALNUM(nextchr);
1847             }
1848             else {
1849                 ln = isALNUM_LC(ln);
1850                 n = isALNUM_LC(nextchr);
1851             }
1852             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
1853                 sayNO;
1854             break;
1855         case BOUNDLUTF8:
1856         case NBOUNDLUTF8:
1857             PL_reg_flags |= RF_tainted;
1858             /* FALL THROUGH */
1859         case BOUNDUTF8:
1860         case NBOUNDUTF8:
1861             /* was last char in word? */
1862             ln = (locinput != PL_regbol)
1863                 ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
1864             if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
1865                 ln = isALNUM_uni(ln);
1866                 n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
1867             }
1868             else {
1869                 ln = isALNUM_LC_uni(ln);
1870                 n = isALNUM_LC_utf8((U8*)locinput);
1871             }
1872             if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
1873                 sayNO;
1874             break;
1875         case SPACEL:
1876             PL_reg_flags |= RF_tainted;
1877             /* FALL THROUGH */
1878         case SPACE:
1879             if (!nextchr && locinput >= PL_regeol)
1880                 sayNO;
1881             if (!(OP(scan) == SPACE
1882                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1883                 sayNO;
1884             nextchr = UCHARAT(++locinput);
1885             break;
1886         case SPACELUTF8:
1887             PL_reg_flags |= RF_tainted;
1888             /* FALL THROUGH */
1889         case SPACEUTF8:
1890             if (!nextchr && locinput >= PL_regeol)
1891                 sayNO;
1892             if (nextchr & 0x80) {
1893                 if (!(OP(scan) == SPACEUTF8
1894                       ? swash_fetch(PL_utf8_space,(U8*)locinput)
1895                       : isSPACE_LC_utf8((U8*)locinput)))
1896                 {
1897                     sayNO;
1898                 }
1899                 locinput += PL_utf8skip[nextchr];
1900                 nextchr = UCHARAT(locinput);
1901                 break;
1902             }
1903             if (!(OP(scan) == SPACEUTF8
1904                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1905                 sayNO;
1906             nextchr = UCHARAT(++locinput);
1907             break;
1908         case NSPACEL:
1909             PL_reg_flags |= RF_tainted;
1910             /* FALL THROUGH */
1911         case NSPACE:
1912             if (!nextchr)
1913                 sayNO;
1914             if (OP(scan) == SPACE
1915                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1916                 sayNO;
1917             nextchr = UCHARAT(++locinput);
1918             break;
1919         case NSPACELUTF8:
1920             PL_reg_flags |= RF_tainted;
1921             /* FALL THROUGH */
1922         case NSPACEUTF8:
1923             if (!nextchr)
1924                 sayNO;
1925             if (nextchr & 0x80) {
1926                 if (OP(scan) == NSPACEUTF8
1927                     ? swash_fetch(PL_utf8_space,(U8*)locinput)
1928                     : isSPACE_LC_utf8((U8*)locinput))
1929                 {
1930                     sayNO;
1931                 }
1932                 locinput += PL_utf8skip[nextchr];
1933                 nextchr = UCHARAT(locinput);
1934                 break;
1935             }
1936             if (OP(scan) == NSPACEUTF8
1937                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1938                 sayNO;
1939             nextchr = UCHARAT(++locinput);
1940             break;
1941         case DIGITL:
1942             PL_reg_flags |= RF_tainted;
1943             /* FALL THROUGH */
1944         case DIGIT:
1945             if (!nextchr && locinput >= PL_regeol)
1946                 sayNO;
1947             if (!(OP(scan) == DIGIT
1948                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
1949                 sayNO;
1950             nextchr = UCHARAT(++locinput);
1951             break;
1952         case DIGITLUTF8:
1953             PL_reg_flags |= RF_tainted;
1954             /* FALL THROUGH */
1955         case DIGITUTF8:
1956             if (!nextchr)
1957                 sayNO;
1958             if (nextchr & 0x80) {
1959                 if (OP(scan) == NDIGITUTF8
1960                     ? swash_fetch(PL_utf8_digit,(U8*)locinput)
1961                     : isDIGIT_LC_utf8((U8*)locinput))
1962                 {
1963                     sayNO;
1964                 }
1965                 locinput += PL_utf8skip[nextchr];
1966                 nextchr = UCHARAT(locinput);
1967                 break;
1968             }
1969             if (!isDIGIT(nextchr))
1970                 sayNO;
1971             nextchr = UCHARAT(++locinput);
1972             break;
1973         case NDIGITL:
1974             PL_reg_flags |= RF_tainted;
1975             /* FALL THROUGH */
1976         case NDIGIT:
1977             if (!nextchr)
1978                 sayNO;
1979             if (OP(scan) == DIGIT
1980                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
1981                 sayNO;
1982             nextchr = UCHARAT(++locinput);
1983             break;
1984         case NDIGITLUTF8:
1985             PL_reg_flags |= RF_tainted;
1986             /* FALL THROUGH */
1987         case NDIGITUTF8:
1988             if (!nextchr && locinput >= PL_regeol)
1989                 sayNO;
1990             if (nextchr & 0x80) {
1991                 if (swash_fetch(PL_utf8_digit,(U8*)locinput))
1992                     sayNO;
1993                 locinput += PL_utf8skip[nextchr];
1994                 nextchr = UCHARAT(locinput);
1995                 break;
1996             }
1997             if (isDIGIT(nextchr))
1998                 sayNO;
1999             nextchr = UCHARAT(++locinput);
2000             break;
2001         case CLUMP:
2002             if (locinput >= PL_regeol || swash_fetch(PL_utf8_mark,(U8*)locinput))
2003                 sayNO;
2004             locinput += PL_utf8skip[nextchr];
2005             while (locinput < PL_regeol && swash_fetch(PL_utf8_mark,(U8*)locinput))
2006                 locinput += UTF8SKIP(locinput);
2007             if (locinput > PL_regeol)
2008                 sayNO;
2009             nextchr = UCHARAT(locinput);
2010             break;
2011         case REFFL:
2012             PL_reg_flags |= RF_tainted;
2013             /* FALL THROUGH */
2014         case REF:
2015         case REFF:
2016             n = ARG(scan);  /* which paren pair */
2017             ln = PL_regstartp[n];
2018             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2019             if (*PL_reglastparen < n || ln == -1)
2020                 sayNO;                  /* Do not match unless seen CLOSEn. */
2021             if (ln == PL_regendp[n])
2022                 break;
2023
2024             s = PL_bostr + ln;
2025             if (UTF && OP(scan) != REF) {       /* REF can do byte comparison */
2026                 char *l = locinput;
2027                 char *e = PL_bostr + PL_regendp[n];
2028                 /*
2029                  * Note that we can't do the "other character" lookup trick as
2030                  * in the 8-bit case (no pun intended) because in Unicode we
2031                  * have to map both upper and title case to lower case.
2032                  */
2033                 if (OP(scan) == REFF) {
2034                     while (s < e) {
2035                         if (l >= PL_regeol)
2036                             sayNO;
2037                         if (toLOWER_utf8((U8*)s) != toLOWER_utf8((U8*)l))
2038                             sayNO;
2039                         s += UTF8SKIP(s);
2040                         l += UTF8SKIP(l);
2041                     }
2042                 }
2043                 else {
2044                     while (s < e) {
2045                         if (l >= PL_regeol)
2046                             sayNO;
2047                         if (toLOWER_LC_utf8((U8*)s) != toLOWER_LC_utf8((U8*)l))
2048                             sayNO;
2049                         s += UTF8SKIP(s);
2050                         l += UTF8SKIP(l);
2051                     }
2052                 }
2053                 locinput = l;
2054                 nextchr = UCHARAT(locinput);
2055                 break;
2056             }
2057
2058             /* Inline the first character, for speed. */
2059             if (UCHARAT(s) != nextchr &&
2060                 (OP(scan) == REF ||
2061                  (UCHARAT(s) != ((OP(scan) == REFF
2062                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2063                 sayNO;
2064             ln = PL_regendp[n] - ln;
2065             if (locinput + ln > PL_regeol)
2066                 sayNO;
2067             if (ln > 1 && (OP(scan) == REF
2068                            ? memNE(s, locinput, ln)
2069                            : (OP(scan) == REFF
2070                               ? ibcmp(s, locinput, ln)
2071                               : ibcmp_locale(s, locinput, ln))))
2072                 sayNO;
2073             locinput += ln;
2074             nextchr = UCHARAT(locinput);
2075             break;
2076
2077         case NOTHING:
2078         case TAIL:
2079             break;
2080         case BACK:
2081             break;
2082         case EVAL:
2083         {
2084             dSP;
2085             OP_4tree *oop = PL_op;
2086             COP *ocurcop = PL_curcop;
2087             SV **ocurpad = PL_curpad;
2088             SV *ret;
2089
2090             n = ARG(scan);
2091             PL_op = (OP_4tree*)PL_regdata->data[n];
2092             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", PL_op) );
2093             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2094             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2095
2096             CALLRUNOPS(aTHX);                   /* Scalar context. */
2097             SPAGAIN;
2098             ret = POPs;
2099             PUTBACK;
2100
2101             PL_op = oop;
2102             PL_curpad = ocurpad;
2103             PL_curcop = ocurcop;
2104             if (logical) {
2105                 if (logical == 2) {     /* Postponed subexpression. */
2106                     regexp *re;
2107                     MAGIC *mg = Null(MAGIC*);
2108                     re_cc_state state;
2109                     CHECKPOINT cp, lastcp;
2110
2111                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2112                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2113
2114                         if(SvMAGICAL(sv))
2115                             mg = mg_find(sv, 'r');
2116                     }
2117                     if (mg) {
2118                         re = (regexp *)mg->mg_obj;
2119                         (void)ReREFCNT_inc(re);
2120                     }
2121                     else {
2122                         STRLEN len;
2123                         char *t = SvPV(ret, len);
2124                         PMOP pm;
2125                         char *oprecomp = PL_regprecomp;
2126                         I32 osize = PL_regsize;
2127                         I32 onpar = PL_regnpar;
2128
2129                         pm.op_pmflags = 0;
2130                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2131                         if (!(SvFLAGS(ret)
2132                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2133                             sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0);
2134                         PL_regprecomp = oprecomp;
2135                         PL_regsize = osize;
2136                         PL_regnpar = onpar;
2137                     }
2138                     DEBUG_r(
2139                         PerlIO_printf(Perl_debug_log,
2140                                       "Entering embedded `%s%.60s%s%s'\n",
2141                                       PL_colors[0],
2142                                       re->precomp,
2143                                       PL_colors[1],
2144                                       (strlen(re->precomp) > 60 ? "..." : ""))
2145                         );
2146                     state.node = next;
2147                     state.prev = PL_reg_call_cc;
2148                     state.cc = PL_regcc;
2149                     state.re = PL_reg_re;
2150
2151                     PL_regcc = 0;
2152
2153                     cp = regcppush(0);  /* Save *all* the positions. */
2154                     REGCP_SET;
2155                     cache_re(re);
2156                     state.ss = PL_savestack_ix;
2157                     *PL_reglastparen = 0;
2158                     PL_reg_call_cc = &state;
2159                     PL_reginput = locinput;
2160
2161                     /* XXXX This is too dramatic a measure... */
2162                     PL_reg_maxiter = 0;
2163
2164                     if (regmatch(re->program + 1)) {
2165                         /* Even though we succeeded, we need to restore
2166                            global variables, since we may be wrapped inside
2167                            SUSPEND, thus the match may be not finished yet. */
2168
2169                         /* XXXX Do this only if SUSPENDed? */
2170                         PL_reg_call_cc = state.prev;
2171                         PL_regcc = state.cc;
2172                         PL_reg_re = state.re;
2173                         cache_re(PL_reg_re);
2174
2175                         /* XXXX This is too dramatic a measure... */
2176                         PL_reg_maxiter = 0;
2177
2178                         /* These are needed even if not SUSPEND. */
2179                         ReREFCNT_dec(re);
2180                         regcpblow(cp);
2181                         sayYES;
2182                     }
2183                     DEBUG_r(
2184                         PerlIO_printf(Perl_debug_log,
2185                                       "%*s  failed...\n",
2186                                       REPORT_CODE_OFF+PL_regindent*2, "")
2187                         );
2188                     ReREFCNT_dec(re);
2189                     REGCP_UNWIND;
2190                     regcppop();
2191                     PL_reg_call_cc = state.prev;
2192                     PL_regcc = state.cc;
2193                     PL_reg_re = state.re;
2194                     cache_re(PL_reg_re);
2195
2196                     /* XXXX This is too dramatic a measure... */
2197                     PL_reg_maxiter = 0;
2198
2199                     sayNO;
2200                 }
2201                 sw = SvTRUE(ret);
2202                 logical = 0;
2203             }
2204             else
2205                 sv_setsv(save_scalar(PL_replgv), ret);
2206             break;
2207         }
2208         case OPEN:
2209             n = ARG(scan);  /* which paren pair */
2210             PL_reg_start_tmp[n] = locinput;
2211             if (n > PL_regsize)
2212                 PL_regsize = n;
2213             break;
2214         case CLOSE:
2215             n = ARG(scan);  /* which paren pair */
2216             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2217             PL_regendp[n] = locinput - PL_bostr;
2218             if (n > *PL_reglastparen)
2219                 *PL_reglastparen = n;
2220             break;
2221         case GROUPP:
2222             n = ARG(scan);  /* which paren pair */
2223             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2224             break;
2225         case IFTHEN:
2226             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2227             if (sw)
2228                 next = NEXTOPER(NEXTOPER(scan));
2229             else {
2230                 next = scan + ARG(scan);
2231                 if (OP(next) == IFTHEN) /* Fake one. */
2232                     next = NEXTOPER(NEXTOPER(next));
2233             }
2234             break;
2235         case LOGICAL:
2236             logical = scan->flags;
2237             break;
2238 /*******************************************************************
2239  PL_regcc contains infoblock about the innermost (...)* loop, and
2240  a pointer to the next outer infoblock.
2241
2242  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2243
2244    1) After matching X, regnode for CURLYX is processed;
2245
2246    2) This regnode creates infoblock on the stack, and calls
2247       regmatch() recursively with the starting point at WHILEM node;
2248
2249    3) Each hit of WHILEM node tries to match A and Z (in the order
2250       depending on the current iteration, min/max of {min,max} and
2251       greediness).  The information about where are nodes for "A"
2252       and "Z" is read from the infoblock, as is info on how many times "A"
2253       was already matched, and greediness.
2254
2255    4) After A matches, the same WHILEM node is hit again.
2256
2257    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2258       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2259       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2260       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2261       of the external loop.
2262
2263  Currently present infoblocks form a tree with a stem formed by PL_curcc
2264  and whatever it mentions via ->next, and additional attached trees
2265  corresponding to temporarily unset infoblocks as in "5" above.
2266
2267  In the following picture infoblocks for outer loop of
2268  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2269  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2270  infoblocks are drawn below the "reset" infoblock.
2271
2272  In fact in the picture below we do not show failed matches for Z and T
2273  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2274  more obvious *why* one needs to *temporary* unset infoblocks.]
2275
2276   Matched       REx position    InfoBlocks      Comment
2277                 (Y(A)*?Z)*?T    x
2278                 Y(A)*?Z)*?T     x <- O
2279   Y             (A)*?Z)*?T      x <- O
2280   Y             A)*?Z)*?T       x <- O <- I
2281   YA            )*?Z)*?T        x <- O <- I
2282   YA            A)*?Z)*?T       x <- O <- I
2283   YAA           )*?Z)*?T        x <- O <- I
2284   YAA           Z)*?T           x <- O          # Temporary unset I
2285                                      I
2286
2287   YAAZ          Y(A)*?Z)*?T     x <- O
2288                                      I
2289
2290   YAAZY         (A)*?Z)*?T      x <- O
2291                                      I
2292
2293   YAAZY         A)*?Z)*?T       x <- O <- I
2294                                      I
2295
2296   YAAZYA        )*?Z)*?T        x <- O <- I
2297                                      I
2298
2299   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2300                                      I,I
2301
2302   YAAZYAZ       )*?T            x <- O
2303                                      I,I
2304
2305   YAAZYAZ       T               x               # Temporary unset O
2306                                 O
2307                                 I,I
2308
2309   YAAZYAZT                      x
2310                                 O
2311                                 I,I
2312  *******************************************************************/
2313         case CURLYX: {
2314                 CURCUR cc;
2315                 CHECKPOINT cp = PL_savestack_ix;
2316
2317                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2318                     next += ARG(next);
2319                 cc.oldcc = PL_regcc;
2320                 PL_regcc = &cc;
2321                 cc.parenfloor = *PL_reglastparen;
2322                 cc.cur = -1;
2323                 cc.min = ARG1(scan);
2324                 cc.max  = ARG2(scan);
2325                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2326                 cc.next = next;
2327                 cc.minmod = minmod;
2328                 cc.lastloc = 0;
2329                 PL_reginput = locinput;
2330                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2331                 regcpblow(cp);
2332                 PL_regcc = cc.oldcc;
2333                 saySAME(n);
2334             }
2335             /* NOT REACHED */
2336         case WHILEM: {
2337                 /*
2338                  * This is really hard to understand, because after we match
2339                  * what we're trying to match, we must make sure the rest of
2340                  * the REx is going to match for sure, and to do that we have
2341                  * to go back UP the parse tree by recursing ever deeper.  And
2342                  * if it fails, we have to reset our parent's current state
2343                  * that we can try again after backing off.
2344                  */
2345
2346                 CHECKPOINT cp, lastcp;
2347                 CURCUR* cc = PL_regcc;
2348                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
2349
2350                 n = cc->cur + 1;        /* how many we know we matched */
2351                 PL_reginput = locinput;
2352
2353                 DEBUG_r(
2354                     PerlIO_printf(Perl_debug_log,
2355                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
2356                                   REPORT_CODE_OFF+PL_regindent*2, "",
2357                                   (long)n, (long)cc->min,
2358                                   (long)cc->max, (long)cc)
2359                     );
2360
2361                 /* If degenerate scan matches "", assume scan done. */
2362
2363                 if (locinput == cc->lastloc && n >= cc->min) {
2364                     PL_regcc = cc->oldcc;
2365                     if (PL_regcc)
2366                         ln = PL_regcc->cur;
2367                     DEBUG_r(
2368                         PerlIO_printf(Perl_debug_log,
2369                            "%*s  empty match detected, try continuation...\n",
2370                            REPORT_CODE_OFF+PL_regindent*2, "")
2371                         );
2372                     if (regmatch(cc->next))
2373                         sayYES;
2374                     DEBUG_r(
2375                         PerlIO_printf(Perl_debug_log,
2376                                       "%*s  failed...\n",
2377                                       REPORT_CODE_OFF+PL_regindent*2, "")
2378                         );
2379                     if (PL_regcc)
2380                         PL_regcc->cur = ln;
2381                     PL_regcc = cc;
2382                     sayNO;
2383                 }
2384
2385                 /* First just match a string of min scans. */
2386
2387                 if (n < cc->min) {
2388                     cc->cur = n;
2389                     cc->lastloc = locinput;
2390                     if (regmatch(cc->scan))
2391                         sayYES;
2392                     cc->cur = n - 1;
2393                     cc->lastloc = lastloc;
2394                     DEBUG_r(
2395                         PerlIO_printf(Perl_debug_log,
2396                                       "%*s  failed...\n",
2397                                       REPORT_CODE_OFF+PL_regindent*2, "")
2398                         );
2399                     sayNO;
2400                 }
2401
2402                 if (scan->flags) {
2403                     /* Check whether we already were at this position.
2404                         Postpone detection until we know the match is not
2405                         *that* much linear. */
2406                 if (!PL_reg_maxiter) {
2407                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
2408                     PL_reg_leftiter = PL_reg_maxiter;
2409                 }
2410                 if (PL_reg_leftiter-- == 0) {
2411                     I32 size = (PL_reg_maxiter + 7)/8;
2412                     if (PL_reg_poscache) {
2413                         if (PL_reg_poscache_size < size) {
2414                             Renew(PL_reg_poscache, size, char);
2415                             PL_reg_poscache_size = size;
2416                         }
2417                         Zero(PL_reg_poscache, size, char);
2418                     }
2419                     else {
2420                         PL_reg_poscache_size = size;
2421                         Newz(29, PL_reg_poscache, size, char);
2422                     }
2423                     DEBUG_r(
2424                         PerlIO_printf(Perl_debug_log,
2425               "%sDetected a super-linear match, switching on caching%s...\n",
2426                                       PL_colors[4], PL_colors[5])
2427                         );
2428                 }
2429                 if (PL_reg_leftiter < 0) {
2430                     I32 o = locinput - PL_bostr, b;
2431
2432                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
2433                     b = o % 8;
2434                     o /= 8;
2435                     if (PL_reg_poscache[o] & (1<<b)) {
2436                     DEBUG_r(
2437                         PerlIO_printf(Perl_debug_log,
2438                                       "%*s  already tried at this position...\n",
2439                                       REPORT_CODE_OFF+PL_regindent*2, "")
2440                         );
2441                         sayNO;
2442                     }
2443                     PL_reg_poscache[o] |= (1<<b);
2444                 }
2445                 }
2446
2447                 /* Prefer next over scan for minimal matching. */
2448
2449                 if (cc->minmod) {
2450                     PL_regcc = cc->oldcc;
2451                     if (PL_regcc)
2452                         ln = PL_regcc->cur;
2453                     cp = regcppush(cc->parenfloor);
2454                     REGCP_SET;
2455                     if (regmatch(cc->next)) {
2456                         regcpblow(cp);
2457                         sayYES; /* All done. */
2458                     }
2459                     REGCP_UNWIND;
2460                     regcppop();
2461                     if (PL_regcc)
2462                         PL_regcc->cur = ln;
2463                     PL_regcc = cc;
2464
2465                     if (n >= cc->max) { /* Maximum greed exceeded? */
2466                         if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
2467                             && !(PL_reg_flags & RF_warned)) {
2468                             PL_reg_flags |= RF_warned;
2469                             Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
2470                                  "Complex regular subexpression recursion",
2471                                  REG_INFTY - 1);
2472                         }
2473                         sayNO;
2474                     }
2475
2476                     DEBUG_r(
2477                         PerlIO_printf(Perl_debug_log,
2478                                       "%*s  trying longer...\n",
2479                                       REPORT_CODE_OFF+PL_regindent*2, "")
2480                         );
2481                     /* Try scanning more and see if it helps. */
2482                     PL_reginput = locinput;
2483                     cc->cur = n;
2484                     cc->lastloc = locinput;
2485                     cp = regcppush(cc->parenfloor);
2486                     REGCP_SET;
2487                     if (regmatch(cc->scan)) {
2488                         regcpblow(cp);
2489                         sayYES;
2490                     }
2491                     DEBUG_r(
2492                         PerlIO_printf(Perl_debug_log,
2493                                       "%*s  failed...\n",
2494                                       REPORT_CODE_OFF+PL_regindent*2, "")
2495                         );
2496                     REGCP_UNWIND;
2497                     regcppop();
2498                     cc->cur = n - 1;
2499                     cc->lastloc = lastloc;
2500                     sayNO;
2501                 }
2502
2503                 /* Prefer scan over next for maximal matching. */
2504
2505                 if (n < cc->max) {      /* More greed allowed? */
2506                     cp = regcppush(cc->parenfloor);
2507                     cc->cur = n;
2508                     cc->lastloc = locinput;
2509                     REGCP_SET;
2510                     if (regmatch(cc->scan)) {
2511                         regcpblow(cp);
2512                         sayYES;
2513                     }
2514                     REGCP_UNWIND;
2515                     regcppop();         /* Restore some previous $<digit>s? */
2516                     PL_reginput = locinput;
2517                     DEBUG_r(
2518                         PerlIO_printf(Perl_debug_log,
2519                                       "%*s  failed, try continuation...\n",
2520                                       REPORT_CODE_OFF+PL_regindent*2, "")
2521                         );
2522                 }
2523                 if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
2524                         && !(PL_reg_flags & RF_warned)) {
2525                     PL_reg_flags |= RF_warned;
2526                     Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
2527                          "Complex regular subexpression recursion",
2528                          REG_INFTY - 1);
2529                 }
2530
2531                 /* Failed deeper matches of scan, so see if this one works. */
2532                 PL_regcc = cc->oldcc;
2533                 if (PL_regcc)
2534                     ln = PL_regcc->cur;
2535                 if (regmatch(cc->next))
2536                     sayYES;
2537                 DEBUG_r(
2538                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
2539                                   REPORT_CODE_OFF+PL_regindent*2, "")
2540                     );
2541                 if (PL_regcc)
2542                     PL_regcc->cur = ln;
2543                 PL_regcc = cc;
2544                 cc->cur = n - 1;
2545                 cc->lastloc = lastloc;
2546                 sayNO;
2547             }
2548             /* NOT REACHED */
2549         case BRANCHJ:
2550             next = scan + ARG(scan);
2551             if (next == scan)
2552                 next = NULL;
2553             inner = NEXTOPER(NEXTOPER(scan));
2554             goto do_branch;
2555         case BRANCH:
2556             inner = NEXTOPER(scan);
2557           do_branch:
2558             {
2559                 CHECKPOINT lastcp;
2560                 c1 = OP(scan);
2561                 if (OP(next) != c1)     /* No choice. */
2562                     next = inner;       /* Avoid recursion. */
2563                 else {
2564                     int lastparen = *PL_reglastparen;
2565
2566                     REGCP_SET;
2567                     do {
2568                         PL_reginput = locinput;
2569                         if (regmatch(inner))
2570                             sayYES;
2571                         REGCP_UNWIND;
2572                         for (n = *PL_reglastparen; n > lastparen; n--)
2573                             PL_regendp[n] = -1;
2574                         *PL_reglastparen = n;
2575                         scan = next;
2576                         /*SUPPRESS 560*/
2577                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
2578                             next += n;
2579                         else
2580                             next = NULL;
2581                         inner = NEXTOPER(scan);
2582                         if (c1 == BRANCHJ) {
2583                             inner = NEXTOPER(inner);
2584                         }
2585                     } while (scan != NULL && OP(scan) == c1);
2586                     sayNO;
2587                     /* NOTREACHED */
2588                 }
2589             }
2590             break;
2591         case MINMOD:
2592             minmod = 1;
2593             break;
2594         case CURLYM:
2595         {
2596             I32 l = 0;
2597             CHECKPOINT lastcp;
2598
2599             /* We suppose that the next guy does not need
2600                backtracking: in particular, it is of constant length,
2601                and has no parenths to influence future backrefs. */
2602             ln = ARG1(scan);  /* min to match */
2603             n  = ARG2(scan);  /* max to match */
2604             paren = scan->flags;
2605             if (paren) {
2606                 if (paren > PL_regsize)
2607                     PL_regsize = paren;
2608                 if (paren > *PL_reglastparen)
2609                     *PL_reglastparen = paren;
2610             }
2611             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
2612             if (paren)
2613                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
2614             PL_reginput = locinput;
2615             if (minmod) {
2616                 minmod = 0;
2617                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
2618                     sayNO;
2619                 if (ln && l == 0 && n >= ln
2620                     /* In fact, this is tricky.  If paren, then the
2621                        fact that we did/didnot match may influence
2622                        future execution. */
2623                     && !(paren && ln == 0))
2624                     ln = n;
2625                 locinput = PL_reginput;
2626                 if (PL_regkind[(U8)OP(next)] == EXACT) {
2627                     c1 = (U8)*STRING(next);
2628                     if (OP(next) == EXACTF)
2629                         c2 = PL_fold[c1];
2630                     else if (OP(next) == EXACTFL)
2631                         c2 = PL_fold_locale[c1];
2632                     else
2633                         c2 = c1;
2634                 }
2635                 else
2636                     c1 = c2 = -1000;
2637                 REGCP_SET;
2638                 /* This may be improved if l == 0.  */
2639                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
2640                     /* If it could work, try it. */
2641                     if (c1 == -1000 ||
2642                         UCHARAT(PL_reginput) == c1 ||
2643                         UCHARAT(PL_reginput) == c2)
2644                     {
2645                         if (paren) {
2646                             if (n) {
2647                                 PL_regstartp[paren] =
2648                                     HOPc(PL_reginput, -l) - PL_bostr;
2649                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2650                             }
2651                             else
2652                                 PL_regendp[paren] = -1;
2653                         }
2654                         if (regmatch(next))
2655                             sayYES;
2656                         REGCP_UNWIND;
2657                     }
2658                     /* Couldn't or didn't -- move forward. */
2659                     PL_reginput = locinput;
2660                     if (regrepeat_hard(scan, 1, &l)) {
2661                         ln++;
2662                         locinput = PL_reginput;
2663                     }
2664                     else
2665                         sayNO;
2666                 }
2667             }
2668             else {
2669                 n = regrepeat_hard(scan, n, &l);
2670                 if (n != 0 && l == 0
2671                     /* In fact, this is tricky.  If paren, then the
2672                        fact that we did/didnot match may influence
2673                        future execution. */
2674                     && !(paren && ln == 0))
2675                     ln = n;
2676                 locinput = PL_reginput;
2677                 DEBUG_r(
2678                     PerlIO_printf(Perl_debug_log,
2679                                   "%*s  matched %ld times, len=%ld...\n",
2680                                   REPORT_CODE_OFF+PL_regindent*2, "", n, l)
2681                     );
2682                 if (n >= ln) {
2683                     if (PL_regkind[(U8)OP(next)] == EXACT) {
2684                         c1 = (U8)*STRING(next);
2685                         if (OP(next) == EXACTF)
2686                             c2 = PL_fold[c1];
2687                         else if (OP(next) == EXACTFL)
2688                             c2 = PL_fold_locale[c1];
2689                         else
2690                             c2 = c1;
2691                     }
2692                     else
2693                         c1 = c2 = -1000;
2694                 }
2695                 REGCP_SET;
2696                 while (n >= ln) {
2697                     /* If it could work, try it. */
2698                     if (c1 == -1000 ||
2699                         UCHARAT(PL_reginput) == c1 ||
2700                         UCHARAT(PL_reginput) == c2)
2701                     {
2702                         DEBUG_r(
2703                                 PerlIO_printf(Perl_debug_log,
2704                                               "%*s  trying tail with n=%ld...\n",
2705                                               REPORT_CODE_OFF+PL_regindent*2, "", n)
2706                             );
2707                         if (paren) {
2708                             if (n) {
2709                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
2710                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2711                             }
2712                             else
2713                                 PL_regendp[paren] = -1;
2714                         }
2715                         if (regmatch(next))
2716                             sayYES;
2717                         REGCP_UNWIND;
2718                     }
2719                     /* Couldn't or didn't -- back up. */
2720                     n--;
2721                     locinput = HOPc(locinput, -l);
2722                     PL_reginput = locinput;
2723                 }
2724             }
2725             sayNO;
2726             break;
2727         }
2728         case CURLYN:
2729             paren = scan->flags;        /* Which paren to set */
2730             if (paren > PL_regsize)
2731                 PL_regsize = paren;
2732             if (paren > *PL_reglastparen)
2733                 *PL_reglastparen = paren;
2734             ln = ARG1(scan);  /* min to match */
2735             n  = ARG2(scan);  /* max to match */
2736             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
2737             goto repeat;
2738         case CURLY:
2739             paren = 0;
2740             ln = ARG1(scan);  /* min to match */
2741             n  = ARG2(scan);  /* max to match */
2742             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
2743             goto repeat;
2744         case STAR:
2745             ln = 0;
2746             n = REG_INFTY;
2747             scan = NEXTOPER(scan);
2748             paren = 0;
2749             goto repeat;
2750         case PLUS:
2751             ln = 1;
2752             n = REG_INFTY;
2753             scan = NEXTOPER(scan);
2754             paren = 0;
2755           repeat:
2756             /*
2757             * Lookahead to avoid useless match attempts
2758             * when we know what character comes next.
2759             */
2760             if (PL_regkind[(U8)OP(next)] == EXACT) {
2761                 c1 = (U8)*STRING(next);
2762                 if (OP(next) == EXACTF)
2763                     c2 = PL_fold[c1];
2764                 else if (OP(next) == EXACTFL)
2765                     c2 = PL_fold_locale[c1];
2766                 else
2767                     c2 = c1;
2768             }
2769             else
2770                 c1 = c2 = -1000;
2771             PL_reginput = locinput;
2772             if (minmod) {
2773                 CHECKPOINT lastcp;
2774                 minmod = 0;
2775                 if (ln && regrepeat(scan, ln) < ln)
2776                     sayNO;
2777                 locinput = PL_reginput;
2778                 REGCP_SET;
2779                 if (c1 != -1000) {
2780                     char *e = locinput + n - ln; /* Should not check after this */
2781                     char *old = locinput;
2782
2783                     if (e >= PL_regeol || (n == REG_INFTY))
2784                         e = PL_regeol - 1;
2785                     while (1) {
2786                         /* Find place 'next' could work */
2787                         if (c1 == c2) {
2788                             while (locinput <= e && *locinput != c1)
2789                                 locinput++;
2790                         } else {
2791                             while (locinput <= e
2792                                    && *locinput != c1
2793                                    && *locinput != c2)
2794                                 locinput++;
2795                         }
2796                         if (locinput > e)
2797                             sayNO;
2798                         /* PL_reginput == old now */
2799                         if (locinput != old) {
2800                             ln = 1;     /* Did some */
2801                             if (regrepeat(scan, locinput - old) <
2802                                  locinput - old)
2803                                 sayNO;
2804                         }
2805                         /* PL_reginput == locinput now */
2806                         if (paren) {
2807                             if (ln) {
2808                                 PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr;
2809                                 PL_regendp[paren] = locinput - PL_bostr;
2810                             }
2811                             else
2812                                 PL_regendp[paren] = -1;
2813                         }
2814                         if (regmatch(next))
2815                             sayYES;
2816                         PL_reginput = locinput; /* Could be reset... */
2817                         REGCP_UNWIND;
2818                         /* Couldn't or didn't -- move forward. */
2819                         old = locinput++;
2820                     }
2821                 }
2822                 else
2823                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
2824                     /* If it could work, try it. */
2825                     if (c1 == -1000 ||
2826                         UCHARAT(PL_reginput) == c1 ||
2827                         UCHARAT(PL_reginput) == c2)
2828                     {
2829                         if (paren) {
2830                             if (n) {
2831                                 PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
2832                                 PL_regendp[paren] = PL_reginput - PL_bostr;
2833                             }
2834                             else
2835                                 PL_regendp[paren] = -1;
2836                         }
2837                         if (regmatch(next))
2838                             sayYES;
2839                         REGCP_UNWIND;
2840                     }
2841                     /* Couldn't or didn't -- move forward. */
2842                     PL_reginput = locinput;
2843                     if (regrepeat(scan, 1)) {
2844                         ln++;
2845                         locinput = PL_reginput;
2846                     }
2847                     else
2848                         sayNO;
2849                 }
2850             }
2851             else {
2852                 CHECKPOINT lastcp;
2853                 n = regrepeat(scan, n);
2854                 locinput = PL_reginput;
2855                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
2856                     (!PL_multiline  || OP(next) == SEOL))
2857                     ln = n;                     /* why back off? */
2858                 REGCP_SET;
2859                 if (paren) {
2860                     while (n >= ln) {
2861                         /* If it could work, try it. */
2862                         if (c1 == -1000 ||
2863                             UCHARAT(PL_reginput) == c1 ||
2864                             UCHARAT(PL_reginput) == c2)
2865                             {
2866                                 if (paren && n) {
2867                                     if (n) {
2868                                         PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
2869                                         PL_regendp[paren] = PL_reginput - PL_bostr;
2870                                     }
2871                                     else
2872                                         PL_regendp[paren] = -1;
2873                                 }
2874                                 if (regmatch(next))
2875                                     sayYES;
2876                                 REGCP_UNWIND;
2877                             }
2878                         /* Couldn't or didn't -- back up. */
2879                         n--;
2880                         PL_reginput = locinput = HOPc(locinput, -1);
2881                     }
2882                 }
2883                 else {
2884                     while (n >= ln) {
2885                         /* If it could work, try it. */
2886                         if (c1 == -1000 ||
2887                             UCHARAT(PL_reginput) == c1 ||
2888                             UCHARAT(PL_reginput) == c2)
2889                             {
2890                                 if (regmatch(next))
2891                                     sayYES;
2892                                 REGCP_UNWIND;
2893                             }
2894                         /* Couldn't or didn't -- back up. */
2895                         n--;
2896                         PL_reginput = locinput = HOPc(locinput, -1);
2897                     }
2898                 }
2899             }
2900             sayNO;
2901             break;
2902         case END:
2903             if (PL_reg_call_cc) {
2904                 re_cc_state *cur_call_cc = PL_reg_call_cc;
2905                 CURCUR *cctmp = PL_regcc;
2906                 regexp *re = PL_reg_re;
2907                 CHECKPOINT cp, lastcp;
2908
2909                 cp = regcppush(0);      /* Save *all* the positions. */
2910                 REGCP_SET;
2911                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
2912                                                     the caller. */
2913                 PL_reginput = locinput; /* Make position available to
2914                                            the callcc. */
2915                 cache_re(PL_reg_call_cc->re);
2916                 PL_regcc = PL_reg_call_cc->cc;
2917                 PL_reg_call_cc = PL_reg_call_cc->prev;
2918                 if (regmatch(cur_call_cc->node)) {
2919                     PL_reg_call_cc = cur_call_cc;
2920                     regcpblow(cp);
2921                     sayYES;
2922                 }
2923                 REGCP_UNWIND;
2924                 regcppop();
2925                 PL_reg_call_cc = cur_call_cc;
2926                 PL_regcc = cctmp;
2927                 PL_reg_re = re;
2928                 cache_re(re);
2929
2930                 DEBUG_r(
2931                     PerlIO_printf(Perl_debug_log,
2932                                   "%*s  continuation failed...\n",
2933                                   REPORT_CODE_OFF+PL_regindent*2, "")
2934                     );
2935                 sayNO;
2936             }
2937             if (locinput < PL_regtill)
2938                 sayNO;                  /* Cannot match: too short. */
2939             /* Fall through */
2940         case SUCCEED:
2941             PL_reginput = locinput;     /* put where regtry can find it */
2942             sayYES;                     /* Success! */
2943         case SUSPEND:
2944             n = 1;
2945             PL_reginput = locinput;
2946             goto do_ifmatch;
2947         case UNLESSM:
2948             n = 0;
2949             if (scan->flags) {
2950                 if (UTF) {              /* XXXX This is absolutely
2951                                            broken, we read before
2952                                            start of string. */
2953                     s = HOPMAYBEc(locinput, -scan->flags);
2954                     if (!s)
2955                         goto say_yes;
2956                     PL_reginput = s;
2957                 }
2958                 else {
2959                     if (locinput < PL_bostr + scan->flags)
2960                         goto say_yes;
2961                     PL_reginput = locinput - scan->flags;
2962                     goto do_ifmatch;
2963                 }
2964             }
2965             else
2966                 PL_reginput = locinput;
2967             goto do_ifmatch;
2968         case IFMATCH:
2969             n = 1;
2970             if (scan->flags) {
2971                 if (UTF) {              /* XXXX This is absolutely
2972                                            broken, we read before
2973                                            start of string. */
2974                     s = HOPMAYBEc(locinput, -scan->flags);
2975                     if (!s || s < PL_bostr)
2976                         goto say_no;
2977                     PL_reginput = s;
2978                 }
2979                 else {
2980                     if (locinput < PL_bostr + scan->flags)
2981                         goto say_no;
2982                     PL_reginput = locinput - scan->flags;
2983                     goto do_ifmatch;
2984                 }
2985             }
2986             else
2987                 PL_reginput = locinput;
2988
2989           do_ifmatch:
2990             inner = NEXTOPER(NEXTOPER(scan));
2991             if (regmatch(inner) != n) {
2992               say_no:
2993                 if (logical) {
2994                     logical = 0;
2995                     sw = 0;
2996                     goto do_longjump;
2997                 }
2998                 else
2999                     sayNO;
3000             }
3001           say_yes:
3002             if (logical) {
3003                 logical = 0;
3004                 sw = 1;
3005             }
3006             if (OP(scan) == SUSPEND) {
3007                 locinput = PL_reginput;
3008                 nextchr = UCHARAT(locinput);
3009             }
3010             /* FALL THROUGH. */
3011         case LONGJMP:
3012           do_longjump:
3013             next = scan + ARG(scan);
3014             if (next == scan)
3015                 next = NULL;
3016             break;
3017         default:
3018             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
3019                           (unsigned long)scan, OP(scan));
3020             Perl_croak(aTHX_ "regexp memory corruption");
3021         }
3022         scan = next;
3023     }
3024
3025     /*
3026     * We get here only if there's trouble -- normally "case END" is
3027     * the terminating point.
3028     */
3029     Perl_croak(aTHX_ "corrupted regexp pointers");
3030     /*NOTREACHED*/
3031     sayNO;
3032
3033 yes:
3034 #ifdef DEBUGGING
3035     PL_regindent--;
3036 #endif
3037     return 1;
3038
3039 no:
3040 #ifdef DEBUGGING
3041     PL_regindent--;
3042 #endif
3043     return 0;
3044 }
3045
3046 /*
3047  - regrepeat - repeatedly match something simple, report how many
3048  */
3049 /*
3050  * [This routine now assumes that it will only match on things of length 1.
3051  * That was true before, but now we assume scan - reginput is the count,
3052  * rather than incrementing count on every character.  [Er, except utf8.]]
3053  */
3054 STATIC I32
3055 S_regrepeat(pTHX_ regnode *p, I32 max)
3056 {
3057     dTHR;
3058     register char *scan;
3059     register char *opnd;
3060     register I32 c;
3061     register char *loceol = PL_regeol;
3062     register I32 hardcount = 0;
3063
3064     scan = PL_reginput;
3065     if (max != REG_INFTY && max < loceol - scan)
3066       loceol = scan + max;
3067     switch (OP(p)) {
3068     case REG_ANY:
3069         while (scan < loceol && *scan != '\n')
3070             scan++;
3071         break;
3072     case SANY:
3073         scan = loceol;
3074         break;
3075     case ANYUTF8:
3076         loceol = PL_regeol;
3077         while (scan < loceol && *scan != '\n') {
3078             scan += UTF8SKIP(scan);
3079             hardcount++;
3080         }
3081         break;
3082     case SANYUTF8:
3083         loceol = PL_regeol;
3084         while (scan < loceol) {
3085             scan += UTF8SKIP(scan);
3086             hardcount++;
3087         }
3088         break;
3089     case EXACT:         /* length of string is 1 */
3090         c = (U8)*STRING(p);
3091         while (scan < loceol && UCHARAT(scan) == c)
3092             scan++;
3093         break;
3094     case EXACTF:        /* length of string is 1 */
3095         c = (U8)*STRING(p);
3096         while (scan < loceol &&
3097                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3098             scan++;
3099         break;
3100     case EXACTFL:       /* length of string is 1 */
3101         PL_reg_flags |= RF_tainted;
3102         c = (U8)*STRING(p);
3103         while (scan < loceol &&
3104                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3105             scan++;
3106         break;
3107     case ANYOFUTF8:
3108         loceol = PL_regeol;
3109         while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
3110             scan += UTF8SKIP(scan);
3111             hardcount++;
3112         }
3113         break;
3114     case ANYOF:
3115         opnd = MASK(p);
3116         while (scan < loceol && REGINCLASS(opnd, *scan))
3117             scan++;
3118         break;
3119     case ALNUM:
3120         while (scan < loceol && isALNUM(*scan))
3121             scan++;
3122         break;
3123     case ALNUMUTF8:
3124         loceol = PL_regeol;
3125         while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3126             scan += UTF8SKIP(scan);
3127             hardcount++;
3128         }
3129         break;
3130     case ALNUML:
3131         PL_reg_flags |= RF_tainted;
3132         while (scan < loceol && isALNUM_LC(*scan))
3133             scan++;
3134         break;
3135     case ALNUMLUTF8:
3136         PL_reg_flags |= RF_tainted;
3137         loceol = PL_regeol;
3138         while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
3139             scan += UTF8SKIP(scan);
3140             hardcount++;
3141         }
3142         break;
3143         break;
3144     case NALNUM:
3145         while (scan < loceol && !isALNUM(*scan))
3146             scan++;
3147         break;
3148     case NALNUMUTF8:
3149         loceol = PL_regeol;
3150         while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3151             scan += UTF8SKIP(scan);
3152             hardcount++;
3153         }
3154         break;
3155     case NALNUML:
3156         PL_reg_flags |= RF_tainted;
3157         while (scan < loceol && !isALNUM_LC(*scan))
3158             scan++;
3159         break;
3160     case NALNUMLUTF8:
3161         PL_reg_flags |= RF_tainted;
3162         loceol = PL_regeol;
3163         while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
3164             scan += UTF8SKIP(scan);
3165             hardcount++;
3166         }
3167         break;
3168     case SPACE:
3169         while (scan < loceol && isSPACE(*scan))
3170             scan++;
3171         break;
3172     case SPACEUTF8:
3173         loceol = PL_regeol;
3174         while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3175             scan += UTF8SKIP(scan);
3176             hardcount++;
3177         }
3178         break;
3179     case SPACEL:
3180         PL_reg_flags |= RF_tainted;
3181         while (scan < loceol && isSPACE_LC(*scan))
3182             scan++;
3183         break;
3184     case SPACELUTF8:
3185         PL_reg_flags |= RF_tainted;
3186         loceol = PL_regeol;
3187         while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3188             scan += UTF8SKIP(scan);
3189             hardcount++;
3190         }
3191         break;
3192     case NSPACE:
3193         while (scan < loceol && !isSPACE(*scan))
3194             scan++;
3195         break;
3196     case NSPACEUTF8:
3197         loceol = PL_regeol;
3198         while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3199             scan += UTF8SKIP(scan);
3200             hardcount++;
3201         }
3202         break;
3203     case NSPACEL:
3204         PL_reg_flags |= RF_tainted;
3205         while (scan < loceol && !isSPACE_LC(*scan))
3206             scan++;
3207         break;
3208     case NSPACELUTF8:
3209         PL_reg_flags |= RF_tainted;
3210         loceol = PL_regeol;
3211         while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3212             scan += UTF8SKIP(scan);
3213             hardcount++;
3214         }
3215         break;
3216     case DIGIT:
3217         while (scan < loceol && isDIGIT(*scan))
3218             scan++;
3219         break;
3220     case DIGITUTF8:
3221         loceol = PL_regeol;
3222         while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
3223             scan += UTF8SKIP(scan);
3224             hardcount++;
3225         }
3226         break;
3227         break;
3228     case NDIGIT:
3229         while (scan < loceol && !isDIGIT(*scan))
3230             scan++;
3231         break;
3232     case NDIGITUTF8:
3233         loceol = PL_regeol;
3234         while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
3235             scan += UTF8SKIP(scan);
3236             hardcount++;
3237         }
3238         break;
3239     default:            /* Called on something of 0 width. */
3240         break;          /* So match right here or not at all. */
3241     }
3242
3243     if (hardcount)
3244         c = hardcount;
3245     else
3246         c = scan - PL_reginput;
3247     PL_reginput = scan;
3248
3249     DEBUG_r(
3250         {
3251                 SV *prop = sv_newmortal();
3252
3253                 regprop(prop, p);
3254                 PerlIO_printf(Perl_debug_log,
3255                               "%*s  %s can match %ld times out of %ld...\n",
3256                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
3257         });
3258
3259     return(c);
3260 }
3261
3262 /*
3263  - regrepeat_hard - repeatedly match something, report total lenth and length
3264  *
3265  * The repeater is supposed to have constant length.
3266  */
3267
3268 STATIC I32
3269 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
3270 {
3271     dTHR;
3272     register char *scan;
3273     register char *start;
3274     register char *loceol = PL_regeol;
3275     I32 l = 0;
3276     I32 count = 0, res = 1;
3277
3278     if (!max)
3279         return 0;
3280
3281     start = PL_reginput;
3282     if (UTF) {
3283         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3284             if (!count++) {
3285                 l = 0;
3286                 while (start < PL_reginput) {
3287                     l++;
3288                     start += UTF8SKIP(start);
3289                 }
3290                 *lp = l;
3291                 if (l == 0)
3292                     return max;
3293             }
3294             if (count == max)
3295                 return count;
3296         }
3297     }
3298     else {
3299         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3300             if (!count++) {
3301                 *lp = l = PL_reginput - start;
3302                 if (max != REG_INFTY && l*max < loceol - scan)
3303                     loceol = scan + l*max;
3304                 if (l == 0)
3305                     return max;
3306             }
3307         }
3308     }
3309     if (!res)
3310         PL_reginput = scan;
3311
3312     return count;
3313 }
3314
3315 /*
3316  - reginclass - determine if a character falls into a character class
3317  */
3318
3319 STATIC bool
3320 S_reginclass(pTHX_ register char *p, register I32 c)
3321 {
3322     dTHR;
3323     char flags = ANYOF_FLAGS(p);
3324     bool match = FALSE;
3325
3326     c &= 0xFF;
3327     if (ANYOF_BITMAP_TEST(p, c))
3328         match = TRUE;
3329     else if (flags & ANYOF_FOLD) {
3330         I32 cf;
3331         if (flags & ANYOF_LOCALE) {
3332             PL_reg_flags |= RF_tainted;
3333             cf = PL_fold_locale[c];
3334         }
3335         else
3336             cf = PL_fold[c];
3337         if (ANYOF_BITMAP_TEST(p, cf))
3338             match = TRUE;
3339     }
3340
3341     if (!match && (flags & ANYOF_CLASS)) {
3342         PL_reg_flags |= RF_tainted;
3343         if (
3344             (ANYOF_CLASS_TEST(p, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
3345             (ANYOF_CLASS_TEST(p, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
3346             (ANYOF_CLASS_TEST(p, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
3347             (ANYOF_CLASS_TEST(p, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
3348             (ANYOF_CLASS_TEST(p, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
3349             (ANYOF_CLASS_TEST(p, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
3350             (ANYOF_CLASS_TEST(p, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
3351             (ANYOF_CLASS_TEST(p, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
3352             (ANYOF_CLASS_TEST(p, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
3353             (ANYOF_CLASS_TEST(p, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
3354             (ANYOF_CLASS_TEST(p, ANYOF_ASCII)   &&  isASCII(c))     ||
3355             (ANYOF_CLASS_TEST(p, ANYOF_NASCII)  && !isASCII(c))     ||
3356             (ANYOF_CLASS_TEST(p, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
3357             (ANYOF_CLASS_TEST(p, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
3358             (ANYOF_CLASS_TEST(p, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
3359             (ANYOF_CLASS_TEST(p, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
3360             (ANYOF_CLASS_TEST(p, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
3361             (ANYOF_CLASS_TEST(p, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
3362             (ANYOF_CLASS_TEST(p, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
3363             (ANYOF_CLASS_TEST(p, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
3364             (ANYOF_CLASS_TEST(p, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
3365             (ANYOF_CLASS_TEST(p, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
3366             (ANYOF_CLASS_TEST(p, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
3367             (ANYOF_CLASS_TEST(p, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
3368             (ANYOF_CLASS_TEST(p, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
3369             (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c))
3370             ) /* How's that for a conditional? */
3371         {
3372             match = TRUE;
3373         }
3374     }
3375
3376     return (flags & ANYOF_INVERT) ? !match : match;
3377 }
3378
3379 STATIC bool
3380 S_reginclassutf8(pTHX_ regnode *f, U8 *p)
3381 {
3382     dTHR;
3383     char flags = ARG1(f);
3384     bool match = FALSE;
3385     SV *sv = (SV*)PL_regdata->data[ARG2(f)];
3386
3387     if (swash_fetch(sv, p))
3388         match = TRUE;
3389     else if (flags & ANYOF_FOLD) {
3390         I32 cf;
3391         U8 tmpbuf[10];
3392         if (flags & ANYOF_LOCALE) {
3393             PL_reg_flags |= RF_tainted;
3394             uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
3395         }
3396         else
3397             uv_to_utf8(tmpbuf, toLOWER_utf8(p));
3398         if (swash_fetch(sv, tmpbuf))
3399             match = TRUE;
3400     }
3401
3402     /* UTF8 combined with ANYOF_CLASS is ill-defined. */
3403
3404     return (flags & ANYOF_INVERT) ? !match : match;
3405 }
3406
3407 STATIC U8 *
3408 S_reghop(pTHX_ U8 *s, I32 off)
3409 {
3410     dTHR;
3411     if (off >= 0) {
3412         while (off-- && s < (U8*)PL_regeol)
3413             s += UTF8SKIP(s);
3414     }
3415     else {
3416         while (off++) {
3417             if (s > (U8*)PL_bostr) {
3418                 s--;
3419                 if (*s & 0x80) {
3420                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3421                         s--;
3422                 }               /* XXX could check well-formedness here */
3423             }
3424         }
3425     }
3426     return s;
3427 }
3428
3429 STATIC U8 *
3430 S_reghopmaybe(pTHX_ U8* s, I32 off)
3431 {
3432     dTHR;
3433     if (off >= 0) {
3434         while (off-- && s < (U8*)PL_regeol)
3435             s += UTF8SKIP(s);
3436         if (off >= 0)
3437             return 0;
3438     }
3439     else {
3440         while (off++) {
3441             if (s > (U8*)PL_bostr) {
3442                 s--;
3443                 if (*s & 0x80) {
3444                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3445                         s--;
3446                 }               /* XXX could check well-formedness here */
3447             }
3448             else
3449                 break;
3450         }
3451         if (off <= 0)
3452             return 0;
3453     }
3454     return s;
3455 }
3456
3457 #ifdef PERL_OBJECT
3458 #define NO_XSLOCKS
3459 #include "XSUB.h"
3460 #endif
3461
3462 static void
3463 restore_pos(pTHXo_ void *arg)
3464 {
3465     dTHR;
3466     if (PL_reg_eval_set) {
3467         if (PL_reg_oldsaved) {
3468             PL_reg_re->subbeg = PL_reg_oldsaved;
3469             PL_reg_re->sublen = PL_reg_oldsavedlen;
3470             RX_MATCH_COPIED_on(PL_reg_re);
3471         }
3472         PL_reg_magic->mg_len = PL_reg_oldpos;
3473         PL_reg_eval_set = 0;
3474         PL_curpm = PL_reg_oldcurpm;
3475     }
3476 }
3477