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