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