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 && SvPOK(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         STRLEN ln;
 785         unsigned int c1;
 786         unsigned 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, *(U8*)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 = *(U8*)m;
 822             c2 = PL_fold[c1];
 823             goto do_exactf;
 824         case EXACTFL:
 825             m = STRING(c);
 826             ln = STR_LEN(c);
 827             c1 = *(U8*)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 ( *(U8*)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 ( (*(U8*)s == c1 || *(U8*)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_REGEXP) && n >= REG_INFTY
2667                             && !(PL_reg_flags & RF_warned)) {
2668                             PL_reg_flags |= RF_warned;
2669                             Perl_warner(aTHX_ WARN_REGEXP, "%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_REGEXP) && n >= REG_INFTY
2719                         && !(PL_reg_flags & RF_warned)) {
2720                     PL_reg_flags |= RF_warned;
2721                     Perl_warner(aTHX_ WARN_REGEXP, "%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 || OP(next) == EOS)) {
3049                     ln = n;                     /* why back off? */
3050                     /* ...because $ and \Z can match before *and* after
3051                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3052                        We should back off by one in this case. */
3053                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3054                         ln--;
3055                 }
3056                 REGCP_SET;
3057                 if (paren) {
3058                     while (n >= ln) {
3059                         /* If it could work, try it. */
3060                         if (c1 == -1000 ||
3061                             UCHARAT(PL_reginput) == c1 ||
3062                             UCHARAT(PL_reginput) == c2)
3063                             {
3064                                 if (paren && n) {
3065                                     if (n) {
3066                                         PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
3067                                         PL_regendp[paren] = PL_reginput - PL_bostr;
3068                                     }
3069                                     else
3070                                         PL_regendp[paren] = -1;
3071                                 }
3072                                 if (regmatch(next))
3073                                     sayYES;
3074                                 REGCP_UNWIND;
3075                             }
3076                         /* Couldn't or didn't -- back up. */
3077                         n--;
3078                         PL_reginput = locinput = HOPc(locinput, -1);
3079                     }
3080                 }
3081                 else {
3082                     while (n >= ln) {
3083                         /* If it could work, try it. */
3084                         if (c1 == -1000 ||
3085                             UCHARAT(PL_reginput) == c1 ||
3086                             UCHARAT(PL_reginput) == c2)
3087                             {
3088                                 if (regmatch(next))
3089                                     sayYES;
3090                                 REGCP_UNWIND;
3091                             }
3092                         /* Couldn't or didn't -- back up. */
3093                         n--;
3094                         PL_reginput = locinput = HOPc(locinput, -1);
3095                     }
3096                 }
3097             }
3098             sayNO;
3099             break;
3100         case END:
3101             if (PL_reg_call_cc) {
3102                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3103                 CURCUR *cctmp = PL_regcc;
3104                 regexp *re = PL_reg_re;
3105                 CHECKPOINT cp, lastcp;
3106
3107                 cp = regcppush(0);      /* Save *all* the positions. */
3108                 REGCP_SET;
3109                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3110                                                     the caller. */
3111                 PL_reginput = locinput; /* Make position available to
3112                                            the callcc. */
3113                 cache_re(PL_reg_call_cc->re);
3114                 PL_regcc = PL_reg_call_cc->cc;
3115                 PL_reg_call_cc = PL_reg_call_cc->prev;
3116                 if (regmatch(cur_call_cc->node)) {
3117                     PL_reg_call_cc = cur_call_cc;
3118                     regcpblow(cp);
3119                     sayYES;
3120                 }
3121                 REGCP_UNWIND;
3122                 regcppop();
3123                 PL_reg_call_cc = cur_call_cc;
3124                 PL_regcc = cctmp;
3125                 PL_reg_re = re;
3126                 cache_re(re);
3127
3128                 DEBUG_r(
3129                     PerlIO_printf(Perl_debug_log,
3130                                   "%*s  continuation failed...\n",
3131                                   REPORT_CODE_OFF+PL_regindent*2, "")
3132                     );
3133                 sayNO_SILENT;
3134             }
3135             if (locinput < PL_regtill) {
3136                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3137                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3138                                       PL_colors[4],
3139                                       (long)(locinput - PL_reg_starttry),
3140                                       (long)(PL_regtill - PL_reg_starttry),
3141                                       PL_colors[5]));
3142                 sayNO_FINAL;            /* Cannot match: too short. */
3143             }
3144             PL_reginput = locinput;     /* put where regtry can find it */
3145             sayYES_FINAL;               /* Success! */
3146         case SUCCEED:
3147             PL_reginput = locinput;     /* put where regtry can find it */
3148             sayYES_LOUD;                /* Success! */
3149         case SUSPEND:
3150             n = 1;
3151             PL_reginput = locinput;
3152             goto do_ifmatch;
3153         case UNLESSM:
3154             n = 0;
3155             if (scan->flags) {
3156                 if (UTF) {              /* XXXX This is absolutely
3157                                            broken, we read before
3158                                            start of string. */
3159                     s = HOPMAYBEc(locinput, -scan->flags);
3160                     if (!s)
3161                         goto say_yes;
3162                     PL_reginput = s;
3163                 }
3164                 else {
3165                     if (locinput < PL_bostr + scan->flags)
3166                         goto say_yes;
3167                     PL_reginput = locinput - scan->flags;
3168                     goto do_ifmatch;
3169                 }
3170             }
3171             else
3172                 PL_reginput = locinput;
3173             goto do_ifmatch;
3174         case IFMATCH:
3175             n = 1;
3176             if (scan->flags) {
3177                 if (UTF) {              /* XXXX This is absolutely
3178                                            broken, we read before
3179                                            start of string. */
3180                     s = HOPMAYBEc(locinput, -scan->flags);
3181                     if (!s || s < PL_bostr)
3182                         goto say_no;
3183                     PL_reginput = s;
3184                 }
3185                 else {
3186                     if (locinput < PL_bostr + scan->flags)
3187                         goto say_no;
3188                     PL_reginput = locinput - scan->flags;
3189                     goto do_ifmatch;
3190                 }
3191             }
3192             else
3193                 PL_reginput = locinput;
3194
3195           do_ifmatch:
3196             inner = NEXTOPER(NEXTOPER(scan));
3197             if (regmatch(inner) != n) {
3198               say_no:
3199                 if (logical) {
3200                     logical = 0;
3201                     sw = 0;
3202                     goto do_longjump;
3203                 }
3204                 else
3205                     sayNO;
3206             }
3207           say_yes:
3208             if (logical) {
3209                 logical = 0;
3210                 sw = 1;
3211             }
3212             if (OP(scan) == SUSPEND) {
3213                 locinput = PL_reginput;
3214                 nextchr = UCHARAT(locinput);
3215             }
3216             /* FALL THROUGH. */
3217         case LONGJMP:
3218           do_longjump:
3219             next = scan + ARG(scan);
3220             if (next == scan)
3221                 next = NULL;
3222             break;
3223         default:
3224             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3225                           PTR2UV(scan), OP(scan));
3226             Perl_croak(aTHX_ "regexp memory corruption");
3227         }
3228         scan = next;
3229     }
3230
3231     /*
3232     * We get here only if there's trouble -- normally "case END" is
3233     * the terminating point.
3234     */
3235     Perl_croak(aTHX_ "corrupted regexp pointers");
3236     /*NOTREACHED*/
3237     sayNO;
3238
3239 yes_loud:
3240     DEBUG_r(
3241         PerlIO_printf(Perl_debug_log,
3242                       "%*s  %scould match...%s\n",
3243                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3244         );
3245     goto yes;
3246 yes_final:
3247     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3248                           PL_colors[4],PL_colors[5]));
3249 yes:
3250 #ifdef DEBUGGING
3251     PL_regindent--;
3252 #endif
3253     return 1;
3254
3255 no:
3256     DEBUG_r(
3257         PerlIO_printf(Perl_debug_log,
3258                       "%*s  %sfailed...%s\n",
3259                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3260         );
3261     goto do_no;
3262 no_final:
3263 do_no:
3264 #ifdef DEBUGGING
3265     PL_regindent--;
3266 #endif
3267     return 0;
3268 }
3269
3270 /*
3271  - regrepeat - repeatedly match something simple, report how many
3272  */
3273 /*
3274  * [This routine now assumes that it will only match on things of length 1.
3275  * That was true before, but now we assume scan - reginput is the count,
3276  * rather than incrementing count on every character.  [Er, except utf8.]]
3277  */
3278 STATIC I32
3279 S_regrepeat(pTHX_ regnode *p, I32 max)
3280 {
3281     dTHR;
3282     register char *scan;
3283     register I32 c;
3284     register char *loceol = PL_regeol;
3285     register I32 hardcount = 0;
3286
3287     scan = PL_reginput;
3288     if (max != REG_INFTY && max < loceol - scan)
3289       loceol = scan + max;
3290     switch (OP(p)) {
3291     case REG_ANY:
3292         while (scan < loceol && *scan != '\n')
3293             scan++;
3294         break;
3295     case SANY:
3296         scan = loceol;
3297         break;
3298     case ANYUTF8:
3299         loceol = PL_regeol;
3300         while (scan < loceol && *scan != '\n') {
3301             scan += UTF8SKIP(scan);
3302             hardcount++;
3303         }
3304         break;
3305     case SANYUTF8:
3306         loceol = PL_regeol;
3307         while (scan < loceol) {
3308             scan += UTF8SKIP(scan);
3309             hardcount++;
3310         }
3311         break;
3312     case EXACT:         /* length of string is 1 */
3313         c = (U8)*STRING(p);
3314         while (scan < loceol && UCHARAT(scan) == c)
3315             scan++;
3316         break;
3317     case EXACTF:        /* length of string is 1 */
3318         c = (U8)*STRING(p);
3319         while (scan < loceol &&
3320                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3321             scan++;
3322         break;
3323     case EXACTFL:       /* length of string is 1 */
3324         PL_reg_flags |= RF_tainted;
3325         c = (U8)*STRING(p);
3326         while (scan < loceol &&
3327                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3328             scan++;
3329         break;
3330     case ANYOFUTF8:
3331         loceol = PL_regeol;
3332         while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
3333             scan += UTF8SKIP(scan);
3334             hardcount++;
3335         }
3336         break;
3337     case ANYOF:
3338         while (scan < loceol && REGINCLASS(p, *scan))
3339             scan++;
3340         break;
3341     case ALNUM:
3342         while (scan < loceol && isALNUM(*scan))
3343             scan++;
3344         break;
3345     case ALNUMUTF8:
3346         loceol = PL_regeol;
3347         while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3348             scan += UTF8SKIP(scan);
3349             hardcount++;
3350         }
3351         break;
3352     case ALNUML:
3353         PL_reg_flags |= RF_tainted;
3354         while (scan < loceol && isALNUM_LC(*scan))
3355             scan++;
3356         break;
3357     case ALNUMLUTF8:
3358         PL_reg_flags |= RF_tainted;
3359         loceol = PL_regeol;
3360         while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
3361             scan += UTF8SKIP(scan);
3362             hardcount++;
3363         }
3364         break;
3365         break;
3366     case NALNUM:
3367         while (scan < loceol && !isALNUM(*scan))
3368             scan++;
3369         break;
3370     case NALNUMUTF8:
3371         loceol = PL_regeol;
3372         while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
3373             scan += UTF8SKIP(scan);
3374             hardcount++;
3375         }
3376         break;
3377     case NALNUML:
3378         PL_reg_flags |= RF_tainted;
3379         while (scan < loceol && !isALNUM_LC(*scan))
3380             scan++;
3381         break;
3382     case NALNUMLUTF8:
3383         PL_reg_flags |= RF_tainted;
3384         loceol = PL_regeol;
3385         while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
3386             scan += UTF8SKIP(scan);
3387             hardcount++;
3388         }
3389         break;
3390     case SPACE:
3391         while (scan < loceol && isSPACE(*scan))
3392             scan++;
3393         break;
3394     case SPACEUTF8:
3395         loceol = PL_regeol;
3396         while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3397             scan += UTF8SKIP(scan);
3398             hardcount++;
3399         }
3400         break;
3401     case SPACEL:
3402         PL_reg_flags |= RF_tainted;
3403         while (scan < loceol && isSPACE_LC(*scan))
3404             scan++;
3405         break;
3406     case SPACELUTF8:
3407         PL_reg_flags |= RF_tainted;
3408         loceol = PL_regeol;
3409         while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3410             scan += UTF8SKIP(scan);
3411             hardcount++;
3412         }
3413         break;
3414     case NSPACE:
3415         while (scan < loceol && !isSPACE(*scan))
3416             scan++;
3417         break;
3418     case NSPACEUTF8:
3419         loceol = PL_regeol;
3420         while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
3421             scan += UTF8SKIP(scan);
3422             hardcount++;
3423         }
3424         break;
3425     case NSPACEL:
3426         PL_reg_flags |= RF_tainted;
3427         while (scan < loceol && !isSPACE_LC(*scan))
3428             scan++;
3429         break;
3430     case NSPACELUTF8:
3431         PL_reg_flags |= RF_tainted;
3432         loceol = PL_regeol;
3433         while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3434             scan += UTF8SKIP(scan);
3435             hardcount++;
3436         }
3437         break;
3438     case DIGIT:
3439         while (scan < loceol && isDIGIT(*scan))
3440             scan++;
3441         break;
3442     case DIGITUTF8:
3443         loceol = PL_regeol;
3444         while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
3445             scan += UTF8SKIP(scan);
3446             hardcount++;
3447         }
3448         break;
3449         break;
3450     case NDIGIT:
3451         while (scan < loceol && !isDIGIT(*scan))
3452             scan++;
3453         break;
3454     case NDIGITUTF8:
3455         loceol = PL_regeol;
3456         while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
3457             scan += UTF8SKIP(scan);
3458             hardcount++;
3459         }
3460         break;
3461     default:            /* Called on something of 0 width. */
3462         break;          /* So match right here or not at all. */
3463     }
3464
3465     if (hardcount)
3466         c = hardcount;
3467     else
3468         c = scan - PL_reginput;
3469     PL_reginput = scan;
3470
3471     DEBUG_r(
3472         {
3473                 SV *prop = sv_newmortal();
3474
3475                 regprop(prop, p);
3476                 PerlIO_printf(Perl_debug_log,
3477                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
3478                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
3479         });
3480
3481     return(c);
3482 }
3483
3484 /*
3485  - regrepeat_hard - repeatedly match something, report total lenth and length
3486  *
3487  * The repeater is supposed to have constant length.
3488  */
3489
3490 STATIC I32
3491 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
3492 {
3493     dTHR;
3494     register char *scan;
3495     register char *start;
3496     register char *loceol = PL_regeol;
3497     I32 l = 0;
3498     I32 count = 0, res = 1;
3499
3500     if (!max)
3501         return 0;
3502
3503     start = PL_reginput;
3504     if (UTF) {
3505         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3506             if (!count++) {
3507                 l = 0;
3508                 while (start < PL_reginput) {
3509                     l++;
3510                     start += UTF8SKIP(start);
3511                 }
3512                 *lp = l;
3513                 if (l == 0)
3514                     return max;
3515             }
3516             if (count == max)
3517                 return count;
3518         }
3519     }
3520     else {
3521         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
3522             if (!count++) {
3523                 *lp = l = PL_reginput - start;
3524                 if (max != REG_INFTY && l*max < loceol - scan)
3525                     loceol = scan + l*max;
3526                 if (l == 0)
3527                     return max;
3528             }
3529         }
3530     }
3531     if (!res)
3532         PL_reginput = scan;
3533
3534     return count;
3535 }
3536
3537 /*
3538  - reginclass - determine if a character falls into a character class
3539  */
3540
3541 STATIC bool
3542 S_reginclass(pTHX_ register regnode *p, register I32 c)
3543 {
3544     dTHR;
3545     char flags = ANYOF_FLAGS(p);
3546     bool match = FALSE;
3547
3548     c &= 0xFF;
3549     if (ANYOF_BITMAP_TEST(p, c))
3550         match = TRUE;
3551     else if (flags & ANYOF_FOLD) {
3552         I32 cf;
3553         if (flags & ANYOF_LOCALE) {
3554             PL_reg_flags |= RF_tainted;
3555             cf = PL_fold_locale[c];
3556         }
3557         else
3558             cf = PL_fold[c];
3559         if (ANYOF_BITMAP_TEST(p, cf))
3560             match = TRUE;
3561     }
3562
3563     if (!match && (flags & ANYOF_CLASS)) {
3564         PL_reg_flags |= RF_tainted;
3565         if (
3566             (ANYOF_CLASS_TEST(p, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
3567             (ANYOF_CLASS_TEST(p, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
3568             (ANYOF_CLASS_TEST(p, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
3569             (ANYOF_CLASS_TEST(p, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
3570             (ANYOF_CLASS_TEST(p, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
3571             (ANYOF_CLASS_TEST(p, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
3572             (ANYOF_CLASS_TEST(p, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
3573             (ANYOF_CLASS_TEST(p, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
3574             (ANYOF_CLASS_TEST(p, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
3575             (ANYOF_CLASS_TEST(p, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
3576             (ANYOF_CLASS_TEST(p, ANYOF_ASCII)   &&  isASCII(c))     ||
3577             (ANYOF_CLASS_TEST(p, ANYOF_NASCII)  && !isASCII(c))     ||
3578             (ANYOF_CLASS_TEST(p, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
3579             (ANYOF_CLASS_TEST(p, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
3580             (ANYOF_CLASS_TEST(p, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
3581             (ANYOF_CLASS_TEST(p, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
3582             (ANYOF_CLASS_TEST(p, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
3583             (ANYOF_CLASS_TEST(p, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
3584             (ANYOF_CLASS_TEST(p, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
3585             (ANYOF_CLASS_TEST(p, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
3586             (ANYOF_CLASS_TEST(p, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
3587             (ANYOF_CLASS_TEST(p, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
3588             (ANYOF_CLASS_TEST(p, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
3589             (ANYOF_CLASS_TEST(p, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
3590             (ANYOF_CLASS_TEST(p, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
3591             (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c))
3592             ) /* How's that for a conditional? */
3593         {
3594             match = TRUE;
3595         }
3596     }
3597
3598     return (flags & ANYOF_INVERT) ? !match : match;
3599 }
3600
3601 STATIC bool
3602 S_reginclassutf8(pTHX_ regnode *f, U8 *p)
3603 {
3604     dTHR;
3605     char flags = ARG1(f);
3606     bool match = FALSE;
3607     SV *sv = (SV*)PL_regdata->data[ARG2(f)];
3608
3609     if (swash_fetch(sv, p))
3610         match = TRUE;
3611     else if (flags & ANYOF_FOLD) {
3612         I32 cf;
3613         U8 tmpbuf[UTF8_MAXLEN];
3614         if (flags & ANYOF_LOCALE) {
3615             PL_reg_flags |= RF_tainted;
3616             uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
3617         }
3618         else
3619             uv_to_utf8(tmpbuf, toLOWER_utf8(p));
3620         if (swash_fetch(sv, tmpbuf))
3621             match = TRUE;
3622     }
3623
3624     /* UTF8 combined with ANYOF_CLASS is ill-defined. */
3625
3626     return (flags & ANYOF_INVERT) ? !match : match;
3627 }
3628
3629 STATIC U8 *
3630 S_reghop(pTHX_ U8 *s, I32 off)
3631 {
3632     dTHR;
3633     if (off >= 0) {
3634         while (off-- && s < (U8*)PL_regeol)
3635             s += UTF8SKIP(s);
3636     }
3637     else {
3638         while (off++) {
3639             if (s > (U8*)PL_bostr) {
3640                 s--;
3641                 if (*s & 0x80) {
3642                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3643                         s--;
3644                 }               /* XXX could check well-formedness here */
3645             }
3646         }
3647     }
3648     return s;
3649 }
3650
3651 STATIC U8 *
3652 S_reghopmaybe(pTHX_ U8* s, I32 off)
3653 {
3654     dTHR;
3655     if (off >= 0) {
3656         while (off-- && s < (U8*)PL_regeol)
3657             s += UTF8SKIP(s);
3658         if (off >= 0)
3659             return 0;
3660     }
3661     else {
3662         while (off++) {
3663             if (s > (U8*)PL_bostr) {
3664                 s--;
3665                 if (*s & 0x80) {
3666                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
3667                         s--;
3668                 }               /* XXX could check well-formedness here */
3669             }
3670             else
3671                 break;
3672         }
3673         if (off <= 0)
3674             return 0;
3675     }
3676     return s;
3677 }
3678
3679 #ifdef PERL_OBJECT
3680 #include "XSUB.h"
3681 #endif
3682
3683 static void
3684 restore_pos(pTHXo_ void *arg)
3685 {
3686     dTHR;
3687     if (PL_reg_eval_set) {
3688         if (PL_reg_oldsaved) {
3689             PL_reg_re->subbeg = PL_reg_oldsaved;
3690             PL_reg_re->sublen = PL_reg_oldsavedlen;
3691             RX_MATCH_COPIED_on(PL_reg_re);
3692         }
3693         PL_reg_magic->mg_len = PL_reg_oldpos;
3694         PL_reg_eval_set = 0;
3695         PL_curpm = PL_reg_oldcurpm;
3696     }
3697 }
3698