regexec.c

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