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