regexec.c

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