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