regexec.c

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