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