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