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