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