regexec.c

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