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