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