regexec.c

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