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 #  ifndef 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 /* *These* symbols are masked to allow static link. */
  39 #  define Perl_pregexec my_pregexec
  40 #endif
  41
  42 /*SUPPRESS 112*/
  43 /*
  44  * pregcomp and pregexec -- regsub and regerror are not used in perl
  45  *
  46  *      Copyright (c) 1986 by University of Toronto.
  47  *      Written by Henry Spencer.  Not derived from licensed software.
  48  *
  49  *      Permission is granted to anyone to use this software for any
  50  *      purpose on any computer system, and to redistribute it freely,
  51  *      subject to the following restrictions:
  52  *
  53  *      1. The author is not responsible for the consequences of use of
  54  *              this software, no matter how awful, even if they arise
  55  *              from defects in it.
  56  *
  57  *      2. The origin of this software must not be misrepresented, either
  58  *              by explicit claim or by omission.
  59  *
  60  *      3. Altered versions must be plainly marked as such, and must not
  61  *              be misrepresented as being the original software.
  62  *
  63  ****    Alterations to Henry's code are...
  64  ****
  65  ****    Copyright (c) 1991-1998, Larry Wall
  66  ****
  67  ****    You may distribute under the terms of either the GNU General Public
  68  ****    License or the Artistic License, as specified in the README file.
  69  *
  70  * Beware that some of this code is subtly aware of the way operator
  71  * precedence is structured in regular expressions.  Serious changes in
  72  * regular-expression syntax might require a total rethink.
  73  */
  74 #include "EXTERN.h"
  75 #include "perl.h"
  76
  77 #include "regcomp.h"
  78
  79 #define RF_tainted      1               /* tainted information used? */
  80 #define RF_warned       2               /* warned about big count? */
  81 #define RF_evaled       4               /* Did an EVAL with setting? */
  82 #define RF_utf8         8               /* String contains multibyte chars? */
  83
  84 #define UTF (PL_reg_flags & RF_utf8)
  85
  86 #define RS_init         1               /* eval environment created */
  87 #define RS_set          2               /* replsv value is set */
  88
  89 #ifndef STATIC
  90 #define STATIC  static
  91 #endif
  92
  93 #ifndef PERL_OBJECT
  94 typedef I32 CHECKPOINT;
  95
  96 /*
  97  * Forwards.
  98  */
  99
 100 static I32 regmatch _((regnode *prog));
 101 static I32 regrepeat _((regnode *p, I32 max));
 102 static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
 103 static I32 regtry _((regexp *prog, char *startpos));
 104
 105 static bool reginclass _((char *p, I32 c));
 106 static bool reginclassutf8 _((regnode *f, U8* p));
 107 static CHECKPOINT regcppush _((I32 parenfloor));
 108 static char * regcppop _((void));
 109 static char * regcp_set_to _((I32 ss));
 110 static void cache_re _((regexp *prog));
 111 #endif
 112
 113 #define REGINCLASS(p,c)  (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
 114 #define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
 115
 116 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 117 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 118
 119 #ifndef PERL_OBJECT
 120 static U8 * reghop _((U8 *pos, I32 off));
 121 static U8 * reghopmaybe _((U8 *pos, I32 off));
 122 #endif
 123 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 124 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
 125 #define HOP(pos,off) (UTF ? reghop((U8*)pos, off) : (U8*)(pos + off))
 126 #define HOPMAYBE(pos,off) (UTF ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 127 #define HOPc(pos,off) ((char*)HOP(pos,off))
 128 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 129
 130 STATIC CHECKPOINT
 131 regcppush(I32 parenfloor)
 132 {
 133     dTHR;
 134     int retval = PL_savestack_ix;
 135     int i = (PL_regsize - parenfloor) * 4;
 136     int p;
 137
 138     SSCHECK(i + 5);
 139     for (p = PL_regsize; p > parenfloor; p--) {
 140         SSPUSHPTR(PL_regendp[p]);
 141         SSPUSHPTR(PL_regstartp[p]);
 142         SSPUSHPTR(PL_reg_start_tmp[p]);
 143         SSPUSHINT(p);
 144     }
 145     SSPUSHINT(PL_regsize);
 146     SSPUSHINT(*PL_reglastparen);
 147     SSPUSHPTR(PL_reginput);
 148     SSPUSHINT(i + 3);
 149     SSPUSHINT(SAVEt_REGCONTEXT);
 150     return retval;
 151 }
 152
 153 /* These are needed since we do not localize EVAL nodes: */
 154 #  define REGCP_SET  DEBUG_r(PerlIO_printf(Perl_debug_log,              \
 155                              "  Setting an EVAL scope, savestack=%i\n", \
 156                              PL_savestack_ix)); lastcp = PL_savestack_ix
 157
 158 #  define REGCP_UNWIND  DEBUG_r(lastcp != PL_savestack_ix ?             \
 159                                 PerlIO_printf(Perl_debug_log,           \
 160                                 "  Clearing an EVAL scope, savestack=%i..%i\n", \
 161                                 lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
 162
 163 STATIC char *
 164 regcppop(void)
 165 {
 166     dTHR;
 167     I32 i = SSPOPINT;
 168     U32 paren = 0;
 169     char *input;
 170     char *tmps;
 171     assert(i == SAVEt_REGCONTEXT);
 172     i = SSPOPINT;
 173     input = (char *) SSPOPPTR;
 174     *PL_reglastparen = SSPOPINT;
 175     PL_regsize = SSPOPINT;
 176     for (i -= 3; i > 0; i -= 4) {
 177         paren = (U32)SSPOPINT;
 178         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 179         PL_regstartp[paren] = (char *) SSPOPPTR;
 180         tmps = (char*)SSPOPPTR;
 181         if (paren <= *PL_reglastparen)
 182             PL_regendp[paren] = tmps;
 183         DEBUG_r(
 184             PerlIO_printf(Perl_debug_log,
 185                           "     restoring \\%d to %d(%d)..%d%s\n",
 186                           paren, PL_regstartp[paren] - PL_regbol,
 187                           PL_reg_start_tmp[paren] - PL_regbol,
 188                           PL_regendp[paren] - PL_regbol,
 189                           (paren > *PL_reglastparen ? "(no)" : ""));
 190         );
 191     }
 192     DEBUG_r(
 193         if (*PL_reglastparen + 1 <= PL_regnpar) {
 194             PerlIO_printf(Perl_debug_log,
 195                           "     restoring \\%d..\\%d to undef\n",
 196                           *PL_reglastparen + 1, PL_regnpar);
 197         }
 198     );
 199     for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
 200         if (paren > PL_regsize)
 201             PL_regstartp[paren] = Nullch;
 202         PL_regendp[paren] = Nullch;
 203     }
 204     return input;
 205 }
 206
 207 STATIC char *
 208 regcp_set_to(I32 ss)
 209 {
 210     dTHR;
 211     I32 tmp = PL_savestack_ix;
 212
 213     PL_savestack_ix = ss;
 214     regcppop();
 215     PL_savestack_ix = tmp;
 216     return Nullch;
 217 }
 218
 219 typedef struct re_cc_state
 220 {
 221     I32 ss;
 222     regnode *node;
 223     struct re_cc_state *prev;
 224     CURCUR *cc;
 225     regexp *re;
 226 } re_cc_state;
 227
 228 #define regcpblow(cp) LEAVE_SCOPE(cp)
 229
 230 /*
 231  * pregexec and friends
 232  */
 233
 234 /*
 235  - pregexec - match a regexp against a string
 236  */
 237 I32
 238 pregexec(register regexp *prog, char *stringarg, register char *strend,
 239          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 240 /* strend: pointer to null at end of string */
 241 /* strbeg: real beginning of string */
 242 /* minend: end of match must be >=minend after stringarg. */
 243 /* nosave: For optimizations. */
 244 {
 245     return
 246         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 247                       nosave ? 0 : REXEC_COPY_STR);
 248 }
 249
 250 STATIC void
 251 cache_re(regexp *prog)
 252 {
 253     dTHR;
 254     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
 255 #ifdef DEBUGGING
 256     PL_regprogram = prog->program;
 257 #endif
 258     PL_regnpar = prog->nparens;
 259     PL_regdata = prog->data;
 260     PL_reg_re = prog;
 261 }
 262
 263 /*
 264  - regexec_flags - match a regexp against a string
 265  */
 266 I32
 267 regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 268               char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
 269 /* strend: pointer to null at end of string */
 270 /* strbeg: real beginning of string */
 271 /* minend: end of match must be >=minend after stringarg. */
 272 /* data: May be used for some additional optimizations. */
 273 /* nosave: For optimizations. */
 274 {
 275     dTHR;
 276     register char *s;
 277     register regnode *c;
 278     register char *startpos = stringarg;
 279     register I32 tmp;
 280     I32 minlen;         /* must match at least this many chars */
 281     I32 dontbother = 0; /* how many characters not to try at end */
 282     CURCUR cc;
 283     I32 start_shift = 0;                /* Offset of the start to find
 284                                          constant substr. */            /* CC */
 285     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
 286     I32 scream_pos = -1;                /* Internal iterator of scream. */
 287     char *scream_olds;
 288     SV* oreplsv = GvSV(PL_replgv);
 289
 290     cc.cur = 0;
 291     cc.oldcc = 0;
 292     PL_regcc = &cc;
 293
 294     cache_re(prog);
 295 #ifdef DEBUGGING
 296     PL_regnarrate = PL_debug & 512;
 297 #endif
 298
 299     /* Be paranoid... */
 300     if (prog == NULL || startpos == NULL) {
 301         croak("NULL regexp parameter");
 302         return 0;
 303     }
 304
 305     minlen = prog->minlen;
 306     if (strend - startpos < minlen) goto phooey;
 307
 308     if (startpos == strbeg)     /* is ^ valid at stringarg? */
 309         PL_regprev = '\n';
 310     else {
 311         PL_regprev = (U32)stringarg[-1];
 312         if (!PL_multiline && PL_regprev == '\n')
 313             PL_regprev = '\0';          /* force ^ to NOT match */
 314     }
 315
 316     /* Check validity of program. */
 317     if (UCHARAT(prog->program) != REG_MAGIC) {
 318         FAIL("corrupted regexp program");
 319     }
 320
 321     PL_reg_flags = 0;
 322     PL_reg_eval_set = 0;
 323
 324     if (prog->reganch & ROPT_UTF8)
 325         PL_reg_flags |= RF_utf8;
 326
 327     /* Mark beginning of line for ^ and lookbehind. */
 328     PL_regbol = startpos;
 329     PL_bostr  = strbeg;
 330
 331     /* Mark end of line for $ (and such) */
 332     PL_regeol = strend;
 333
 334     /* see how far we have to get to not match where we matched before */
 335     PL_regtill = startpos+minend;
 336
 337     /* We start without call_cc context.  */
 338     PL_reg_call_cc = 0;
 339
 340     /* If there is a "must appear" string, look for it. */
 341     s = startpos;
 342     if (!(flags & REXEC_CHECKED)
 343         && prog->check_substr != Nullsv &&
 344         !(prog->reganch & ROPT_ANCH_GPOS) &&
 345         (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
 346          || (PL_multiline && prog->check_substr == prog->anchored_substr)) )
 347     {
 348         char *t;
 349         start_shift = prog->check_offset_min;   /* okay to underestimate on CC */
 350         /* Should be nonnegative! */
 351         end_shift = minlen - start_shift - CHR_SVLEN(prog->check_substr);
 352         if (screamer) {
 353             if (PL_screamfirst[BmRARE(prog->check_substr)] >= 0)
 354                     s = screaminstr(screamer, prog->check_substr,
 355                                     start_shift + (stringarg - strbeg),
 356                                     end_shift, &scream_pos, 0);
 357             else
 358                     s = Nullch;
 359             scream_olds = s;
 360         }
 361         else
 362             s = fbm_instr((unsigned char*)s + start_shift,
 363                           (unsigned char*)strend - end_shift,
 364                 prog->check_substr, 0);
 365         if (!s) {
 366             ++BmUSEFUL(prog->check_substr);     /* hooray */
 367             goto phooey;        /* not present */
 368         }
 369         else if (s - stringarg > prog->check_offset_max &&
 370                  (UTF
 371                     ? ((t = reghopmaybe_c(s, -(prog->check_offset_max))) && t >= stringarg)
 372                     : (t = s - prog->check_offset_max) != 0
 373                  )
 374                 )
 375         {
 376             ++BmUSEFUL(prog->check_substr);     /* hooray/2 */
 377             s = t;
 378         }
 379         else if (!(prog->reganch & ROPT_NAUGHTY)
 380                    && --BmUSEFUL(prog->check_substr) < 0
 381                    && prog->check_substr == prog->float_substr) { /* boo */
 382             SvREFCNT_dec(prog->check_substr);
 383             prog->check_substr = Nullsv;        /* disable */
 384             prog->float_substr = Nullsv;        /* clear */
 385             s = startpos;
 386         }
 387         else
 388             s = startpos;
 389     }
 390
 391     DEBUG_r(
 392         PerlIO_printf(Perl_debug_log,
 393                       "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
 394                       PL_colors[4],PL_colors[5],PL_colors[0],
 395                       prog->precomp,
 396                       PL_colors[1],
 397                       (strlen(prog->precomp) > 60 ? "..." : ""),
 398                       PL_colors[0],
 399                       (strend - startpos > 60 ? 60 : strend - startpos),
 400                       startpos, PL_colors[1],
 401                       (strend - startpos > 60 ? "..." : ""))
 402         );
 403
 404     /* Simplest case:  anchored match need be tried only once. */
 405     /*  [unless only anchor is BOL and multiline is set] */
 406     if (prog->reganch & ROPT_ANCH) {
 407         if (regtry(prog, startpos))
 408             goto got_it;
 409         else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
 410                  (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
 411                   || (prog->reganch & ROPT_ANCH_MBOL)))
 412         {
 413             if (minlen)
 414                 dontbother = minlen - 1;
 415             strend = HOPc(strend, -dontbother);
 416             /* for multiline we only have to try after newlines */
 417             if (s > startpos)
 418                 s--;
 419             while (s < strend) {
 420                 if (*s++ == '\n') {     /* don't need utf8skip here */
 421                     if (s < strend && regtry(prog, s))
 422                         goto got_it;
 423                 }
 424             }
 425         }
 426         goto phooey;
 427     }
 428
 429     /* Messy cases:  unanchored match. */
 430     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
 431         /* we have /x+whatever/ */
 432         /* it must be a one character string */
 433         char ch = SvPVX(prog->anchored_substr)[0];
 434         if (UTF) {
 435             while (s < strend) {
 436                 if (*s == ch) {
 437                     if (regtry(prog, s)) goto got_it;
 438                     s += UTF8SKIP(s);
 439                     while (s < strend && *s == ch)
 440                         s += UTF8SKIP(s);
 441                 }
 442                 s += UTF8SKIP(s);
 443             }
 444         }
 445         else {
 446             while (s < strend) {
 447                 if (*s == ch) {
 448                     if (regtry(prog, s)) goto got_it;
 449                     s++;
 450                     while (s < strend && *s == ch)
 451                         s++;
 452                 }
 453                 s++;
 454             }
 455         }
 456     }
 457     /*SUPPRESS 560*/
 458     else if (prog->anchored_substr != Nullsv
 459              || (prog->float_substr != Nullsv
 460                  && prog->float_max_offset < strend - s)) {
 461         SV *must = prog->anchored_substr
 462             ? prog->anchored_substr : prog->float_substr;
 463         I32 back_max =
 464             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
 465         I32 back_min =
 466             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
 467         I32 delta = back_max - back_min;
 468         char *last = HOPc(strend, 0-(CHR_SVLEN(must) + back_min)); /* Cannot start after this */
 469         char *last1;            /* Last position checked before */
 470
 471         if (s > PL_bostr)
 472             last1 = HOPc(s, -1);
 473         else
 474             last1 = s - 1;      /* bogus */
 475
 476         /* XXXX check_substr already used to find `s', can optimize if
 477            check_substr==must. */
 478         scream_pos = -1;
 479         dontbother = end_shift;
 480         strend = HOPc(strend, -dontbother);
 481         while ( (s <= last) &&
 482                 (screamer
 483                  ? (s = screaminstr(screamer, must, HOPc(s, back_min) - strbeg,
 484                                     end_shift, &scream_pos, 0))
 485                  : (s = fbm_instr((unsigned char*)HOP(s, back_min),
 486                                   (unsigned char*)strend, must, 0))) ) {
 487             if (HOPc(s, -back_max) > last1) {
 488                 last1 = HOPc(s, -back_min);
 489                 s = HOPc(s, -back_max);
 490             }
 491             else {
 492                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
 493
 494                 last1 = HOPc(s, -back_min);
 495                 s = t;
 496             }
 497             if (UTF) {
 498                 while (s <= last1) {
 499                     if (regtry(prog, s))
 500                         goto got_it;
 501                     s += UTF8SKIP(s);
 502                 }
 503             }
 504             else {
 505                 while (s <= last1) {
 506                     if (regtry(prog, s))
 507                         goto got_it;
 508                     s++;
 509                 }
 510             }
 511         }
 512         goto phooey;
 513     }
 514     else if (c = prog->regstclass) {
 515         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 516         char *cc;
 517
 518         if (minlen)
 519             dontbother = minlen - 1;
 520         strend = HOPc(strend, -dontbother);     /* don't bother with what can't match */
 521         tmp = 1;
 522         /* We know what class it must start with. */
 523         switch (OP(c)) {
 524         case ANYOFUTF8:
 525             cc = (char *) OPERAND(c);
 526             while (s < strend) {
 527                 if (REGINCLASSUTF8(c, (U8*)s)) {
 528                     if (tmp && regtry(prog, s))
 529                         goto got_it;
 530                     else
 531                         tmp = doevery;
 532                 }
 533                 else
 534                     tmp = 1;
 535                 s += UTF8SKIP(s);
 536             }
 537             break;
 538         case ANYOF:
 539             cc = (char *) OPERAND(c);
 540             while (s < strend) {
 541                 if (REGINCLASS(cc, *s)) {
 542                     if (tmp && regtry(prog, s))
 543                         goto got_it;
 544                     else
 545                         tmp = doevery;
 546                 }
 547                 else
 548                     tmp = 1;
 549                 s++;
 550             }
 551             break;
 552         case BOUNDL:
 553             PL_reg_flags |= RF_tainted;
 554             /* FALL THROUGH */
 555         case BOUND:
 556             if (minlen) {
 557                 dontbother++;
 558                 strend -= 1;
 559             }
 560             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 561             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 562             while (s < strend) {
 563                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
 564                     tmp = !tmp;
 565                     if (regtry(prog, s))
 566                         goto got_it;
 567                 }
 568                 s++;
 569             }
 570             if ((minlen || tmp) && regtry(prog,s))
 571                 goto got_it;
 572             break;
 573         case BOUNDLUTF8:
 574             PL_reg_flags |= RF_tainted;
 575             /* FALL THROUGH */
 576         case BOUNDUTF8:
 577             if (minlen) {
 578                 dontbother++;
 579                 strend = reghop_c(strend, -1);
 580             }
 581             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 582             tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 583             while (s < strend) {
 584                 if (tmp == !(OP(c) == BOUND ?
 585                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 586                              isALNUM_LC_utf8((U8*)s)))
 587                 {
 588                     tmp = !tmp;
 589                     if (regtry(prog, s))
 590                         goto got_it;
 591                 }
 592                 s += UTF8SKIP(s);
 593             }
 594             if ((minlen || tmp) && regtry(prog,s))
 595                 goto got_it;
 596             break;
 597         case NBOUNDL:
 598             PL_reg_flags |= RF_tainted;
 599             /* FALL THROUGH */
 600         case NBOUND:
 601             if (minlen) {
 602                 dontbother++;
 603                 strend -= 1;
 604             }
 605             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 606             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 607             while (s < strend) {
 608                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
 609                     tmp = !tmp;
 610                 else if (regtry(prog, s))
 611                     goto got_it;
 612                 s++;
 613             }
 614             if ((minlen || !tmp) && regtry(prog,s))
 615                 goto got_it;
 616             break;
 617         case NBOUNDLUTF8:
 618             PL_reg_flags |= RF_tainted;
 619             /* FALL THROUGH */
 620         case NBOUNDUTF8:
 621             if (minlen) {
 622                 dontbother++;
 623                 strend = reghop_c(strend, -1);
 624             }
 625             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
 626             tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 627             while (s < strend) {
 628                 if (tmp == !(OP(c) == NBOUND ?
 629                              swash_fetch(PL_utf8_alnum, (U8*)s) :
 630                              isALNUM_LC_utf8((U8*)s)))
 631                     tmp = !tmp;
 632                 else if (regtry(prog, s))
 633                     goto got_it;
 634                 s += UTF8SKIP(s);
 635             }
 636             if ((minlen || !tmp) && regtry(prog,s))
 637                 goto got_it;
 638             break;
 639         case ALNUM:
 640             while (s < strend) {
 641                 if (isALNUM(*s)) {
 642                     if (tmp && regtry(prog, s))
 643                         goto got_it;
 644                     else
 645                         tmp = doevery;
 646                 }
 647                 else
 648                     tmp = 1;
 649                 s++;
 650             }
 651             break;
 652         case ALNUMUTF8:
 653             while (s < strend) {
 654                 if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
 655                     if (tmp && regtry(prog, s))
 656                         goto got_it;
 657                     else
 658                         tmp = doevery;
 659                 }
 660                 else
 661                     tmp = 1;
 662                 s += UTF8SKIP(s);
 663             }
 664             break;
 665         case ALNUML:
 666             PL_reg_flags |= RF_tainted;
 667             while (s < strend) {
 668                 if (isALNUM_LC(*s)) {
 669                     if (tmp && regtry(prog, s))
 670                         goto got_it;
 671                     else
 672                         tmp = doevery;
 673                 }
 674                 else
 675                     tmp = 1;
 676                 s++;
 677             }
 678             break;
 679         case ALNUMLUTF8:
 680             PL_reg_flags |= RF_tainted;
 681             while (s < strend) {
 682                 if (isALNUM_LC_utf8((U8*)s)) {
 683                     if (tmp && regtry(prog, s))
 684                         goto got_it;
 685                     else
 686                         tmp = doevery;
 687                 }
 688                 else
 689                     tmp = 1;
 690                 s += UTF8SKIP(s);
 691             }
 692             break;
 693         case NALNUM:
 694             while (s < strend) {
 695                 if (!isALNUM(*s)) {
 696                     if (tmp && regtry(prog, s))
 697                         goto got_it;
 698                     else
 699                         tmp = doevery;
 700                 }
 701                 else
 702                     tmp = 1;
 703                 s++;
 704             }
 705             break;
 706         case NALNUMUTF8:
 707             while (s < strend) {
 708                 if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
 709                     if (tmp && regtry(prog, s))
 710                         goto got_it;
 711                     else
 712                         tmp = doevery;
 713                 }
 714                 else
 715                     tmp = 1;
 716                 s += UTF8SKIP(s);
 717             }
 718             break;
 719         case NALNUML:
 720             PL_reg_flags |= RF_tainted;
 721             while (s < strend) {
 722                 if (!isALNUM_LC(*s)) {
 723                     if (tmp && regtry(prog, s))
 724                         goto got_it;
 725                     else
 726                         tmp = doevery;
 727                 }
 728                 else
 729                     tmp = 1;
 730                 s++;
 731             }
 732             break;
 733         case NALNUMLUTF8:
 734             PL_reg_flags |= RF_tainted;
 735             while (s < strend) {
 736                 if (!isALNUM_LC_utf8((U8*)s)) {
 737                     if (tmp && regtry(prog, s))
 738                         goto got_it;
 739                     else
 740                         tmp = doevery;
 741                 }
 742                 else
 743                     tmp = 1;
 744                 s += UTF8SKIP(s);
 745             }
 746             break;
 747         case SPACE:
 748             while (s < strend) {
 749                 if (isSPACE(*s)) {
 750                     if (tmp && regtry(prog, s))
 751                         goto got_it;
 752                     else
 753                         tmp = doevery;
 754                 }
 755                 else
 756                     tmp = 1;
 757                 s++;
 758             }
 759             break;
 760         case SPACEUTF8:
 761             while (s < strend) {
 762                 if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
 763                     if (tmp && regtry(prog, s))
 764                         goto got_it;
 765                     else
 766                         tmp = doevery;
 767                 }
 768                 else
 769                     tmp = 1;
 770                 s += UTF8SKIP(s);
 771             }
 772             break;
 773         case SPACEL:
 774             PL_reg_flags |= RF_tainted;
 775             while (s < strend) {
 776                 if (isSPACE_LC(*s)) {
 777                     if (tmp && regtry(prog, s))
 778                         goto got_it;
 779                     else
 780                         tmp = doevery;
 781                 }
 782                 else
 783                     tmp = 1;
 784                 s++;
 785             }
 786             break;
 787         case SPACELUTF8:
 788             PL_reg_flags |= RF_tainted;
 789             while (s < strend) {
 790                 if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
 791                     if (tmp && regtry(prog, s))
 792                         goto got_it;
 793                     else
 794                         tmp = doevery;
 795                 }
 796                 else
 797                     tmp = 1;
 798                 s += UTF8SKIP(s);
 799             }
 800             break;
 801         case NSPACE:
 802             while (s < strend) {
 803                 if (!isSPACE(*s)) {
 804                     if (tmp && regtry(prog, s))
 805                         goto got_it;
 806                     else
 807                         tmp = doevery;
 808                 }
 809                 else
 810                     tmp = 1;
 811                 s++;
 812             }
 813             break;
 814         case NSPACEUTF8:
 815             while (s < strend) {
 816                 if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
 817                     if (tmp && regtry(prog, s))
 818                         goto got_it;
 819                     else
 820                         tmp = doevery;
 821                 }
 822                 else
 823                     tmp = 1;
 824                 s += UTF8SKIP(s);
 825             }
 826             break;
 827         case NSPACEL:
 828             PL_reg_flags |= RF_tainted;
 829             while (s < strend) {
 830                 if (!isSPACE_LC(*s)) {
 831                     if (tmp && regtry(prog, s))
 832                         goto got_it;
 833                     else
 834                         tmp = doevery;
 835                 }
 836                 else
 837                     tmp = 1;
 838                 s++;
 839             }
 840             break;
 841         case NSPACELUTF8:
 842             PL_reg_flags |= RF_tainted;
 843             while (s < strend) {
 844                 if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
 845                     if (tmp && regtry(prog, s))
 846                         goto got_it;
 847                     else
 848                         tmp = doevery;
 849                 }
 850                 else
 851                     tmp = 1;
 852                 s += UTF8SKIP(s);
 853             }
 854             break;
 855         case DIGIT:
 856             while (s < strend) {
 857                 if (isDIGIT(*s)) {
 858                     if (tmp && regtry(prog, s))
 859                         goto got_it;
 860                     else
 861                         tmp = doevery;
 862                 }
 863                 else
 864                     tmp = 1;
 865                 s++;
 866             }
 867             break;
 868         case DIGITUTF8:
 869             while (s < strend) {
 870                 if (swash_fetch(PL_utf8_digit,(U8*)s)) {
 871                     if (tmp && regtry(prog, s))
 872                         goto got_it;
 873                     else
 874                         tmp = doevery;
 875                 }
 876                 else
 877                     tmp = 1;
 878                 s += UTF8SKIP(s);
 879             }
 880             break;
 881         case NDIGIT:
 882             while (s < strend) {
 883                 if (!isDIGIT(*s)) {
 884                     if (tmp && regtry(prog, s))
 885                         goto got_it;
 886                     else
 887                         tmp = doevery;
 888                 }
 889                 else
 890                     tmp = 1;
 891                 s++;
 892             }
 893             break;
 894         case NDIGITUTF8:
 895             while (s < strend) {
 896                 if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
 897                     if (tmp && regtry(prog, s))
 898                         goto got_it;
 899                     else
 900                         tmp = doevery;
 901                 }
 902                 else
 903                     tmp = 1;
 904                 s += UTF8SKIP(s);
 905             }
 906             break;
 907         }
 908     }
 909     else {
 910         dontbother = 0;
 911         if (prog->float_substr != Nullsv) {     /* Trim the end. */
 912             char *last;
 913             I32 oldpos = scream_pos;
 914
 915             if (screamer) {
 916                 last = screaminstr(screamer, prog->float_substr, s - strbeg,
 917                                    end_shift, &scream_pos, 1); /* last one */
 918                 if (!last) {
 919                     last = scream_olds; /* Only one occurence. */
 920                 }
 921             }
 922             else {
 923                 STRLEN len;
 924                 char *little = SvPV(prog->float_substr, len);
 925                 if (len)
 926                     last = rninstr(s, strend, little, little + len);
 927                 else
 928                     last = strend;      /* matching `$' */
 929             }
 930             if (last == NULL) goto phooey; /* Should not happen! */
 931             dontbother = strend - last + prog->float_min_offset;
 932         }
 933         if (minlen && (dontbother < minlen))
 934             dontbother = minlen - 1;
 935         strend -= dontbother;              /* this one's always in bytes! */
 936         /* We don't know much -- general case. */
 937         if (UTF) {
 938             for (;;) {
 939                 if (regtry(prog, s))
 940                     goto got_it;
 941                 if (s >= strend)
 942                     break;
 943                 s += UTF8SKIP(s);
 944             };
 945         }
 946         else {
 947             do {
 948                 if (regtry(prog, s))
 949                     goto got_it;
 950             } while (s++ < strend);
 951         }
 952     }
 953
 954     /* Failure. */
 955     goto phooey;
 956
 957 got_it:
 958     prog->subbeg = strbeg;
 959     prog->subend = PL_regeol;   /* strend may have been modified */
 960     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
 961
 962     /* make sure $`, $&, $', and $digit will work later */
 963     if (strbeg != prog->subbase) {      /* second+ //g match.  */
 964         if (!(flags & REXEC_COPY_STR)) {
 965             if (prog->subbase) {
 966                 Safefree(prog->subbase);
 967                 prog->subbase = Nullch;
 968             }
 969         }
 970         else {
 971             I32 i = PL_regeol - startpos + (stringarg - strbeg);
 972             s = savepvn(strbeg, i);
 973             Safefree(prog->subbase);
 974             prog->subbase = s;
 975             prog->subbeg = prog->subbase;
 976             prog->subend = prog->subbase + i;
 977             s = prog->subbase + (stringarg - strbeg);
 978             for (i = 0; i <= prog->nparens; i++) {
 979                 if (prog->endp[i]) {
 980                     prog->startp[i] = s + (prog->startp[i] - startpos);
 981                     prog->endp[i] = s + (prog->endp[i] - startpos);
 982                 }
 983             }
 984         }
 985     }
 986     /* Preserve the current value of $^R */
 987     if (oreplsv != GvSV(PL_replgv)) {
 988         sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
 989                                            restored, the value remains
 990                                            the same. */
 991     }
 992     return 1;
 993
 994 phooey:
 995     return 0;
 996 }
 997
 998 /*
 999  - regtry - try match at specific point
1000  */
1001 STATIC I32                      /* 0 failure, 1 success */
1002 regtry(regexp *prog, char *startpos)
1003 {
1004     dTHR;
1005     register I32 i;
1006     register char **sp;
1007     register char **ep;
1008     CHECKPOINT lastcp;
1009
1010     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1011         PL_reg_eval_set = RS_init;
1012         DEBUG_r(DEBUG_s(
1013             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
1014                           PL_stack_sp - PL_stack_base);
1015             ));
1016         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
1017         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1018         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1019         SAVETMPS;
1020         /* Apparently this is not needed, judging by wantarray. */
1021         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
1022            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1023     }
1024     PL_reginput = startpos;
1025     PL_regstartp = prog->startp;
1026     PL_regendp = prog->endp;
1027     PL_reglastparen = &prog->lastparen;
1028     prog->lastparen = 0;
1029     PL_regsize = 0;
1030     if (PL_reg_start_tmpl <= prog->nparens) {
1031         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1032         if(PL_reg_start_tmp)
1033             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1034         else
1035             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1036     }
1037
1038     sp = prog->startp;
1039     ep = prog->endp;
1040     if (prog->nparens) {
1041         for (i = prog->nparens; i >= 0; i--) {
1042             *sp++ = NULL;
1043             *ep++ = NULL;
1044         }
1045     }
1046     REGCP_SET;
1047     if (regmatch(prog->program + 1)) {
1048         prog->startp[0] = startpos;
1049         prog->endp[0] = PL_reginput;
1050         return 1;
1051     }
1052     REGCP_UNWIND;
1053     return 0;
1054 }
1055
1056 /*
1057  - regmatch - main matching routine
1058  *
1059  * Conceptually the strategy is simple:  check to see whether the current
1060  * node matches, call self recursively to see whether the rest matches,
1061  * and then act accordingly.  In practice we make some effort to avoid
1062  * recursion, in particular by going through "ordinary" nodes (that don't
1063  * need to know whether the rest of the match failed) by a loop instead of
1064  * by recursion.
1065  */
1066 /* [lwall] I've hoisted the register declarations to the outer block in order to
1067  * maybe save a little bit of pushing and popping on the stack.  It also takes
1068  * advantage of machines that use a register save mask on subroutine entry.
1069  */
1070 STATIC I32                      /* 0 failure, 1 success */
1071 regmatch(regnode *prog)
1072 {
1073     dTHR;
1074     register regnode *scan;     /* Current node. */
1075     regnode *next;              /* Next node. */
1076     regnode *inner;             /* Next node in internal branch. */
1077     register I32 nextchr;       /* renamed nextchr - nextchar colides with
1078                                    function of same name */
1079     register I32 n;             /* no or next */
1080     register I32 ln;            /* len or last */
1081     register char *s;           /* operand or save */
1082     register char *locinput = PL_reginput;
1083     register I32 c1, c2, paren; /* case fold search, parenth */
1084     int minmod = 0, sw = 0, logical = 0;
1085 #ifdef DEBUGGING
1086     PL_regindent++;
1087 #endif
1088
1089     /* Note that nextchr is a byte even in UTF */
1090     nextchr = UCHARAT(locinput);
1091     scan = prog;
1092     while (scan != NULL) {
1093 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
1094 #ifdef DEBUGGING
1095 #  define sayYES goto yes
1096 #  define sayNO goto no
1097 #  define saySAME(x) if (x) goto yes; else goto no
1098 #  define REPORT_CODE_OFF 24
1099 #else
1100 #  define sayYES return 1
1101 #  define sayNO return 0
1102 #  define saySAME(x) return x
1103 #endif
1104         DEBUG_r( {
1105             SV *prop = sv_newmortal();
1106             int docolor = *PL_colors[0];
1107             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
1108             int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
1109             int pref_len = (locinput - PL_bostr > (5 + taill) - l
1110                             ? (5 + taill) - l : locinput - PL_bostr);
1111             int pref0_len = pref_len  - (locinput - PL_reginput);
1112
1113             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
1114                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
1115                       ? (5 + taill) - pref_len : PL_regeol - locinput);
1116             if (pref0_len < 0)
1117                 pref0_len = 0;
1118             regprop(prop, scan);
1119             PerlIO_printf(Perl_debug_log,
1120                           "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
1121                           locinput - PL_bostr,
1122                           PL_colors[4], pref0_len,
1123                           locinput - pref_len, PL_colors[5],
1124                           PL_colors[2], pref_len - pref0_len,
1125                           locinput - pref_len + pref0_len, PL_colors[3],
1126                           (docolor ? "" : "> <"),
1127                           PL_colors[0], l, locinput, PL_colors[1],
1128                           15 - l - pref_len + 1,
1129                           "",
1130                           scan - PL_regprogram, PL_regindent*2, "",
1131                           SvPVX(prop));
1132         } );
1133
1134         next = scan + NEXT_OFF(scan);
1135         if (next == scan)
1136             next = NULL;
1137
1138         switch (OP(scan)) {
1139         case BOL:
1140             if (locinput == PL_bostr
1141                 ? PL_regprev == '\n'
1142                 : (PL_multiline &&
1143                    (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1144             {
1145                 /* regtill = regbol; */
1146                 break;
1147             }
1148             sayNO;
1149         case MBOL:
1150             if (locinput == PL_bostr
1151                 ? PL_regprev == '\n'
1152                 : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1153             {
1154                 break;
1155             }
1156             sayNO;
1157         case SBOL:
1158             if (locinput == PL_regbol && PL_regprev == '\n')
1159                 break;
1160             sayNO;
1161         case GPOS:
1162             if (locinput == PL_regbol)
1163                 break;
1164             sayNO;
1165         case EOL:
1166             if (PL_multiline)
1167                 goto meol;
1168             else
1169                 goto seol;
1170         case MEOL:
1171           meol:
1172             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1173                 sayNO;
1174             break;
1175         case SEOL:
1176           seol:
1177             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1178                 sayNO;
1179             if (PL_regeol - locinput > 1)
1180                 sayNO;
1181             break;
1182         case EOS:
1183             if (PL_regeol != locinput)
1184                 sayNO;
1185             break;
1186         case SANYUTF8:
1187             if (nextchr & 0x80) {
1188                 locinput += utf8skip[nextchr];
1189                 if (locinput > PL_regeol)
1190                     sayNO;
1191                 nextchr = UCHARAT(locinput);
1192                 break;
1193             }
1194             if (!nextchr && locinput >= PL_regeol)
1195                 sayNO;
1196             nextchr = UCHARAT(++locinput);
1197             break;
1198         case SANY:
1199             if (!nextchr && locinput >= PL_regeol)
1200                 sayNO;
1201             nextchr = UCHARAT(++locinput);
1202             break;
1203         case ANYUTF8:
1204             if (nextchr & 0x80) {
1205                 locinput += utf8skip[nextchr];
1206                 if (locinput > PL_regeol)
1207                     sayNO;
1208                 nextchr = UCHARAT(locinput);
1209                 break;
1210             }
1211             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1212                 sayNO;
1213             nextchr = UCHARAT(++locinput);
1214             break;
1215         case REG_ANY:
1216             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1217                 sayNO;
1218             nextchr = UCHARAT(++locinput);
1219             break;
1220         case EXACT:
1221             s = (char *) OPERAND(scan);
1222             ln = UCHARAT(s++);
1223             /* Inline the first character, for speed. */
1224             if (UCHARAT(s) != nextchr)
1225                 sayNO;
1226             if (PL_regeol - locinput < ln)
1227                 sayNO;
1228             if (ln > 1 && memNE(s, locinput, ln))
1229                 sayNO;
1230             locinput += ln;
1231             nextchr = UCHARAT(locinput);
1232             break;
1233         case EXACTFL:
1234             PL_reg_flags |= RF_tainted;
1235             /* FALL THROUGH */
1236         case EXACTF:
1237             s = (char *) OPERAND(scan);
1238             ln = UCHARAT(s++);
1239
1240             if (UTF) {
1241                 char *l = locinput;
1242                 char *e = s + ln;
1243                 c1 = OP(scan) == EXACTF;
1244                 while (s < e) {
1245                     if (l >= PL_regeol)
1246                         sayNO;
1247                     if (utf8_to_uv((U8*)s, 0) != (c1 ?
1248                                                   toLOWER_utf8((U8*)l) :
1249                                                   toLOWER_LC_utf8((U8*)l)))
1250                     {
1251                         sayNO;
1252                     }
1253                     s += UTF8SKIP(s);
1254                     l += UTF8SKIP(l);
1255                 }
1256                 locinput = l;
1257                 nextchr = UCHARAT(locinput);
1258                 break;
1259             }
1260
1261             /* Inline the first character, for speed. */
1262             if (UCHARAT(s) != nextchr &&
1263                 UCHARAT(s) != ((OP(scan) == EXACTF)
1264                                ? PL_fold : PL_fold_locale)[nextchr])
1265                 sayNO;
1266             if (PL_regeol - locinput < ln)
1267                 sayNO;
1268             if (ln > 1 && (OP(scan) == EXACTF
1269                            ? ibcmp(s, locinput, ln)
1270                            : ibcmp_locale(s, locinput, ln)))
1271                 sayNO;
1272             locinput += ln;
1273             nextchr = UCHARAT(locinput);
1274             break;
1275         case ANYOFUTF8:
1276             s = (char *) OPERAND(scan);
1277             if (!REGINCLASSUTF8(scan, (U8*)locinput))
1278                 sayNO;
1279             if (locinput >= PL_regeol)
1280                 sayNO;
1281             locinput += utf8skip[nextchr];
1282             nextchr = UCHARAT(locinput);
1283             break;
1284         case ANYOF:
1285             s = (char *) OPERAND(scan);
1286             if (nextchr < 0)
1287                 nextchr = UCHARAT(locinput);
1288             if (!REGINCLASS(s, nextchr))
1289                 sayNO;
1290             if (!nextchr && locinput >= PL_regeol)
1291                 sayNO;
1292             nextchr = UCHARAT(++locinput);
1293             break;
1294         case ALNUML:
1295             PL_reg_flags |= RF_tainted;
1296             /* FALL THROUGH */
1297         case ALNUM:
1298             if (!nextchr)
1299                 sayNO;
1300             if (!(OP(scan) == ALNUM
1301                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1302                 sayNO;
1303             nextchr = UCHARAT(++locinput);
1304             break;
1305         case ALNUMLUTF8:
1306             PL_reg_flags |= RF_tainted;
1307             /* FALL THROUGH */
1308         case ALNUMUTF8:
1309             if (!nextchr)
1310                 sayNO;
1311             if (nextchr & 0x80) {
1312                 if (!(OP(scan) == ALNUMUTF8
1313                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1314                       : isALNUM_LC_utf8((U8*)locinput)))
1315                 {
1316                     sayNO;
1317                 }
1318                 locinput += utf8skip[nextchr];
1319                 nextchr = UCHARAT(locinput);
1320                 break;
1321             }
1322             if (!(OP(scan) == ALNUMUTF8
1323                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1324                 sayNO;
1325             nextchr = UCHARAT(++locinput);
1326             break;
1327         case NALNUML:
1328             PL_reg_flags |= RF_tainted;
1329             /* FALL THROUGH */
1330         case NALNUM:
1331             if (!nextchr && locinput >= PL_regeol)
1332                 sayNO;
1333             if (OP(scan) == NALNUM
1334                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1335                 sayNO;
1336             nextchr = UCHARAT(++locinput);
1337             break;
1338         case NALNUMLUTF8:
1339             PL_reg_flags |= RF_tainted;
1340             /* FALL THROUGH */
1341         case NALNUMUTF8:
1342             if (!nextchr && locinput >= PL_regeol)
1343                 sayNO;
1344             if (nextchr & 0x80) {
1345                 if (OP(scan) == NALNUMUTF8
1346                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1347                     : isALNUM_LC_utf8((U8*)locinput))
1348                 {
1349                     sayNO;
1350                 }
1351                 locinput += utf8skip[nextchr];
1352                 nextchr = UCHARAT(locinput);
1353                 break;
1354             }
1355             if (OP(scan) == NALNUMUTF8
1356                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1357                 sayNO;
1358             nextchr = UCHARAT(++locinput);
1359             break;
1360         case BOUNDL:
1361         case NBOUNDL:
1362             PL_reg_flags |= RF_tainted;
1363             /* FALL THROUGH */
1364         case BOUND:
1365         case NBOUND:
1366             /* was last char in word? */
1367             ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
1368             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
1369                 ln = isALNUM(ln);
1370                 n = isALNUM(nextchr);
1371             }
1372             else {
1373                 ln = isALNUM_LC(ln);
1374                 n = isALNUM_LC(nextchr);
1375             }
1376             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
1377                 sayNO;
1378             break;
1379         case BOUNDLUTF8:
1380         case NBOUNDLUTF8:
1381             PL_reg_flags |= RF_tainted;
1382             /* FALL THROUGH */
1383         case BOUNDUTF8:
1384         case NBOUNDUTF8:
1385             /* was last char in word? */
1386             ln = (locinput != PL_regbol)
1387                 ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
1388             if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
1389                 ln = isALNUM_uni(ln);
1390                 n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
1391             }
1392             else {
1393                 ln = isALNUM_LC_uni(ln);
1394                 n = isALNUM_LC_utf8((U8*)locinput);
1395             }
1396             if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
1397                 sayNO;
1398             break;
1399         case SPACEL:
1400             PL_reg_flags |= RF_tainted;
1401             /* FALL THROUGH */
1402         case SPACE:
1403             if (!nextchr && locinput >= PL_regeol)
1404                 sayNO;
1405             if (!(OP(scan) == SPACE
1406                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1407                 sayNO;
1408             nextchr = UCHARAT(++locinput);
1409             break;
1410         case SPACELUTF8:
1411             PL_reg_flags |= RF_tainted;
1412             /* FALL THROUGH */
1413         case SPACEUTF8:
1414             if (!nextchr && locinput >= PL_regeol)
1415                 sayNO;
1416             if (nextchr & 0x80) {
1417                 if (!(OP(scan) == SPACEUTF8
1418                       ? swash_fetch(PL_utf8_space,(U8*)locinput)
1419                       : isSPACE_LC_utf8((U8*)locinput)))
1420                 {
1421                     sayNO;
1422                 }
1423                 locinput += utf8skip[nextchr];
1424                 nextchr = UCHARAT(locinput);
1425                 break;
1426             }
1427             if (!(OP(scan) == SPACEUTF8
1428                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1429                 sayNO;
1430             nextchr = UCHARAT(++locinput);
1431             break;
1432         case NSPACEL:
1433             PL_reg_flags |= RF_tainted;
1434             /* FALL THROUGH */
1435         case NSPACE:
1436             if (!nextchr)
1437                 sayNO;
1438             if (OP(scan) == SPACE
1439                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1440                 sayNO;
1441             nextchr = UCHARAT(++locinput);
1442             break;
1443         case NSPACELUTF8:
1444             PL_reg_flags |= RF_tainted;
1445             /* FALL THROUGH */
1446         case NSPACEUTF8:
1447             if (!nextchr)
1448                 sayNO;
1449             if (nextchr & 0x80) {
1450                 if (OP(scan) == NSPACEUTF8
1451                     ? swash_fetch(PL_utf8_space,(U8*)locinput)
1452                     : isSPACE_LC_utf8((U8*)locinput))
1453                 {
1454                     sayNO;
1455                 }
1456                 locinput += utf8skip[nextchr];
1457                 nextchr = UCHARAT(locinput);
1458                 break;
1459             }
1460             if (OP(scan) == NSPACEUTF8
1461                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1462                 sayNO;
1463             nextchr = UCHARAT(++locinput);
1464             break;
1465         case DIGIT:
1466             if (!isDIGIT(nextchr))
1467                 sayNO;
1468             nextchr = UCHARAT(++locinput);
1469             break;
1470         case DIGITUTF8:
1471             if (nextchr & 0x80) {
1472                 if (!(swash_fetch(PL_utf8_digit,(U8*)locinput)))
1473                     sayNO;
1474                 locinput += utf8skip[nextchr];
1475                 nextchr = UCHARAT(locinput);
1476                 break;
1477             }
1478             if (!isDIGIT(nextchr))
1479                 sayNO;
1480             nextchr = UCHARAT(++locinput);
1481             break;
1482         case NDIGIT:
1483             if (!nextchr && locinput >= PL_regeol)
1484                 sayNO;
1485             if (isDIGIT(nextchr))
1486                 sayNO;
1487             nextchr = UCHARAT(++locinput);
1488             break;
1489         case NDIGITUTF8:
1490             if (!nextchr && locinput >= PL_regeol)
1491                 sayNO;
1492             if (nextchr & 0x80) {
1493                 if (swash_fetch(PL_utf8_digit,(U8*)locinput))
1494                     sayNO;
1495                 locinput += utf8skip[nextchr];
1496                 nextchr = UCHARAT(locinput);
1497                 break;
1498             }
1499             if (isDIGIT(nextchr))
1500                 sayNO;
1501             nextchr = UCHARAT(++locinput);
1502             break;
1503         case CLUMP:
1504             if (locinput >= PL_regeol || swash_fetch(PL_utf8_mark,(U8*)locinput))
1505                 sayNO;
1506             locinput += utf8skip[nextchr];
1507             while (locinput < PL_regeol && swash_fetch(PL_utf8_mark,(U8*)locinput))
1508                 locinput += UTF8SKIP(locinput);
1509             if (locinput > PL_regeol)
1510                 sayNO;
1511             nextchr = UCHARAT(locinput);
1512             break;
1513         case REFFL:
1514             PL_reg_flags |= RF_tainted;
1515             /* FALL THROUGH */
1516         case REF:
1517         case REFF:
1518             n = ARG(scan);  /* which paren pair */
1519             s = PL_regstartp[n];
1520             if (*PL_reglastparen < n || !s)
1521                 sayNO;                  /* Do not match unless seen CLOSEn. */
1522             if (s == PL_regendp[n])
1523                 break;
1524
1525             if (UTF && OP(scan) != REF) {       /* REF can do byte comparison */
1526                 char *l = locinput;
1527                 char *e = PL_regendp[n];
1528                 /*
1529                  * Note that we can't do the "other character" lookup trick as
1530                  * in the 8-bit case (no pun intended) because in Unicode we
1531                  * have to map both upper and title case to lower case.
1532                  */
1533                 if (OP(scan) == REFF) {
1534                     while (s < e) {
1535                         if (l >= PL_regeol)
1536                             sayNO;
1537                         if (toLOWER_utf8((U8*)s) != toLOWER_utf8((U8*)l))
1538                             sayNO;
1539                         s += UTF8SKIP(s);
1540                         l += UTF8SKIP(l);
1541                     }
1542                 }
1543                 else {
1544                     while (s < e) {
1545                         if (l >= PL_regeol)
1546                             sayNO;
1547                         if (toLOWER_LC_utf8((U8*)s) != toLOWER_LC_utf8((U8*)l))
1548                             sayNO;
1549                         s += UTF8SKIP(s);
1550                         l += UTF8SKIP(l);
1551                     }
1552                 }
1553                 locinput = l;
1554                 nextchr = UCHARAT(locinput);
1555                 break;
1556             }
1557
1558             /* Inline the first character, for speed. */
1559             if (UCHARAT(s) != nextchr &&
1560                 (OP(scan) == REF ||
1561                  (UCHARAT(s) != ((OP(scan) == REFF
1562                                   ? PL_fold : PL_fold_locale)[nextchr]))))
1563                 sayNO;
1564             ln = PL_regendp[n] - s;
1565             if (locinput + ln > PL_regeol)
1566                 sayNO;
1567             if (ln > 1 && (OP(scan) == REF
1568                            ? memNE(s, locinput, ln)
1569                            : (OP(scan) == REFF
1570                               ? ibcmp(s, locinput, ln)
1571                               : ibcmp_locale(s, locinput, ln))))
1572                 sayNO;
1573             locinput += ln;
1574             nextchr = UCHARAT(locinput);
1575             break;
1576
1577         case NOTHING:
1578         case TAIL:
1579             break;
1580         case BACK:
1581             break;
1582         case EVAL:
1583         {
1584             dSP;
1585             OP_4tree *oop = PL_op;
1586             COP *ocurcop = PL_curcop;
1587             SV **ocurpad = PL_curpad;
1588             SV *ret;
1589
1590             n = ARG(scan);
1591             PL_op = (OP_4tree*)PL_regdata->data[n];
1592             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", PL_op) );
1593             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]);
1594
1595             CALLRUNOPS();                       /* Scalar context. */
1596             SPAGAIN;
1597             ret = POPs;
1598             PUTBACK;
1599
1600             PL_op = oop;
1601             PL_curpad = ocurpad;
1602             PL_curcop = ocurcop;
1603             if (logical) {
1604                 if (logical == 2) {     /* Postponed subexpression. */
1605                     regexp *re;
1606                     MAGIC *mg = Null(MAGIC*);
1607                     re_cc_state state;
1608                     CURCUR cctmp;
1609                     CHECKPOINT cp, lastcp;
1610
1611                     if(SvROK(ret) || SvRMAGICAL(ret)) {
1612                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
1613
1614                         if(SvMAGICAL(sv))
1615                             mg = mg_find(sv, 'r');
1616                     }
1617                     if (mg) {
1618                         re = (regexp *)mg->mg_obj;
1619                         (void)ReREFCNT_inc(re);
1620                     }
1621                     else {
1622                         STRLEN len;
1623                         char *t = SvPV(ret, len);
1624                         PMOP pm;
1625                         char *oprecomp = PL_regprecomp;
1626                         I32 osize = PL_regsize;
1627                         I32 onpar = PL_regnpar;
1628
1629                         pm.op_pmflags = 0;
1630                         re = CALLREGCOMP(t, t + len, &pm);
1631                         if (!(SvFLAGS(ret)
1632                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
1633                             sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0);
1634                         PL_regprecomp = oprecomp;
1635                         PL_regsize = osize;
1636                         PL_regnpar = onpar;
1637                     }
1638                     DEBUG_r(
1639                         PerlIO_printf(Perl_debug_log,
1640                                       "Entering embedded `%s%.60s%s%s'\n",
1641                                       PL_colors[0],
1642                                       re->precomp,
1643                                       PL_colors[1],
1644                                       (strlen(re->precomp) > 60 ? "..." : ""))
1645                         );
1646                     state.node = next;
1647                     state.prev = PL_reg_call_cc;
1648                     state.cc = PL_regcc;
1649                     state.re = PL_reg_re;
1650
1651                     cctmp.cur = 0;
1652                     cctmp.oldcc = 0;
1653                     PL_regcc = &cctmp;
1654
1655                     cp = regcppush(0);  /* Save *all* the positions. */
1656                     REGCP_SET;
1657                     cache_re(re);
1658                     state.ss = PL_savestack_ix;
1659                     *PL_reglastparen = 0;
1660                     PL_reg_call_cc = &state;
1661                     PL_reginput = locinput;
1662                     if (regmatch(re->program + 1)) {
1663                         ReREFCNT_dec(re);
1664                         regcpblow(cp);
1665                         sayYES;
1666                     }
1667                     DEBUG_r(
1668                         PerlIO_printf(Perl_debug_log,
1669                                       "%*s  failed...\n",
1670                                       REPORT_CODE_OFF+PL_regindent*2, "")
1671                         );
1672                     ReREFCNT_dec(re);
1673                     REGCP_UNWIND;
1674                     regcppop();
1675                     PL_reg_call_cc = state.prev;
1676                     PL_regcc = state.cc;
1677                     PL_reg_re = state.re;
1678                     cache_re(PL_reg_re);
1679                     sayNO;
1680                 }
1681                 sw = SvTRUE(ret);
1682                 logical = 0;
1683             }
1684             else
1685                 sv_setsv(save_scalar(PL_replgv), ret);
1686             break;
1687         }
1688         case OPEN:
1689             n = ARG(scan);  /* which paren pair */
1690             PL_reg_start_tmp[n] = locinput;
1691             if (n > PL_regsize)
1692                 PL_regsize = n;
1693             break;
1694         case CLOSE:
1695             n = ARG(scan);  /* which paren pair */
1696             PL_regstartp[n] = PL_reg_start_tmp[n];
1697             PL_regendp[n] = locinput;
1698             if (n > *PL_reglastparen)
1699                 *PL_reglastparen = n;
1700             break;
1701         case GROUPP:
1702             n = ARG(scan);  /* which paren pair */
1703             sw = (*PL_reglastparen >= n && PL_regendp[n] != NULL);
1704             break;
1705         case IFTHEN:
1706             if (sw)
1707                 next = NEXTOPER(NEXTOPER(scan));
1708             else {
1709                 next = scan + ARG(scan);
1710                 if (OP(next) == IFTHEN) /* Fake one. */
1711                     next = NEXTOPER(NEXTOPER(next));
1712             }
1713             break;
1714         case LOGICAL:
1715             logical = scan->flags;
1716             break;
1717         case CURLYX: {
1718                 CURCUR cc;
1719                 CHECKPOINT cp = PL_savestack_ix;
1720
1721                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1722                     next += ARG(next);
1723                 cc.oldcc = PL_regcc;
1724                 PL_regcc = &cc;
1725                 cc.parenfloor = *PL_reglastparen;
1726                 cc.cur = -1;
1727                 cc.min = ARG1(scan);
1728                 cc.max  = ARG2(scan);
1729                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
1730                 cc.next = next;
1731                 cc.minmod = minmod;
1732                 cc.lastloc = 0;
1733                 PL_reginput = locinput;
1734                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
1735                 regcpblow(cp);
1736                 PL_regcc = cc.oldcc;
1737                 saySAME(n);
1738             }
1739             /* NOT REACHED */
1740         case WHILEM: {
1741                 /*
1742                  * This is really hard to understand, because after we match
1743                  * what we're trying to match, we must make sure the rest of
1744                  * the RE is going to match for sure, and to do that we have
1745                  * to go back UP the parse tree by recursing ever deeper.  And
1746                  * if it fails, we have to reset our parent's current state
1747                  * that we can try again after backing off.
1748                  */
1749
1750                 CHECKPOINT cp, lastcp;
1751                 CURCUR* cc = PL_regcc;
1752                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1753
1754                 n = cc->cur + 1;        /* how many we know we matched */
1755                 PL_reginput = locinput;
1756
1757                 DEBUG_r(
1758                     PerlIO_printf(Perl_debug_log,
1759                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
1760                                   REPORT_CODE_OFF+PL_regindent*2, "",
1761                                   (long)n, (long)cc->min,
1762                                   (long)cc->max, (long)cc)
1763                     );
1764
1765                 /* If degenerate scan matches "", assume scan done. */
1766
1767                 if (locinput == cc->lastloc && n >= cc->min) {
1768                     PL_regcc = cc->oldcc;
1769                     ln = PL_regcc->cur;
1770                     DEBUG_r(
1771                         PerlIO_printf(Perl_debug_log,
1772                            "%*s  empty match detected, try continuation...\n",
1773                            REPORT_CODE_OFF+PL_regindent*2, "")
1774                         );
1775                     if (regmatch(cc->next))
1776                         sayYES;
1777                     DEBUG_r(
1778                         PerlIO_printf(Perl_debug_log,
1779                                       "%*s  failed...\n",
1780                                       REPORT_CODE_OFF+PL_regindent*2, "")
1781                         );
1782                     PL_regcc->cur = ln;
1783                     PL_regcc = cc;
1784                     sayNO;
1785                 }
1786
1787                 /* First just match a string of min scans. */
1788
1789                 if (n < cc->min) {
1790                     cc->cur = n;
1791                     cc->lastloc = locinput;
1792                     if (regmatch(cc->scan))
1793                         sayYES;
1794                     cc->cur = n - 1;
1795                     cc->lastloc = lastloc;
1796                     DEBUG_r(
1797                         PerlIO_printf(Perl_debug_log,
1798                                       "%*s  failed...\n",
1799                                       REPORT_CODE_OFF+PL_regindent*2, "")
1800                         );
1801                     sayNO;
1802                 }
1803
1804                 /* Prefer next over scan for minimal matching. */
1805
1806                 if (cc->minmod) {
1807                     PL_regcc = cc->oldcc;
1808                     ln = PL_regcc->cur;
1809                     cp = regcppush(cc->parenfloor);
1810                     REGCP_SET;
1811                     if (regmatch(cc->next)) {
1812                         regcpblow(cp);
1813                         sayYES; /* All done. */
1814                     }
1815                     REGCP_UNWIND;
1816                     regcppop();
1817                     PL_regcc->cur = ln;
1818                     PL_regcc = cc;
1819
1820                     if (n >= cc->max) { /* Maximum greed exceeded? */
1821                         if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
1822                             && !(PL_reg_flags & RF_warned)) {
1823                             PL_reg_flags |= RF_warned;
1824                             warner(WARN_UNSAFE, "%s limit (%d) exceeded",
1825                                  "Complex regular subexpression recursion",
1826                                  REG_INFTY - 1);
1827                         }
1828                         sayNO;
1829                     }
1830
1831                     DEBUG_r(
1832                         PerlIO_printf(Perl_debug_log,
1833                                       "%*s  trying longer...\n",
1834                                       REPORT_CODE_OFF+PL_regindent*2, "")
1835                         );
1836                     /* Try scanning more and see if it helps. */
1837                     PL_reginput = locinput;
1838                     cc->cur = n;
1839                     cc->lastloc = locinput;
1840                     cp = regcppush(cc->parenfloor);
1841                     REGCP_SET;
1842                     if (regmatch(cc->scan)) {
1843                         regcpblow(cp);
1844                         sayYES;
1845                     }
1846                     DEBUG_r(
1847                         PerlIO_printf(Perl_debug_log,
1848                                       "%*s  failed...\n",
1849                                       REPORT_CODE_OFF+PL_regindent*2, "")
1850                         );
1851                     REGCP_UNWIND;
1852                     regcppop();
1853                     cc->cur = n - 1;
1854                     cc->lastloc = lastloc;
1855                     sayNO;
1856                 }
1857
1858                 /* Prefer scan over next for maximal matching. */
1859
1860                 if (n < cc->max) {      /* More greed allowed? */
1861                     cp = regcppush(cc->parenfloor);
1862                     cc->cur = n;
1863                     cc->lastloc = locinput;
1864                     REGCP_SET;
1865                     if (regmatch(cc->scan)) {
1866                         regcpblow(cp);
1867                         sayYES;
1868                     }
1869                     REGCP_UNWIND;
1870                     regcppop();         /* Restore some previous $<digit>s? */
1871                     PL_reginput = locinput;
1872                     DEBUG_r(
1873                         PerlIO_printf(Perl_debug_log,
1874                                       "%*s  failed, try continuation...\n",
1875                                       REPORT_CODE_OFF+PL_regindent*2, "")
1876                         );
1877                 }
1878                 if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
1879                         && !(PL_reg_flags & RF_warned)) {
1880                     PL_reg_flags |= RF_warned;
1881                     warner(WARN_UNSAFE, "%s limit (%d) exceeded",
1882                          "Complex regular subexpression recursion",
1883                          REG_INFTY - 1);
1884                 }
1885
1886                 /* Failed deeper matches of scan, so see if this one works. */
1887                 PL_regcc = cc->oldcc;
1888                 ln = PL_regcc->cur;
1889                 if (regmatch(cc->next))
1890                     sayYES;
1891                 DEBUG_r(
1892                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
1893                                   REPORT_CODE_OFF+PL_regindent*2, "")
1894                     );
1895                 PL_regcc->cur = ln;
1896                 PL_regcc = cc;
1897                 cc->cur = n - 1;
1898                 cc->lastloc = lastloc;
1899                 sayNO;
1900             }
1901             /* NOT REACHED */
1902         case BRANCHJ:
1903             next = scan + ARG(scan);
1904             if (next == scan)
1905                 next = NULL;
1906             inner = NEXTOPER(NEXTOPER(scan));
1907             goto do_branch;
1908         case BRANCH:
1909             inner = NEXTOPER(scan);
1910           do_branch:
1911             {
1912                 CHECKPOINT lastcp;
1913                 c1 = OP(scan);
1914                 if (OP(next) != c1)     /* No choice. */
1915                     next = inner;       /* Avoid recursion. */
1916                 else {
1917                     int lastparen = *PL_reglastparen;
1918
1919                     REGCP_SET;
1920                     do {
1921                         PL_reginput = locinput;
1922                         if (regmatch(inner))
1923                             sayYES;
1924                         REGCP_UNWIND;
1925                         for (n = *PL_reglastparen; n > lastparen; n--)
1926                             PL_regendp[n] = 0;
1927                         *PL_reglastparen = n;
1928                         scan = next;
1929                         /*SUPPRESS 560*/
1930                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1931                             next += n;
1932                         else
1933                             next = NULL;
1934                         inner = NEXTOPER(scan);
1935                         if (c1 == BRANCHJ) {
1936                             inner = NEXTOPER(inner);
1937                         }
1938                     } while (scan != NULL && OP(scan) == c1);
1939                     sayNO;
1940                     /* NOTREACHED */
1941                 }
1942             }
1943             break;
1944         case MINMOD:
1945             minmod = 1;
1946             break;
1947         case CURLYM:
1948         {
1949             I32 l = 0;
1950             CHECKPOINT lastcp;
1951
1952             /* We suppose that the next guy does not need
1953                backtracking: in particular, it is of constant length,
1954                and has no parenths to influence future backrefs. */
1955             ln = ARG1(scan);  /* min to match */
1956             n  = ARG2(scan);  /* max to match */
1957             paren = scan->flags;
1958             if (paren) {
1959                 if (paren > PL_regsize)
1960                     PL_regsize = paren;
1961                 if (paren > *PL_reglastparen)
1962                     *PL_reglastparen = paren;
1963             }
1964             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1965             if (paren)
1966                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
1967             PL_reginput = locinput;
1968             if (minmod) {
1969                 minmod = 0;
1970                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1971                     sayNO;
1972                 if (ln && l == 0 && n >= ln
1973                     /* In fact, this is tricky.  If paren, then the
1974                        fact that we did/didnot match may influence
1975                        future execution. */
1976                     && !(paren && ln == 0))
1977                     ln = n;
1978                 locinput = PL_reginput;
1979                 if (PL_regkind[(U8)OP(next)] == EXACT) {
1980                     c1 = UCHARAT(OPERAND(next) + 1);
1981                     if (OP(next) == EXACTF)
1982                         c2 = PL_fold[c1];
1983                     else if (OP(next) == EXACTFL)
1984                         c2 = PL_fold_locale[c1];
1985                     else
1986                         c2 = c1;
1987                 }
1988                 else
1989                     c1 = c2 = -1000;
1990                 REGCP_SET;
1991                 /* This may be improved if l == 0.  */
1992                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1993                     /* If it could work, try it. */
1994                     if (c1 == -1000 ||
1995                         UCHARAT(PL_reginput) == c1 ||
1996                         UCHARAT(PL_reginput) == c2)
1997                     {
1998                         if (paren) {
1999                             if (n) {
2000                                 PL_regstartp[paren] = HOPc(PL_reginput, -l);
2001                                 PL_regendp[paren] = PL_reginput;
2002                             }
2003                             else
2004                                 PL_regendp[paren] = NULL;
2005                         }
2006                         if (regmatch(next))
2007                             sayYES;
2008                         REGCP_UNWIND;
2009                     }
2010                     /* Couldn't or didn't -- move forward. */
2011                     PL_reginput = locinput;
2012                     if (regrepeat_hard(scan, 1, &l)) {
2013                         ln++;
2014                         locinput = PL_reginput;
2015                     }
2016                     else
2017                         sayNO;
2018                 }
2019             }
2020             else {
2021                 n = regrepeat_hard(scan, n, &l);
2022                 if (n != 0 && l == 0
2023                     /* In fact, this is tricky.  If paren, then the
2024                        fact that we did/didnot match may influence
2025                        future execution. */
2026                     && !(paren && ln == 0))
2027                     ln = n;
2028                 locinput = PL_reginput;
2029                 DEBUG_r(
2030                     PerlIO_printf(Perl_debug_log,
2031                                   "%*s  matched %ld times, len=%ld...\n",
2032                                   REPORT_CODE_OFF+PL_regindent*2, "", n, l)
2033                     );
2034                 if (n >= ln) {
2035                     if (PL_regkind[(U8)OP(next)] == EXACT) {
2036                         c1 = UCHARAT(OPERAND(next) + 1);
2037                         if (OP(next) == EXACTF)
2038                             c2 = PL_fold[c1];
2039                         else if (OP(next) == EXACTFL)
2040                             c2 = PL_fold_locale[c1];
2041                         else
2042                             c2 = c1;
2043                     }
2044                     else
2045                         c1 = c2 = -1000;
2046                 }
2047                 REGCP_SET;
2048                 while (n >= ln) {
2049                     /* If it could work, try it. */
2050                     if (c1 == -1000 ||
2051                         UCHARAT(PL_reginput) == c1 ||
2052                         UCHARAT(PL_reginput) == c2)
2053                     {
2054                         DEBUG_r(
2055                                 PerlIO_printf(Perl_debug_log,
2056                                               "%*s  trying tail with n=%ld...\n",
2057                                               REPORT_CODE_OFF+PL_regindent*2, "", n)
2058                             );
2059                         if (paren) {
2060                             if (n) {
2061                                 PL_regstartp[paren] = HOPc(PL_reginput, -l);
2062                                 PL_regendp[paren] = PL_reginput;
2063                             }
2064                             else
2065                                 PL_regendp[paren] = NULL;
2066                         }
2067                         if (regmatch(next))
2068                             sayYES;
2069                         REGCP_UNWIND;
2070                     }
2071                     /* Couldn't or didn't -- back up. */
2072                     n--;
2073                     locinput = HOPc(locinput, -l);
2074                     PL_reginput = locinput;
2075                 }
2076             }
2077             sayNO;
2078             break;
2079         }
2080         case CURLYN:
2081             paren = scan->flags;        /* Which paren to set */
2082             if (paren > PL_regsize)
2083                 PL_regsize = paren;
2084             if (paren > *PL_reglastparen)
2085                 *PL_reglastparen = paren;
2086             ln = ARG1(scan);  /* min to match */
2087             n  = ARG2(scan);  /* max to match */
2088             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
2089             goto repeat;
2090         case CURLY:
2091             paren = 0;
2092             ln = ARG1(scan);  /* min to match */
2093             n  = ARG2(scan);  /* max to match */
2094             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
2095             goto repeat;
2096         case STAR:
2097             ln = 0;
2098             n = REG_INFTY;
2099             scan = NEXTOPER(scan);
2100             paren = 0;
2101             goto repeat;
2102         case PLUS:
2103             ln = 1;
2104             n = REG_INFTY;
2105             scan = NEXTOPER(scan);
2106             paren = 0;
2107           repeat:
2108             /*
2109             * Lookahead to avoid useless match attempts
2110             * when we know what character comes next.
2111             */
2112             if (PL_regkind[(U8)OP(next)] == EXACT) {
2113                 c1 = UCHARAT(OPERAND(next) + 1);
2114                 if (OP(next) == EXACTF)
2115                     c2 = PL_fold[c1];
2116                 else if (OP(next) == EXACTFL)
2117                     c2 = PL_fold_locale[c1];
2118                 else
2119                     c2 = c1;
2120             }
2121             else
2122                 c1 = c2 = -1000;
2123             PL_reginput = locinput;
2124             if (minmod) {
2125                 CHECKPOINT lastcp;
2126                 minmod = 0;
2127                 if (ln && regrepeat(scan, ln) < ln)
2128                     sayNO;
2129                 locinput = PL_reginput;
2130                 REGCP_SET;
2131                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
2132                     /* If it could work, try it. */
2133                     if (c1 == -1000 ||
2134                         UCHARAT(PL_reginput) == c1 ||
2135                         UCHARAT(PL_reginput) == c2)
2136                     {
2137                         if (paren) {
2138                             if (n) {
2139                                 PL_regstartp[paren] = HOPc(PL_reginput, -1);
2140                                 PL_regendp[paren] = PL_reginput;
2141                             }
2142                             else
2143                                 PL_regendp[paren] = NULL;
2144                         }
2145                         if (regmatch(next))
2146                             sayYES;
2147                         REGCP_UNWIND;
2148                     }
2149                     /* Couldn't or didn't -- move forward. */
2150                     PL_reginput = locinput;
2151                     if (regrepeat(scan, 1)) {
2152                         ln++;
2153                         locinput = PL_reginput;
2154                     }
2155                     else
2156                         sayNO;
2157                 }
2158             }
2159             else {
2160                 CHECKPOINT lastcp;
2161                 n = regrepeat(scan, n);
2162                 locinput = PL_reginput;
2163                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
2164                     (!PL_multiline  || OP(next) == SEOL))
2165                     ln = n;                     /* why back off? */
2166                 REGCP_SET;
2167                 if (paren) {
2168                     while (n >= ln) {
2169                         /* If it could work, try it. */
2170                         if (c1 == -1000 ||
2171                             UCHARAT(PL_reginput) == c1 ||
2172                             UCHARAT(PL_reginput) == c2)
2173                             {
2174                                 if (paren && n) {
2175                                     if (n) {
2176                                         PL_regstartp[paren] = HOPc(PL_reginput, -1);
2177                                         PL_regendp[paren] = PL_reginput;
2178                                     }
2179                                     else
2180                                         PL_regendp[paren] = NULL;
2181                                 }
2182                                 if (regmatch(next))
2183                                     sayYES;
2184                                 REGCP_UNWIND;
2185                             }
2186                         /* Couldn't or didn't -- back up. */
2187                         n--;
2188                         PL_reginput = locinput = HOPc(locinput, -1);
2189                     }
2190                 }
2191                 else {
2192                     while (n >= ln) {
2193                         /* If it could work, try it. */
2194                         if (c1 == -1000 ||
2195                             UCHARAT(PL_reginput) == c1 ||
2196                             UCHARAT(PL_reginput) == c2)
2197                             {
2198                                 if (regmatch(next))
2199                                     sayYES;
2200                                 REGCP_UNWIND;
2201                             }
2202                         /* Couldn't or didn't -- back up. */
2203                         n--;
2204                         PL_reginput = locinput = HOPc(locinput, -1);
2205                     }
2206                 }
2207             }
2208             sayNO;
2209             break;
2210         case END:
2211             if (PL_reg_call_cc) {
2212                 re_cc_state *cur_call_cc = PL_reg_call_cc;
2213                 CURCUR *cctmp = PL_regcc;
2214                 regexp *re = PL_reg_re;
2215                 CHECKPOINT cp, lastcp;
2216
2217                 cp = regcppush(0);      /* Save *all* the positions. */
2218                 REGCP_SET;
2219                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
2220                                                     the caller. */
2221                 PL_reginput = locinput; /* Make position available to
2222                                            the callcc. */
2223                 cache_re(PL_reg_call_cc->re);
2224                 PL_regcc = PL_reg_call_cc->cc;
2225                 PL_reg_call_cc = PL_reg_call_cc->prev;
2226                 if (regmatch(cur_call_cc->node)) {
2227                     PL_reg_call_cc = cur_call_cc;
2228                     regcpblow(cp);
2229                     sayYES;
2230                 }
2231                 REGCP_UNWIND;
2232                 regcppop();
2233                 PL_reg_call_cc = cur_call_cc;
2234                 PL_regcc = cctmp;
2235                 PL_reg_re = re;
2236                 cache_re(re);
2237
2238                 DEBUG_r(
2239                     PerlIO_printf(Perl_debug_log,
2240                                   "%*s  continuation failed...\n",
2241                                   REPORT_CODE_OFF+PL_regindent*2, "")
2242                     );
2243                 sayNO;
2244             }
2245             if (locinput < PL_regtill)
2246                 sayNO;                  /* Cannot match: too short. */
2247             /* Fall through */
2248         case SUCCEED:
2249             PL_reginput = locinput;     /* put where regtry can find it */
2250             sayYES;                     /* Success! */
2251         case SUSPEND:
2252             n = 1;
2253             PL_reginput = locinput;
2254             goto do_ifmatch;
2255         case UNLESSM:
2256             n = 0;
2257             if (scan->flags) {
2258                 s = HOPMAYBEc(locinput, -scan->flags);
2259                 if (!s)
2260                     goto say_yes;
2261                 PL_reginput = s;
2262             }
2263             else
2264                 PL_reginput = locinput;
2265             goto do_ifmatch;
2266         case IFMATCH:
2267             n = 1;
2268             if (scan->flags) {
2269                 s = HOPMAYBEc(locinput, -scan->flags);
2270                 if (!s)
2271                     goto say_no;
2272                 PL_reginput = s;
2273             }
2274             else
2275                 PL_reginput = locinput;
2276
2277           do_ifmatch:
2278             inner = NEXTOPER(NEXTOPER(scan));
2279             if (regmatch(inner) != n) {
2280               say_no:
2281                 if (logical) {
2282                     logical = 0;
2283                     sw = 0;
2284                     goto do_longjump;
2285                 }
2286                 else
2287                     sayNO;
2288             }
2289           say_yes:
2290             if (logical) {
2291                 logical = 0;
2292                 sw = 1;
2293             }
2294             if (OP(scan) == SUSPEND) {
2295                 locinput = PL_reginput;
2296                 nextchr = UCHARAT(locinput);
2297             }
2298             /* FALL THROUGH. */
2299         case LONGJMP:
2300           do_longjump:
2301             next = scan + ARG(scan);
2302             if (next == scan)
2303                 next = NULL;
2304             break;
2305         default:
2306             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
2307                           (unsigned long)scan, OP(scan));
2308             FAIL("regexp memory corruption");
2309         }
2310         scan = next;
2311     }
2312
2313     /*
2314     * We get here only if there's trouble -- normally "case END" is
2315     * the terminating point.
2316     */
2317     FAIL("corrupted regexp pointers");
2318     /*NOTREACHED*/
2319     sayNO;
2320
2321 yes:
2322 #ifdef DEBUGGING
2323     PL_regindent--;
2324 #endif
2325     return 1;
2326
2327 no:
2328 #ifdef DEBUGGING
2329     PL_regindent--;
2330 #endif
2331     return 0;
2332 }
2333
2334 /*
2335  - regrepeat - repeatedly match something simple, report how many
2336  */
2337 /*
2338  * [This routine now assumes that it will only match on things of length 1.
2339  * That was true before, but now we assume scan - reginput is the count,
2340  * rather than incrementing count on every character.  [Er, except utf8.]]
2341  */
2342 STATIC I32
2343 regrepeat(regnode *p, I32 max)
2344 {
2345     dTHR;
2346     register char *scan;
2347     register char *opnd;
2348     register I32 c;
2349     register char *loceol = PL_regeol;
2350     register I32 hardcount = 0;
2351
2352     scan = PL_reginput;
2353     if (max != REG_INFTY && max < loceol - scan)
2354       loceol = scan + max;
2355     opnd = (char *) OPERAND(p);
2356     switch (OP(p)) {
2357     case REG_ANY:
2358         while (scan < loceol && *scan != '\n')
2359             scan++;
2360         break;
2361     case SANY:
2362         scan = loceol;
2363         break;
2364     case ANYUTF8:
2365         loceol = PL_regeol;
2366         while (scan < loceol && *scan != '\n') {
2367             scan += UTF8SKIP(scan);
2368             hardcount++;
2369         }
2370         break;
2371     case SANYUTF8:
2372         loceol = PL_regeol;
2373         while (scan < loceol) {
2374             scan += UTF8SKIP(scan);
2375             hardcount++;
2376         }
2377         break;
2378     case EXACT:         /* length of string is 1 */
2379         c = UCHARAT(++opnd);
2380         while (scan < loceol && UCHARAT(scan) == c)
2381             scan++;
2382         break;
2383     case EXACTF:        /* length of string is 1 */
2384         c = UCHARAT(++opnd);
2385         while (scan < loceol &&
2386                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
2387             scan++;
2388         break;
2389     case EXACTFL:       /* length of string is 1 */
2390         PL_reg_flags |= RF_tainted;
2391         c = UCHARAT(++opnd);
2392         while (scan < loceol &&
2393                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
2394             scan++;
2395         break;
2396     case ANYOFUTF8:
2397         loceol = PL_regeol;
2398         while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
2399             scan += UTF8SKIP(scan);
2400             hardcount++;
2401         }
2402         break;
2403     case ANYOF:
2404         while (scan < loceol && REGINCLASS(opnd, *scan))
2405             scan++;
2406         break;
2407     case ALNUM:
2408         while (scan < loceol && isALNUM(*scan))
2409             scan++;
2410         break;
2411     case ALNUMUTF8:
2412         loceol = PL_regeol;
2413         while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
2414             scan += UTF8SKIP(scan);
2415             hardcount++;
2416         }
2417         break;
2418     case ALNUML:
2419         PL_reg_flags |= RF_tainted;
2420         while (scan < loceol && isALNUM_LC(*scan))
2421             scan++;
2422         break;
2423     case ALNUMLUTF8:
2424         PL_reg_flags |= RF_tainted;
2425         loceol = PL_regeol;
2426         while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
2427             scan += UTF8SKIP(scan);
2428             hardcount++;
2429         }
2430         break;
2431         break;
2432     case NALNUM:
2433         while (scan < loceol && !isALNUM(*scan))
2434             scan++;
2435         break;
2436     case NALNUMUTF8:
2437         loceol = PL_regeol;
2438         while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
2439             scan += UTF8SKIP(scan);
2440             hardcount++;
2441         }
2442         break;
2443     case NALNUML:
2444         PL_reg_flags |= RF_tainted;
2445         while (scan < loceol && !isALNUM_LC(*scan))
2446             scan++;
2447         break;
2448     case NALNUMLUTF8:
2449         PL_reg_flags |= RF_tainted;
2450         loceol = PL_regeol;
2451         while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
2452             scan += UTF8SKIP(scan);
2453             hardcount++;
2454         }
2455         break;
2456     case SPACE:
2457         while (scan < loceol && isSPACE(*scan))
2458             scan++;
2459         break;
2460     case SPACEUTF8:
2461         loceol = PL_regeol;
2462         while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
2463             scan += UTF8SKIP(scan);
2464             hardcount++;
2465         }
2466         break;
2467     case SPACEL:
2468         PL_reg_flags |= RF_tainted;
2469         while (scan < loceol && isSPACE_LC(*scan))
2470             scan++;
2471         break;
2472     case SPACELUTF8:
2473         PL_reg_flags |= RF_tainted;
2474         loceol = PL_regeol;
2475         while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
2476             scan += UTF8SKIP(scan);
2477             hardcount++;
2478         }
2479         break;
2480     case NSPACE:
2481         while (scan < loceol && !isSPACE(*scan))
2482             scan++;
2483         break;
2484     case NSPACEUTF8:
2485         loceol = PL_regeol;
2486         while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
2487             scan += UTF8SKIP(scan);
2488             hardcount++;
2489         }
2490         break;
2491     case NSPACEL:
2492         PL_reg_flags |= RF_tainted;
2493         while (scan < loceol && !isSPACE_LC(*scan))
2494             scan++;
2495         break;
2496     case NSPACELUTF8:
2497         PL_reg_flags |= RF_tainted;
2498         loceol = PL_regeol;
2499         while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
2500             scan += UTF8SKIP(scan);
2501             hardcount++;
2502         }
2503         break;
2504     case DIGIT:
2505         while (scan < loceol && isDIGIT(*scan))
2506             scan++;
2507         break;
2508     case DIGITUTF8:
2509         loceol = PL_regeol;
2510         while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
2511             scan += UTF8SKIP(scan);
2512             hardcount++;
2513         }
2514         break;
2515         break;
2516     case NDIGIT:
2517         while (scan < loceol && !isDIGIT(*scan))
2518             scan++;
2519         break;
2520     case NDIGITUTF8:
2521         loceol = PL_regeol;
2522         while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
2523             scan += UTF8SKIP(scan);
2524             hardcount++;
2525         }
2526         break;
2527     default:            /* Called on something of 0 width. */
2528         break;          /* So match right here or not at all. */
2529     }
2530
2531     if (hardcount)
2532         c = hardcount;
2533     else
2534         c = scan - PL_reginput;
2535     PL_reginput = scan;
2536
2537     DEBUG_r(
2538         {
2539                 SV *prop = sv_newmortal();
2540
2541                 regprop(prop, p);
2542                 PerlIO_printf(Perl_debug_log,
2543                               "%*s  %s can match %ld times out of %ld...\n",
2544                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
2545         });
2546
2547     return(c);
2548 }
2549
2550 /*
2551  - regrepeat_hard - repeatedly match something, report total lenth and length
2552  *
2553  * The repeater is supposed to have constant length.
2554  */
2555
2556 STATIC I32
2557 regrepeat_hard(regnode *p, I32 max, I32 *lp)
2558 {
2559     dTHR;
2560     register char *scan;
2561     register char *start;
2562     register char *loceol = PL_regeol;
2563     I32 l = 0;
2564     I32 count = 0, res = 1;
2565
2566     if (!max)
2567         return 0;
2568
2569     start = PL_reginput;
2570     if (UTF) {
2571         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
2572             if (!count++) {
2573                 l = 0;
2574                 while (start < PL_reginput) {
2575                     l++;
2576                     start += UTF8SKIP(start);
2577                 }
2578                 *lp = l;
2579                 if (l == 0)
2580                     return max;
2581             }
2582             if (count == max)
2583                 return count;
2584         }
2585     }
2586     else {
2587         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
2588             if (!count++) {
2589                 *lp = l = PL_reginput - start;
2590                 if (max != REG_INFTY && l*max < loceol - scan)
2591                     loceol = scan + l*max;
2592                 if (l == 0)
2593                     return max;
2594             }
2595         }
2596     }
2597     if (!res)
2598         PL_reginput = scan;
2599
2600     return count;
2601 }
2602
2603 /*
2604  - regclass - determine if a character falls into a character class
2605  */
2606
2607 STATIC bool
2608 reginclass(register char *p, register I32 c)
2609 {
2610     dTHR;
2611     char flags = *p;
2612     bool match = FALSE;
2613
2614     c &= 0xFF;
2615     if (ANYOF_TEST(p, c))
2616         match = TRUE;
2617     else if (flags & ANYOF_FOLD) {
2618         I32 cf;
2619         if (flags & ANYOF_LOCALE) {
2620             PL_reg_flags |= RF_tainted;
2621             cf = PL_fold_locale[c];
2622         }
2623         else
2624             cf = PL_fold[c];
2625         if (ANYOF_TEST(p, cf))
2626             match = TRUE;
2627     }
2628
2629     if (!match && (flags & ANYOF_ISA)) {
2630         PL_reg_flags |= RF_tainted;
2631
2632         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
2633             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
2634             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
2635             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
2636         {
2637             match = TRUE;
2638         }
2639     }
2640
2641     return (flags & ANYOF_INVERT) ? !match : match;
2642 }
2643
2644 STATIC bool
2645 reginclassutf8(regnode *f, U8 *p)
2646 {
2647     dTHR;
2648     char flags = ARG1(f);
2649     bool match = FALSE;
2650     SV *sv = (SV*)PL_regdata->data[ARG2(f)];
2651
2652     if (swash_fetch(sv, p))
2653         match = TRUE;
2654     else if (flags & ANYOF_FOLD) {
2655         I32 cf;
2656         U8 tmpbuf[10];
2657         if (flags & ANYOF_LOCALE) {
2658             PL_reg_flags |= RF_tainted;
2659             uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
2660         }
2661         else
2662             uv_to_utf8(tmpbuf, toLOWER_utf8(p));
2663         if (swash_fetch(sv, tmpbuf))
2664             match = TRUE;
2665     }
2666
2667     if (!match && (flags & ANYOF_ISA)) {
2668         PL_reg_flags |= RF_tainted;
2669
2670         if (((flags & ANYOF_ALNUML)  && isALNUM_LC_utf8(p))  ||
2671             ((flags & ANYOF_NALNUML) && !isALNUM_LC_utf8(p)) ||
2672             ((flags & ANYOF_SPACEL)  && isSPACE_LC_utf8(p))  ||
2673             ((flags & ANYOF_NSPACEL) && !isSPACE_LC_utf8(p)))
2674         {
2675             match = TRUE;
2676         }
2677     }
2678
2679     return (flags & ANYOF_INVERT) ? !match : match;
2680 }
2681
2682 STATIC U8 *
2683 reghop(U8 *s, I32 off)
2684 {
2685     dTHR;
2686     if (off >= 0) {
2687         while (off-- && s < (U8*)PL_regeol)
2688             s += UTF8SKIP(s);
2689     }
2690     else {
2691         while (off++) {
2692             if (s > (U8*)PL_bostr) {
2693                 s--;
2694                 if (*s & 0x80) {
2695                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2696                         s--;
2697                 }               /* XXX could check well-formedness here */
2698             }
2699         }
2700     }
2701     return s;
2702 }
2703
2704 STATIC U8 *
2705 reghopmaybe(U8* s, I32 off)
2706 {
2707     dTHR;
2708     if (off >= 0) {
2709         while (off-- && s < (U8*)PL_regeol)
2710             s += UTF8SKIP(s);
2711         if (off >= 0)
2712             return 0;
2713     }
2714     else {
2715         while (off++) {
2716             if (s > (U8*)PL_bostr) {
2717                 s--;
2718                 if (*s & 0x80) {
2719                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2720                         s--;
2721                 }               /* XXX could check well-formedness here */
2722             }
2723             else
2724                 break;
2725         }
2726         if (off <= 0)
2727             return 0;
2728     }
2729     return s;
2730 }