regexec.c

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