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