regcomp.c

   1 /*    regcomp.c
   2  */
   3
   4 /*
   5  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
   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_pregcomp my_regcomp
  36 #  define Perl_regdump my_regdump
  37 #  define Perl_regprop my_regprop
  38 /* *These* symbols are masked to allow static link. */
  39 #  define Perl_pregfree my_regfree
  40 #  define Perl_regnext my_regnext
  41 #endif
  42
  43 /*SUPPRESS 112*/
  44 /*
  45  * pregcomp and pregexec -- regsub and regerror are not used in perl
  46  *
  47  *      Copyright (c) 1986 by University of Toronto.
  48  *      Written by Henry Spencer.  Not derived from licensed software.
  49  *
  50  *      Permission is granted to anyone to use this software for any
  51  *      purpose on any computer system, and to redistribute it freely,
  52  *      subject to the following restrictions:
  53  *
  54  *      1. The author is not responsible for the consequences of use of
  55  *              this software, no matter how awful, even if they arise
  56  *              from defects in it.
  57  *
  58  *      2. The origin of this software must not be misrepresented, either
  59  *              by explicit claim or by omission.
  60  *
  61  *      3. Altered versions must be plainly marked as such, and must not
  62  *              be misrepresented as being the original software.
  63  *
  64  *
  65  ****    Alterations to Henry's code are...
  66  ****
  67  ****    Copyright (c) 1991-1998, Larry Wall
  68  ****
  69  ****    You may distribute under the terms of either the GNU General Public
  70  ****    License or the Artistic License, as specified in the README file.
  71
  72  *
  73  * Beware that some of this code is subtly aware of the way operator
  74  * precedence is structured in regular expressions.  Serious changes in
  75  * regular-expression syntax might require a total rethink.
  76  */
  77 #include "EXTERN.h"
  78 #include "perl.h"
  79
  80 #ifndef PERL_IN_XSUB_RE
  81 #  include "INTERN.h"
  82 #endif
  83
  84 #define REG_COMP_C
  85 #include "regcomp.h"
  86
  87 #ifdef op
  88 #undef op
  89 #endif /* op */
  90
  91 #ifdef MSDOS
  92 # if defined(BUGGY_MSC6)
  93  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
  94  # pragma optimize("a",off)
  95  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
  96  # pragma optimize("w",on )
  97 # endif /* BUGGY_MSC6 */
  98 #endif /* MSDOS */
  99
 100 #ifndef STATIC
 101 #define STATIC  static
 102 #endif
 103
 104 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
 105 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
 106         ((*s) == '{' && regcurly(s)))
 107 #ifdef atarist
 108 #define PERL_META       "^$.[()|?+*\\"
 109 #else
 110 #define META    "^$.[()|?+*\\"
 111 #endif
 112
 113 #ifdef SPSTART
 114 #undef SPSTART          /* dratted cpp namespace... */
 115 #endif
 116 /*
 117  * Flags to be passed up and down.
 118  */
 119 #define WORST           0       /* Worst case. */
 120 #define HASWIDTH        0x1     /* Known to match non-null strings. */
 121 #define SIMPLE          0x2     /* Simple enough to be STAR/PLUS operand. */
 122 #define SPSTART         0x4     /* Starts with * or +. */
 123 #define TRYAGAIN        0x8     /* Weeded out a declaration. */
 124
 125 /*
 126  * Forward declarations for pregcomp()'s friends.
 127  */
 128
 129 #ifndef PERL_OBJECT
 130 static regnode *reg _((I32, I32 *));
 131 static regnode *reganode _((U8, U32));
 132 static regnode *regatom _((I32 *));
 133 static regnode *regbranch _((I32 *, I32));
 134 static void regc _((U8, char *));
 135 static void reguni _((UV, char *, I32*));
 136 static regnode *regclass _((void));
 137 static regnode *regclassutf8 _((void));
 138 STATIC I32 regcurly _((char *));
 139 static regnode *reg_node _((U8));
 140 static regnode *regpiece _((I32 *));
 141 static void reginsert _((U8, regnode *));
 142 static void regoptail _((regnode *, regnode *));
 143 static void regtail _((regnode *, regnode *));
 144 static char* regwhite _((char *, char *));
 145 static char* nextchar _((void));
 146 static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
 147 #endif
 148
 149 /* Length of a variant. */
 150
 151 #ifndef PERL_OBJECT
 152 typedef struct {
 153     I32 len_min;
 154     I32 len_delta;
 155     I32 pos_min;                        /* CC */
 156     I32 pos_delta;                      /* CC */
 157     SV *last_found;
 158     I32 last_end;                       /* min value, <0 unless valid. */
 159     I32 last_start_min;                 /* CC */
 160     I32 last_start_max;                 /* CC */
 161     SV **longest;                       /* Either &l_fixed, or &l_float. */
 162     SV *longest_fixed;
 163     I32 offset_fixed;                   /* CC */
 164     SV *longest_float;
 165     I32 offset_float_min;               /* CC */
 166     I32 offset_float_max;               /* CC */
 167     I32 flags;
 168 } scan_data_t;
 169 #endif
 170
 171 static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
 172
 173 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
 174 #define SF_BEFORE_SEOL          0x1
 175 #define SF_BEFORE_MEOL          0x2
 176 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
 177 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
 178
 179 #ifdef NO_UNARY_PLUS
 180 #  define SF_FIX_SHIFT_EOL      (0+2)
 181 #  define SF_FL_SHIFT_EOL               (0+4)
 182 #else
 183 #  define SF_FIX_SHIFT_EOL      (+2)
 184 #  define SF_FL_SHIFT_EOL               (+4)
 185 #endif
 186
 187 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
 188 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
 189
 190 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
 191 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
 192 #define SF_IS_INF               0x40
 193 #define SF_HAS_PAR              0x80
 194 #define SF_IN_PAR               0x100
 195 #define SF_HAS_EVAL             0x200
 196 #define SCF_DO_SUBSTR           0x400
 197
 198 #define RF_utf8         8
 199 #define UTF (PL_reg_flags & RF_utf8)
 200 #define LOC (PL_regflags & PMf_LOCALE)
 201 #define FOLD (PL_regflags & PMf_FOLD)
 202
 203 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 204 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 205
 206 STATIC void
 207 scan_commit(scan_data_t *data)
 208 {
 209     STRLEN l = CHR_SVLEN(data->last_found);
 210     STRLEN old_l = CHR_SVLEN(*data->longest);
 211
 212     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
 213         sv_setsv(*data->longest, data->last_found);
 214         if (*data->longest == data->longest_fixed) {
 215             data->offset_fixed = l ? data->last_start_min : data->pos_min;
 216             if (data->flags & SF_BEFORE_EOL)
 217                 data->flags
 218                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
 219             else
 220                 data->flags &= ~SF_FIX_BEFORE_EOL;
 221         }
 222         else {
 223             data->offset_float_min = l ? data->last_start_min : data->pos_min;
 224             data->offset_float_max = (l
 225                                       ? data->last_start_max
 226                                       : data->pos_min + data->pos_delta);
 227             if (data->flags & SF_BEFORE_EOL)
 228                 data->flags
 229                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
 230             else
 231                 data->flags &= ~SF_FL_BEFORE_EOL;
 232         }
 233     }
 234     SvCUR_set(data->last_found, 0);
 235     data->last_end = -1;
 236     data->flags &= ~SF_BEFORE_EOL;
 237 }
 238
 239 /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
 240    to the position after last scanned or to NULL. */
 241
 242 STATIC I32
 243 study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
 244                         /* scanp: Start here (read-write). */
 245                         /* deltap: Write maxlen-minlen here. */
 246                         /* last: Stop before this one. */
 247 {
 248     dTHR;
 249     I32 min = 0, pars = 0, code;
 250     regnode *scan = *scanp, *next;
 251     I32 delta = 0;
 252     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
 253     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
 254     scan_data_t data_fake;
 255
 256     while (scan && OP(scan) != END && scan < last) {
 257         /* Peephole optimizer: */
 258
 259         if (regkind[(U8)OP(scan)] == EXACT) {
 260             regnode *n = regnext(scan);
 261             U32 stringok = 1;
 262 #ifdef DEBUGGING
 263             regnode *stop = scan;
 264 #endif
 265
 266             next = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
 267             /* Skip NOTHING, merge EXACT*. */
 268             while (n &&
 269                    ( regkind[(U8)OP(n)] == NOTHING ||
 270                      (stringok && (OP(n) == OP(scan))))
 271                    && NEXT_OFF(n)
 272                    && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
 273                 if (OP(n) == TAIL || n > next)
 274                     stringok = 0;
 275                 if (regkind[(U8)OP(n)] == NOTHING) {
 276                     NEXT_OFF(scan) += NEXT_OFF(n);
 277                     next = n + NODE_STEP_REGNODE;
 278 #ifdef DEBUGGING
 279                     if (stringok)
 280                         stop = n;
 281 #endif
 282                     n = regnext(n);
 283                 }
 284                 else {
 285                     int oldl = *OPERAND(scan);
 286                     regnode *nnext = regnext(n);
 287
 288                     if (oldl + *OPERAND(n) > U8_MAX)
 289                         break;
 290                     NEXT_OFF(scan) += NEXT_OFF(n);
 291                     *OPERAND(scan) += *OPERAND(n);
 292                     next = n + (*OPERAND(n) + 2 - 1)/sizeof(regnode) + 2;
 293                     /* Now we can overwrite *n : */
 294                     Move(OPERAND(n) + 1, OPERAND(scan) + oldl + 1,
 295                          *OPERAND(n) + 1, char);
 296 #ifdef DEBUGGING
 297                     if (stringok)
 298                         stop = next - 1;
 299 #endif
 300                     n = nnext;
 301                 }
 302             }
 303 #ifdef DEBUGGING
 304             /* Allow dumping */
 305             n = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
 306             while (n <= stop) {
 307                 /* Purify reports a benign UMR here sometimes, because we
 308                  * don't initialize the OP() slot of a node when that node
 309                  * is occupied by just the trailing null of the string in
 310                  * an EXACT node */
 311                 if (regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
 312                     OP(n) = OPTIMIZED;
 313                     NEXT_OFF(n) = 0;
 314                 }
 315                 n++;
 316             }
 317 #endif
 318
 319         }
 320         if (OP(scan) != CURLYX) {
 321             int max = (reg_off_by_arg[OP(scan)] ? I32_MAX : U16_MAX);
 322             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
 323             int noff;
 324             regnode *n = scan;
 325
 326             /* Skip NOTHING and LONGJMP. */
 327             while ((n = regnext(n))
 328                    && ((regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
 329                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
 330                    && off + noff < max)
 331                 off += noff;
 332             if (reg_off_by_arg[OP(scan)])
 333                 ARG(scan) = off;
 334             else
 335                 NEXT_OFF(scan) = off;
 336         }
 337         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
 338                    || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
 339             next = regnext(scan);
 340             code = OP(scan);
 341
 342             if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
 343                 I32 max1 = 0, min1 = I32_MAX, num = 0;
 344
 345                 if (flags & SCF_DO_SUBSTR)
 346                     scan_commit(data);
 347                 while (OP(scan) == code) {
 348                     I32 deltanext, minnext;
 349
 350                     num++;
 351                     data_fake.flags = 0;
 352                     next = regnext(scan);
 353                     scan = NEXTOPER(scan);
 354                     if (code != BRANCH)
 355                         scan = NEXTOPER(scan);
 356                     /* We suppose the run is continuous, last=next...*/
 357                     minnext = study_chunk(&scan, &deltanext, next,
 358                                           &data_fake, 0);
 359                     if (min1 > minnext)
 360                         min1 = minnext;
 361                     if (max1 < minnext + deltanext)
 362                         max1 = minnext + deltanext;
 363                     if (deltanext == I32_MAX)
 364                         is_inf = 1;
 365                     scan = next;
 366                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
 367                         pars++;
 368                     if (data && (data_fake.flags & SF_HAS_EVAL))
 369                         data->flags |= SF_HAS_EVAL;
 370                     if (code == SUSPEND)
 371                         break;
 372                 }
 373                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
 374                     min1 = 0;
 375                 if (flags & SCF_DO_SUBSTR) {
 376                     data->pos_min += min1;
 377                     data->pos_delta += max1 - min1;
 378                     if (max1 != min1 || is_inf)
 379                         data->longest = &(data->longest_float);
 380                 }
 381                 min += min1;
 382                 delta += max1 - min1;
 383             }
 384             else if (code == BRANCHJ)   /* single branch is optimized. */
 385                 scan = NEXTOPER(NEXTOPER(scan));
 386             else                        /* single branch is optimized. */
 387                 scan = NEXTOPER(scan);
 388             continue;
 389         }
 390         else if (OP(scan) == EXACT) {
 391             I32 l = *OPERAND(scan);
 392             if (UTF) {
 393                 unsigned char *s = (unsigned char *)(OPERAND(scan)+1);
 394                 unsigned char *e = s + l;
 395                 I32 newl = 0;
 396                 while (s < e) {
 397                     newl++;
 398                     s += UTF8SKIP(s);
 399                 }
 400                 l = newl;
 401             }
 402             min += l;
 403             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
 404                 /* The code below prefers earlier match for fixed
 405                    offset, later match for variable offset.  */
 406                 if (data->last_end == -1) { /* Update the start info. */
 407                     data->last_start_min = data->pos_min;
 408                     data->last_start_max = is_inf
 409                         ? I32_MAX : data->pos_min + data->pos_delta;
 410                 }
 411                 sv_catpvn(data->last_found, (char *)(OPERAND(scan)+1), *OPERAND(scan));
 412                 data->last_end = data->pos_min + l;
 413                 data->pos_min += l; /* As in the first entry. */
 414                 data->flags &= ~SF_BEFORE_EOL;
 415             }
 416         }
 417         else if (regkind[(U8)OP(scan)] == EXACT) {
 418             I32 l = *OPERAND(scan);
 419             if (flags & SCF_DO_SUBSTR)
 420                 scan_commit(data);
 421             if (UTF) {
 422                 unsigned char *s = (unsigned char *)(OPERAND(scan)+1);
 423                 unsigned char *e = s + l;
 424                 I32 newl = 0;
 425                 while (s < e) {
 426                     newl++;
 427                     s += UTF8SKIP(s);
 428                 }
 429                 l = newl;
 430             }
 431             min += l;
 432             if (data && (flags & SCF_DO_SUBSTR))
 433                 data->pos_min += l;
 434         }
 435         else if (strchr(varies,OP(scan))) {
 436             I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
 437             regnode *oscan = scan;
 438
 439             switch (regkind[(U8)OP(scan)]) {
 440             case WHILEM:
 441                 scan = NEXTOPER(scan);
 442                 goto finish;
 443             case PLUS:
 444                 if (flags & SCF_DO_SUBSTR) {
 445                     next = NEXTOPER(scan);
 446                     if (OP(next) == EXACT) {
 447                         mincount = 1;
 448                         maxcount = REG_INFTY;
 449                         next = regnext(scan);
 450                         scan = NEXTOPER(scan);
 451                         goto do_curly;
 452                     }
 453                 }
 454                 if (flags & SCF_DO_SUBSTR)
 455                     data->pos_min++;
 456                 min++;
 457                 /* Fall through. */
 458             case STAR:
 459                 is_inf = 1;
 460                 scan = regnext(scan);
 461                 if (flags & SCF_DO_SUBSTR) {
 462                     scan_commit(data);
 463                     data->longest = &(data->longest_float);
 464                 }
 465                 goto optimize_curly_tail;
 466             case CURLY:
 467                 mincount = ARG1(scan);
 468                 maxcount = ARG2(scan);
 469                 next = regnext(scan);
 470                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
 471               do_curly:
 472                 if (flags & SCF_DO_SUBSTR) {
 473                     if (mincount == 0) scan_commit(data);
 474                     pos_before = data->pos_min;
 475                 }
 476                 if (data) {
 477                     fl = data->flags;
 478                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
 479                     if (is_inf)
 480                         data->flags |= SF_IS_INF;
 481                 }
 482                 /* This will finish on WHILEM, setting scan, or on NULL: */
 483                 minnext = study_chunk(&scan, &deltanext, last, data,
 484                                       mincount == 0
 485                                         ? (flags & ~SCF_DO_SUBSTR) : flags);
 486                 if (!scan)              /* It was not CURLYX, but CURLY. */
 487                     scan = next;
 488                 if (PL_dowarn && (minnext + deltanext == 0)
 489                     && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
 490                     && maxcount <= 10000) /* Complement check for big count */
 491                     warn("Strange *+?{} on zero-length expression");
 492                 min += minnext * mincount;
 493                 is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
 494                            || deltanext == I32_MAX);
 495                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
 496
 497                 /* Try powerful optimization CURLYX => CURLYN. */
 498                 if (  OP(oscan) == CURLYX && data
 499                       && data->flags & SF_IN_PAR
 500                       && !(data->flags & SF_HAS_EVAL)
 501                       && !deltanext && minnext == 1 ) {
 502                     /* Try to optimize to CURLYN.  */
 503                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
 504                     regnode *nxt1 = nxt, *nxt2;
 505
 506                     /* Skip open. */
 507                     nxt = regnext(nxt);
 508                     if (!strchr(simple,OP(nxt))
 509                         && !(regkind[(U8)OP(nxt)] == EXACT
 510                              && *OPERAND(nxt) == 1))
 511                         goto nogo;
 512                     nxt2 = nxt;
 513                     nxt = regnext(nxt);
 514                     if (OP(nxt) != CLOSE)
 515                         goto nogo;
 516                     /* Now we know that nxt2 is the only contents: */
 517                     oscan->flags = ARG(nxt);
 518                     OP(oscan) = CURLYN;
 519                     OP(nxt1) = NOTHING; /* was OPEN. */
 520 #ifdef DEBUGGING
 521                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
 522                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
 523                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
 524                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
 525                     OP(nxt + 1) = OPTIMIZED; /* was count. */
 526                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
 527 #endif
 528                 }
 529               nogo:
 530
 531                 /* Try optimization CURLYX => CURLYM. */
 532                 if (  OP(oscan) == CURLYX && data
 533                       && !(data->flags & SF_HAS_PAR)
 534                       && !(data->flags & SF_HAS_EVAL)
 535                       && !deltanext  ) {
 536                     /* XXXX How to optimize if data == 0? */
 537                     /* Optimize to a simpler form.  */
 538                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
 539                     regnode *nxt2;
 540
 541                     OP(oscan) = CURLYM;
 542                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
 543                             && (OP(nxt2) != WHILEM))
 544                         nxt = nxt2;
 545                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
 546                     /* Need to optimize away parenths. */
 547                     if (data->flags & SF_IN_PAR) {
 548                         /* Set the parenth number.  */
 549                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
 550
 551                         if (OP(nxt) != CLOSE)
 552                             FAIL("panic opt close");
 553                         oscan->flags = ARG(nxt);
 554                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
 555                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
 556 #ifdef DEBUGGING
 557                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
 558                         OP(nxt + 1) = OPTIMIZED; /* was count. */
 559                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
 560                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
 561 #endif
 562 #if 0
 563                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
 564                             regnode *nnxt = regnext(nxt1);
 565
 566                             if (nnxt == nxt) {
 567                                 if (reg_off_by_arg[OP(nxt1)])
 568                                     ARG_SET(nxt1, nxt2 - nxt1);
 569                                 else if (nxt2 - nxt1 < U16_MAX)
 570                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
 571                                 else
 572                                     OP(nxt) = NOTHING;  /* Cannot beautify */
 573                             }
 574                             nxt1 = nnxt;
 575                         }
 576 #endif
 577                         /* Optimize again: */
 578                         study_chunk(&nxt1, &deltanext, nxt, NULL, 0);
 579                     }
 580                     else
 581                         oscan->flags = 0;
 582                 }
 583                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
 584                     pars++;
 585                 if (flags & SCF_DO_SUBSTR) {
 586                     SV *last_str = Nullsv;
 587                     int counted = mincount != 0;
 588
 589                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
 590                         I32 b = pos_before >= data->last_start_min
 591                             ? pos_before : data->last_start_min;
 592                         STRLEN l;
 593                         char *s = SvPV(data->last_found, l);
 594                         I32 old = b - data->last_start_min;
 595
 596                         if (UTF)
 597                             old = utf8_hop((U8*)s, old) - (U8*)s;
 598
 599                         l -= old;
 600                         /* Get the added string: */
 601                         last_str = newSVpv(s  + old, l);
 602                         if (deltanext == 0 && pos_before == b) {
 603                             /* What was added is a constant string */
 604                             if (mincount > 1) {
 605                                 SvGROW(last_str, (mincount * l) + 1);
 606                                 repeatcpy(SvPVX(last_str) + l,
 607                                           SvPVX(last_str), l, mincount - 1);
 608                                 SvCUR(last_str) *= mincount;
 609                                 /* Add additional parts. */
 610                                 SvCUR_set(data->last_found,
 611                                           SvCUR(data->last_found) - l);
 612                                 sv_catsv(data->last_found, last_str);
 613                                 data->last_end += l * (mincount - 1);
 614                             }
 615                         }
 616                     }
 617                     /* It is counted once already... */
 618                     data->pos_min += minnext * (mincount - counted);
 619                     data->pos_delta += - counted * deltanext +
 620                         (minnext + deltanext) * maxcount - minnext * mincount;
 621                     if (mincount != maxcount) {
 622                         scan_commit(data);
 623                         if (mincount && last_str) {
 624                             sv_setsv(data->last_found, last_str);
 625                             data->last_end = data->pos_min;
 626                             data->last_start_min =
 627                                 data->pos_min - CHR_SVLEN(last_str);
 628                             data->last_start_max = is_inf
 629                                 ? I32_MAX
 630                                 : data->pos_min + data->pos_delta
 631                                 - CHR_SVLEN(last_str);
 632                         }
 633                         data->longest = &(data->longest_float);
 634                     }
 635                 }
 636                 if (data && (fl & SF_HAS_EVAL))
 637                     data->flags |= SF_HAS_EVAL;
 638               optimize_curly_tail:
 639                 if (OP(oscan) != CURLYX) {
 640                     while (regkind[(U8)OP(next = regnext(oscan))] == NOTHING
 641                            && NEXT_OFF(next))
 642                         NEXT_OFF(oscan) += NEXT_OFF(next);
 643                 }
 644                 continue;
 645             default:                    /* REF only? */
 646                 if (flags & SCF_DO_SUBSTR) {
 647                     scan_commit(data);
 648                     data->longest = &(data->longest_float);
 649                 }
 650                 is_inf = 1;
 651                 break;
 652             }
 653         }
 654         else if (strchr(simple,OP(scan)) || regkind[(U8)OP(scan)] == ANYUTF8) {
 655             if (flags & SCF_DO_SUBSTR) {
 656                 scan_commit(data);
 657                 data->pos_min++;
 658             }
 659             min++;
 660         }
 661         else if (regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
 662             data->flags |= (OP(scan) == MEOL
 663                             ? SF_BEFORE_MEOL
 664                             : SF_BEFORE_SEOL);
 665         }
 666         else if (regkind[(U8)OP(scan)] == BRANCHJ
 667                    && (scan->flags || data)
 668                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
 669             I32 deltanext, minnext;
 670             regnode *nscan;
 671
 672             data_fake.flags = 0;
 673             next = regnext(scan);
 674             nscan = NEXTOPER(NEXTOPER(scan));
 675             minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0);
 676             if (scan->flags) {
 677                 if (deltanext) {
 678                     FAIL("variable length lookbehind not implemented");
 679                 }
 680                 else if (minnext > U8_MAX) {
 681                     FAIL2("lookbehind longer than %d not implemented", U8_MAX);
 682                 }
 683                 scan->flags = minnext;
 684             }
 685             if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
 686                 pars++;
 687             if (data && (data_fake.flags & SF_HAS_EVAL))
 688                 data->flags |= SF_HAS_EVAL;
 689         }
 690         else if (OP(scan) == OPEN) {
 691             pars++;
 692         }
 693         else if (OP(scan) == CLOSE && ARG(scan) == is_par) {
 694             next = regnext(scan);
 695
 696             if ( next && (OP(next) != WHILEM) && next < last)
 697                 is_par = 0;             /* Disable optimization */
 698         }
 699         else if (OP(scan) == EVAL) {
 700                 if (data)
 701                     data->flags |= SF_HAS_EVAL;
 702         }
 703         /* Else: zero-length, ignore. */
 704         scan = regnext(scan);
 705     }
 706
 707   finish:
 708     *scanp = scan;
 709     *deltap = is_inf ? I32_MAX : delta;
 710     if (flags & SCF_DO_SUBSTR && is_inf)
 711         data->pos_delta = I32_MAX - data->pos_min;
 712     if (is_par > U8_MAX)
 713         is_par = 0;
 714     if (is_par && pars==1 && data) {
 715         data->flags |= SF_IN_PAR;
 716         data->flags &= ~SF_HAS_PAR;
 717     }
 718     else if (pars && data) {
 719         data->flags |= SF_HAS_PAR;
 720         data->flags &= ~SF_IN_PAR;
 721     }
 722     return min;
 723 }
 724
 725 STATIC I32
 726 add_data(I32 n, char *s)
 727 {
 728     dTHR;
 729     if (PL_regcomp_rx->data) {
 730         Renewc(PL_regcomp_rx->data,
 731                sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (PL_regcomp_rx->data->count + n - 1),
 732                char, struct reg_data);
 733         Renew(PL_regcomp_rx->data->what, PL_regcomp_rx->data->count + n, U8);
 734         PL_regcomp_rx->data->count += n;
 735     }
 736     else {
 737         Newc(1207, PL_regcomp_rx->data, sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (n - 1),
 738              char, struct reg_data);
 739         New(1208, PL_regcomp_rx->data->what, n, U8);
 740         PL_regcomp_rx->data->count = n;
 741     }
 742     Copy(s, PL_regcomp_rx->data->what + PL_regcomp_rx->data->count - n, n, U8);
 743     return PL_regcomp_rx->data->count - n;
 744 }
 745
 746 /*
 747  - pregcomp - compile a regular expression into internal code
 748  *
 749  * We can't allocate space until we know how big the compiled form will be,
 750  * but we can't compile it (and thus know how big it is) until we've got a
 751  * place to put the code.  So we cheat:  we compile it twice, once with code
 752  * generation turned off and size counting turned on, and once "for real".
 753  * This also means that we don't allocate space until we are sure that the
 754  * thing really will compile successfully, and we never have to move the
 755  * code and thus invalidate pointers into it.  (Note that it has to be in
 756  * one piece because free() must be able to free it all.) [NB: not true in perl]
 757  *
 758  * Beware that the optimization-preparation code in here knows about some
 759  * of the structure of the compiled regexp.  [I'll say.]
 760  */
 761 regexp *
 762 pregcomp(char *exp, char *xend, PMOP *pm)
 763 {
 764     dTHR;
 765     register regexp *r;
 766     regnode *scan;
 767     SV **longest;
 768     SV *longest_fixed;
 769     SV *longest_float;
 770     regnode *first;
 771     I32 flags;
 772     I32 minlen = 0;
 773     I32 sawplus = 0;
 774     I32 sawopen = 0;
 775
 776     if (exp == NULL)
 777         FAIL("NULL regexp argument");
 778
 779     if (PL_curcop == &compiling ? (PL_hints & HINT_UTF8) : IN_UTF8)
 780         PL_reg_flags |= RF_utf8;
 781     else
 782         PL_reg_flags = 0;
 783
 784     PL_regprecomp = savepvn(exp, xend - exp);
 785     DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
 786                           xend - exp, PL_regprecomp));
 787     PL_regflags = pm->op_pmflags;
 788     PL_regsawback = 0;
 789
 790     PL_regseen = 0;
 791     PL_seen_zerolen = *exp == '^' ? -1 : 0;
 792     PL_seen_evals = 0;
 793     PL_extralen = 0;
 794
 795     /* First pass: determine size, legality. */
 796     PL_regcomp_parse = exp;
 797     PL_regxend = xend;
 798     PL_regnaughty = 0;
 799     PL_regnpar = 1;
 800     PL_regsize = 0L;
 801     PL_regcode = &PL_regdummy;
 802     regc((U8)MAGIC, (char*)PL_regcode);
 803     if (reg(0, &flags) == NULL) {
 804         Safefree(PL_regprecomp);
 805         PL_regprecomp = Nullch;
 806         return(NULL);
 807     }
 808     DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize));
 809
 810     DEBUG_r(
 811         if (!PL_colorset) {
 812             int i = 0;
 813             char *s = PerlEnv_getenv("TERMCAP_COLORS");
 814
 815             PL_colorset = 1;
 816             if (s) {
 817                 PL_colors[0] = s = savepv(s);
 818                 while (++i < 4) {
 819                     s = strchr(s, '\t');
 820                     if (!s)
 821                         FAIL("Not enough TABs in TERMCAP_COLORS");
 822                     *s = '\0';
 823                     PL_colors[i] = ++s;
 824                 }
 825             }
 826             else {
 827                 while (i < 4)
 828                     PL_colors[i++] = "";
 829             }
 830             /* Reset colors: */
 831             PerlIO_printf(Perl_debug_log, "%s%s%s%s",
 832                           PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]);
 833         }
 834         );
 835
 836     /* Small enough for pointer-storage convention?
 837        If extralen==0, this means that we will not need long jumps. */
 838     if (PL_regsize >= 0x10000L && PL_extralen)
 839         PL_regsize += PL_extralen;
 840     else
 841         PL_extralen = 0;
 842
 843     /* Allocate space and initialize. */
 844     Newc(1001, r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode),
 845          char, regexp);
 846     if (r == NULL)
 847         FAIL("regexp out of space");
 848     r->refcnt = 1;
 849     r->prelen = xend - exp;
 850     r->precomp = PL_regprecomp;
 851     r->subbeg = r->subbase = NULL;
 852     r->nparens = PL_regnpar - 1;                /* set early to validate backrefs */
 853     PL_regcomp_rx = r;
 854
 855     /* Second pass: emit code. */
 856     PL_regcomp_parse = exp;
 857     PL_regxend = xend;
 858     PL_regnaughty = 0;
 859     PL_regnpar = 1;
 860     PL_regcode = r->program;
 861     /* Store the count of eval-groups for security checks: */
 862     PL_regcode->next_off = ((PL_seen_evals > U16_MAX) ? U16_MAX : PL_seen_evals);
 863     regc((U8)MAGIC, (char*) PL_regcode++);
 864     r->data = 0;
 865     if (reg(0, &flags) == NULL)
 866         return(NULL);
 867
 868     /* Dig out information for optimizations. */
 869     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
 870     pm->op_pmflags = PL_regflags;
 871     if (UTF)
 872         r->reganch |= ROPT_UTF8;
 873     r->regstclass = NULL;
 874     if (PL_regnaughty >= 10)    /* Probably an expensive pattern. */
 875         r->reganch |= ROPT_NAUGHTY;
 876     scan = r->program + 1;              /* First BRANCH. */
 877
 878     /* XXXX To minimize changes to RE engine we always allocate
 879        3-units-long substrs field. */
 880     Newz(1004, r->substrs, 1, struct reg_substr_data);
 881
 882     if (OP(scan) != BRANCH) {   /* Only one top-level choice. */
 883         scan_data_t data;
 884         I32 fake;
 885         STRLEN longest_float_length, longest_fixed_length;
 886
 887         StructCopy(&zero_scan_data, &data, scan_data_t);
 888         first = scan;
 889         /* Skip introductions and multiplicators >= 1. */
 890         while ((OP(first) == OPEN && (sawopen = 1)) ||
 891             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
 892             (OP(first) == PLUS) ||
 893             (OP(first) == MINMOD) ||
 894             (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
 895                 if (OP(first) == PLUS)
 896                     sawplus = 1;
 897                 else
 898                     first += regarglen[(U8)OP(first)];
 899                 first = NEXTOPER(first);
 900         }
 901
 902         /* Starting-point info. */
 903       again:
 904         if (OP(first) == EXACT);        /* Empty, get anchored substr later. */
 905         else if (strchr(simple+4,OP(first)))
 906             r->regstclass = first;
 907         else if (regkind[(U8)OP(first)] == BOUND ||
 908                  regkind[(U8)OP(first)] == NBOUND)
 909             r->regstclass = first;
 910         else if (regkind[(U8)OP(first)] == BOL) {
 911             r->reganch |= (OP(first) == MBOL ? ROPT_ANCH_MBOL: ROPT_ANCH_BOL);
 912             first = NEXTOPER(first);
 913             goto again;
 914         }
 915         else if (OP(first) == GPOS) {
 916             r->reganch |= ROPT_ANCH_GPOS;
 917             first = NEXTOPER(first);
 918             goto again;
 919         }
 920         else if ((OP(first) == STAR &&
 921             regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
 922             !(r->reganch & ROPT_ANCH) )
 923         {
 924             /* turn .* into ^.* with an implied $*=1 */
 925             r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
 926             first = NEXTOPER(first);
 927             goto again;
 928         }
 929         if (sawplus && (!sawopen || !PL_regsawback))
 930             r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
 931
 932         /* Scan is after the zeroth branch, first is atomic matcher. */
 933         DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n",
 934                               first - scan + 1));
 935         /*
 936         * If there's something expensive in the r.e., find the
 937         * longest literal string that must appear and make it the
 938         * regmust.  Resolve ties in favor of later strings, since
 939         * the regstart check works with the beginning of the r.e.
 940         * and avoiding duplication strengthens checking.  Not a
 941         * strong reason, but sufficient in the absence of others.
 942         * [Now we resolve ties in favor of the earlier string if
 943         * it happens that c_offset_min has been invalidated, since the
 944         * earlier string may buy us something the later one won't.]
 945         */
 946         minlen = 0;
 947
 948         data.longest_fixed = newSVpv("",0);
 949         data.longest_float = newSVpv("",0);
 950         data.last_found = newSVpv("",0);
 951         data.longest = &(data.longest_fixed);
 952         first = scan;
 953
 954         minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */
 955                              &data, SCF_DO_SUBSTR);
 956         if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed)
 957              && data.last_start_min == 0 && data.last_end > 0
 958              && !PL_seen_zerolen
 959              && (!(PL_regseen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
 960             r->reganch |= ROPT_CHECK_ALL;
 961         scan_commit(&data);
 962         SvREFCNT_dec(data.last_found);
 963
 964         longest_float_length = CHR_SVLEN(data.longest_float);
 965         if (longest_float_length
 966             || (data.flags & SF_FL_BEFORE_EOL
 967                 && (!(data.flags & SF_FL_BEFORE_MEOL)
 968                     || (PL_regflags & PMf_MULTILINE)))) {
 969             if (SvCUR(data.longest_fixed)                       /* ok to leave SvCUR */
 970                 && data.offset_fixed == data.offset_float_min)
 971                 goto remove;            /* Like in (a)+. */
 972
 973             r->float_substr = data.longest_float;
 974             r->float_min_offset = data.offset_float_min;
 975             r->float_max_offset = data.offset_float_max;
 976             fbm_compile(r->float_substr, 0);
 977             BmUSEFUL(r->float_substr) = 100;
 978             if (data.flags & SF_FL_BEFORE_EOL /* Cannot have SEOL and MULTI */
 979                 && (!(data.flags & SF_FL_BEFORE_MEOL)
 980                     || (PL_regflags & PMf_MULTILINE)))
 981                 SvTAIL_on(r->float_substr);
 982         }
 983         else {
 984           remove:
 985             r->float_substr = Nullsv;
 986             SvREFCNT_dec(data.longest_float);
 987             longest_float_length = 0;
 988         }
 989
 990         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
 991         if (longest_fixed_length
 992             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
 993                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
 994                     || (PL_regflags & PMf_MULTILINE)))) {
 995             r->anchored_substr = data.longest_fixed;
 996             r->anchored_offset = data.offset_fixed;
 997             fbm_compile(r->anchored_substr, 0);
 998             BmUSEFUL(r->anchored_substr) = 100;
 999             if (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
1000                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
1001                     || (PL_regflags & PMf_MULTILINE)))
1002                 SvTAIL_on(r->anchored_substr);
1003         }
1004         else {
1005             r->anchored_substr = Nullsv;
1006             SvREFCNT_dec(data.longest_fixed);
1007             longest_fixed_length = 0;
1008         }
1009
1010         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
1011         if (longest_fixed_length > longest_float_length) {
1012             r->check_substr = r->anchored_substr;
1013             r->check_offset_min = r->check_offset_max = r->anchored_offset;
1014             if (r->reganch & ROPT_ANCH_SINGLE)
1015                 r->reganch |= ROPT_NOSCAN;
1016         }
1017         else {
1018             r->check_substr = r->float_substr;
1019             r->check_offset_min = data.offset_float_min;
1020             r->check_offset_max = data.offset_float_max;
1021         }
1022     }
1023     else {
1024         /* Several toplevels. Best we can is to set minlen. */
1025         I32 fake;
1026
1027         DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
1028         scan = r->program + 1;
1029         minlen = study_chunk(&scan, &fake, scan + PL_regsize, NULL, 0);
1030         r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
1031     }
1032
1033     r->minlen = minlen;
1034     if (PL_regseen & REG_SEEN_GPOS)
1035         r->reganch |= ROPT_GPOS_SEEN;
1036     if (PL_regseen & REG_SEEN_LOOKBEHIND)
1037         r->reganch |= ROPT_LOOKBEHIND_SEEN;
1038     if (PL_regseen & REG_SEEN_EVAL)
1039         r->reganch |= ROPT_EVAL_SEEN;
1040     Newz(1002, r->startp, PL_regnpar, char*);
1041     Newz(1002, r->endp, PL_regnpar, char*);
1042     DEBUG_r(regdump(r));
1043     return(r);
1044 }
1045
1046 /*
1047  - reg - regular expression, i.e. main body or parenthesized thing
1048  *
1049  * Caller must absorb opening parenthesis.
1050  *
1051  * Combining parenthesis handling with the base level of regular expression
1052  * is a trifle forced, but the need to tie the tails of the branches to what
1053  * follows makes it hard to avoid.
1054  */
1055 STATIC regnode *
1056 reg(I32 paren, I32 *flagp)
1057     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
1058 {
1059     dTHR;
1060     register regnode *ret;              /* Will be the head of the group. */
1061     register regnode *br;
1062     register regnode *lastbr;
1063     register regnode *ender = 0;
1064     register I32 parno = 0;
1065     I32 flags, oregflags = PL_regflags, have_branch = 0, open = 0;
1066     char c;
1067
1068     *flagp = 0;                         /* Tentatively. */
1069
1070     /* Make an OPEN node, if parenthesized. */
1071     if (paren) {
1072         if (*PL_regcomp_parse == '?') {
1073             U16 posflags = 0, negflags = 0;
1074             U16 *flagsp = &posflags;
1075
1076             PL_regcomp_parse++;
1077             paren = *PL_regcomp_parse++;
1078             ret = NULL;                 /* For look-ahead/behind. */
1079             switch (paren) {
1080             case '<':
1081                 PL_regseen |= REG_SEEN_LOOKBEHIND;
1082                 if (*PL_regcomp_parse == '!')
1083                     paren = ',';
1084                 if (*PL_regcomp_parse != '=' && *PL_regcomp_parse != '!')
1085                     goto unknown;
1086                 PL_regcomp_parse++;
1087             case '=':
1088             case '!':
1089                 PL_seen_zerolen++;
1090             case ':':
1091             case '>':
1092                 break;
1093             case '$':
1094             case '@':
1095                 FAIL2("Sequence (?%c...) not implemented", (int)paren);
1096                 break;
1097             case '#':
1098                 while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
1099                     PL_regcomp_parse++;
1100                 if (*PL_regcomp_parse != ')')
1101                     FAIL("Sequence (?#... not terminated");
1102                 nextchar();
1103                 *flagp = TRYAGAIN;
1104                 return NULL;
1105             case '{':
1106             {
1107                 dTHR;
1108                 I32 count = 1, n = 0;
1109                 char c;
1110                 char *s = PL_regcomp_parse;
1111                 SV *sv;
1112                 OP_4tree *sop, *rop;
1113
1114                 PL_seen_zerolen++;
1115                 PL_regseen |= REG_SEEN_EVAL;
1116                 while (count && (c = *PL_regcomp_parse)) {
1117                     if (c == '\\' && PL_regcomp_parse[1])
1118                         PL_regcomp_parse++;
1119                     else if (c == '{')
1120                         count++;
1121                     else if (c == '}')
1122                         count--;
1123                     PL_regcomp_parse++;
1124                 }
1125                 if (*PL_regcomp_parse != ')')
1126                     FAIL("Sequence (?{...}) not terminated or not {}-balanced");
1127                 if (!SIZE_ONLY) {
1128                     AV *av;
1129
1130                     if (PL_regcomp_parse - 1 - s)
1131                         sv = newSVpv(s, PL_regcomp_parse - 1 - s);
1132                     else
1133                         sv = newSVpv("", 0);
1134
1135                     rop = sv_compile_2op(sv, &sop, "re", &av);
1136
1137                     n = add_data(3, "nso");
1138                     PL_regcomp_rx->data->data[n] = (void*)rop;
1139                     PL_regcomp_rx->data->data[n+1] = (void*)av;
1140                     PL_regcomp_rx->data->data[n+2] = (void*)sop;
1141                     SvREFCNT_dec(sv);
1142                 }
1143                 else {          /* First pass */
1144                     if (PL_reginterp_cnt < ++PL_seen_evals && PL_curcop != &compiling)
1145                         /* No compiled RE interpolated, has runtime
1146                            components ===> unsafe.  */
1147                         FAIL("Eval-group not allowed at runtime, use re 'eval'");
1148                     if (PL_tainted)
1149                         FAIL("Eval-group in insecure regular expression");
1150                 }
1151
1152                 nextchar();
1153                 return reganode(EVAL, n);
1154             }
1155             case '(':
1156             {
1157                 if (PL_regcomp_parse[0] == '?') {
1158                     if (PL_regcomp_parse[1] == '=' || PL_regcomp_parse[1] == '!'
1159                         || PL_regcomp_parse[1] == '<'
1160                         || PL_regcomp_parse[1] == '{') { /* Lookahead or eval. */
1161                         I32 flag;
1162
1163                         ret = reg_node(LOGICAL);
1164                         regtail(ret, reg(1, &flag));
1165                         goto insert_if;
1166                     }
1167                 }
1168                 else if (PL_regcomp_parse[0] >= '1' && PL_regcomp_parse[0] <= '9' ) {
1169                     parno = atoi(PL_regcomp_parse++);
1170
1171                     while (isDIGIT(*PL_regcomp_parse))
1172                         PL_regcomp_parse++;
1173                     ret = reganode(GROUPP, parno);
1174                     if ((c = *nextchar()) != ')')
1175                         FAIL2("Switch (?(number%c not recognized", c);
1176                   insert_if:
1177                     regtail(ret, reganode(IFTHEN, 0));
1178                     br = regbranch(&flags, 1);
1179                     if (br == NULL)
1180                         br = reganode(LONGJMP, 0);
1181                     else
1182                         regtail(br, reganode(LONGJMP, 0));
1183                     c = *nextchar();
1184                     if (c == '|') {
1185                         lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */
1186                         regbranch(&flags, 1);
1187                         regtail(ret, lastbr);
1188                         c = *nextchar();
1189                     }
1190                     else
1191                         lastbr = NULL;
1192                     if (c != ')')
1193                         FAIL("Switch (?(condition)... contains too many branches");
1194                     ender = reg_node(TAIL);
1195                     regtail(br, ender);
1196                     if (lastbr) {
1197                         regtail(lastbr, ender);
1198                         regtail(NEXTOPER(NEXTOPER(lastbr)), ender);
1199                     }
1200                     else
1201                         regtail(ret, ender);
1202                     return ret;
1203                 }
1204                 else {
1205                     FAIL2("Unknown condition for (?(%.2s", PL_regcomp_parse);
1206                 }
1207             }
1208             case 0:
1209                 FAIL("Sequence (? incomplete");
1210                 break;
1211             default:
1212                 --PL_regcomp_parse;
1213               parse_flags:
1214                 while (*PL_regcomp_parse && strchr("iogcmsx", *PL_regcomp_parse)) {
1215                     if (*PL_regcomp_parse != 'o')
1216                         pmflag(flagsp, *PL_regcomp_parse);
1217                     ++PL_regcomp_parse;
1218                 }
1219                 if (*PL_regcomp_parse == '-') {
1220                     flagsp = &negflags;
1221                     ++PL_regcomp_parse;
1222                     goto parse_flags;
1223                 }
1224                 PL_regflags |= posflags;
1225                 PL_regflags &= ~negflags;
1226                 if (*PL_regcomp_parse == ':') {
1227                     PL_regcomp_parse++;
1228                     paren = ':';
1229                     break;
1230                 }
1231               unknown:
1232                 if (*PL_regcomp_parse != ')')
1233                     FAIL2("Sequence (?%c...) not recognized", *PL_regcomp_parse);
1234                 nextchar();
1235                 *flagp = TRYAGAIN;
1236                 return NULL;
1237             }
1238         }
1239         else {
1240             parno = PL_regnpar;
1241             PL_regnpar++;
1242             ret = reganode(OPEN, parno);
1243             open = 1;
1244         }
1245     }
1246     else
1247         ret = NULL;
1248
1249     /* Pick up the branches, linking them together. */
1250     br = regbranch(&flags, 1);
1251     if (br == NULL)
1252         return(NULL);
1253     if (*PL_regcomp_parse == '|') {
1254         if (!SIZE_ONLY && PL_extralen) {
1255             reginsert(BRANCHJ, br);
1256         }
1257         else
1258             reginsert(BRANCH, br);
1259         have_branch = 1;
1260         if (SIZE_ONLY)
1261             PL_extralen += 1;           /* For BRANCHJ-BRANCH. */
1262     }
1263     else if (paren == ':') {
1264         *flagp |= flags&SIMPLE;
1265     }
1266     if (open) {                         /* Starts with OPEN. */
1267         regtail(ret, br);               /* OPEN -> first. */
1268     }
1269     else if (paren != '?')              /* Not Conditional */
1270         ret = br;
1271     if (flags&HASWIDTH)
1272         *flagp |= HASWIDTH;
1273     *flagp |= flags&SPSTART;
1274     lastbr = br;
1275     while (*PL_regcomp_parse == '|') {
1276         if (!SIZE_ONLY && PL_extralen) {
1277             ender = reganode(LONGJMP,0);
1278             regtail(NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
1279         }
1280         if (SIZE_ONLY)
1281             PL_extralen += 2;           /* Account for LONGJMP. */
1282         nextchar();
1283         br = regbranch(&flags, 0);
1284         if (br == NULL)
1285             return(NULL);
1286         regtail(lastbr, br);            /* BRANCH -> BRANCH. */
1287         lastbr = br;
1288         if (flags&HASWIDTH)
1289             *flagp |= HASWIDTH;
1290         *flagp |= flags&SPSTART;
1291     }
1292
1293     if (have_branch || paren != ':') {
1294         /* Make a closing node, and hook it on the end. */
1295         switch (paren) {
1296         case ':':
1297             ender = reg_node(TAIL);
1298             break;
1299         case 1:
1300             ender = reganode(CLOSE, parno);
1301             break;
1302         case '<':
1303         case ',':
1304         case '=':
1305         case '!':
1306             *flagp &= ~HASWIDTH;
1307             /* FALL THROUGH */
1308         case '>':
1309             ender = reg_node(SUCCEED);
1310             break;
1311         case 0:
1312             ender = reg_node(END);
1313             break;
1314         }
1315         regtail(lastbr, ender);
1316
1317         if (have_branch) {
1318             /* Hook the tails of the branches to the closing node. */
1319             for (br = ret; br != NULL; br = regnext(br)) {
1320                 regoptail(br, ender);
1321             }
1322         }
1323     }
1324
1325     {
1326         char *p;
1327         static char parens[] = "=!<,>";
1328
1329         if (paren && (p = strchr(parens, paren))) {
1330             int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
1331             int flag = (p - parens) > 1;
1332
1333             if (paren == '>')
1334                 node = SUSPEND, flag = 0;
1335             reginsert(node,ret);
1336             ret->flags = flag;
1337             regtail(ret, reg_node(TAIL));
1338         }
1339     }
1340
1341     /* Check for proper termination. */
1342     if (paren && (PL_regcomp_parse >= PL_regxend || *nextchar() != ')')) {
1343         FAIL("unmatched () in regexp");
1344     }
1345     else if (!paren && PL_regcomp_parse < PL_regxend) {
1346         if (*PL_regcomp_parse == ')') {
1347             FAIL("unmatched () in regexp");
1348         }
1349         else
1350             FAIL("junk on end of regexp");      /* "Can't happen". */
1351         /* NOTREACHED */
1352     }
1353     if (paren != 0) {
1354         PL_regflags = oregflags;
1355     }
1356
1357     return(ret);
1358 }
1359
1360 /*
1361  - regbranch - one alternative of an | operator
1362  *
1363  * Implements the concatenation operator.
1364  */
1365 STATIC regnode *
1366 regbranch(I32 *flagp, I32 first)
1367 {
1368     dTHR;
1369     register regnode *ret;
1370     register regnode *chain = NULL;
1371     register regnode *latest;
1372     I32 flags = 0, c = 0;
1373
1374     if (first)
1375         ret = NULL;
1376     else {
1377         if (!SIZE_ONLY && PL_extralen)
1378             ret = reganode(BRANCHJ,0);
1379         else
1380             ret = reg_node(BRANCH);
1381     }
1382
1383     if (!first && SIZE_ONLY)
1384         PL_extralen += 1;                       /* BRANCHJ */
1385
1386     *flagp = WORST;                     /* Tentatively. */
1387
1388     PL_regcomp_parse--;
1389     nextchar();
1390     while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '|' && *PL_regcomp_parse != ')') {
1391         flags &= ~TRYAGAIN;
1392         latest = regpiece(&flags);
1393         if (latest == NULL) {
1394             if (flags & TRYAGAIN)
1395                 continue;
1396             return(NULL);
1397         }
1398         else if (ret == NULL)
1399             ret = latest;
1400         *flagp |= flags&HASWIDTH;
1401         if (chain == NULL)      /* First piece. */
1402             *flagp |= flags&SPSTART;
1403         else {
1404             PL_regnaughty++;
1405             regtail(chain, latest);
1406         }
1407         chain = latest;
1408         c++;
1409     }
1410     if (chain == NULL) {        /* Loop ran zero times. */
1411         chain = reg_node(NOTHING);
1412         if (ret == NULL)
1413             ret = chain;
1414     }
1415     if (c == 1) {
1416         *flagp |= flags&SIMPLE;
1417     }
1418
1419     return(ret);
1420 }
1421
1422 /*
1423  - regpiece - something followed by possible [*+?]
1424  *
1425  * Note that the branching code sequences used for ? and the general cases
1426  * of * and + are somewhat optimized:  they use the same NOTHING node as
1427  * both the endmarker for their branch list and the body of the last branch.
1428  * It might seem that this node could be dispensed with entirely, but the
1429  * endmarker role is not redundant.
1430  */
1431 STATIC regnode *
1432 regpiece(I32 *flagp)
1433 {
1434     dTHR;
1435     register regnode *ret;
1436     register char op;
1437     register char *next;
1438     I32 flags;
1439     char *origparse = PL_regcomp_parse;
1440     char *maxpos;
1441     I32 min;
1442     I32 max = REG_INFTY;
1443
1444     ret = regatom(&flags);
1445     if (ret == NULL) {
1446         if (flags & TRYAGAIN)
1447             *flagp |= TRYAGAIN;
1448         return(NULL);
1449     }
1450
1451     op = *PL_regcomp_parse;
1452
1453     if (op == '{' && regcurly(PL_regcomp_parse)) {
1454         next = PL_regcomp_parse + 1;
1455         maxpos = Nullch;
1456         while (isDIGIT(*next) || *next == ',') {
1457             if (*next == ',') {
1458                 if (maxpos)
1459                     break;
1460                 else
1461                     maxpos = next;
1462             }
1463             next++;
1464         }
1465         if (*next == '}') {             /* got one */
1466             if (!maxpos)
1467                 maxpos = next;
1468             PL_regcomp_parse++;
1469             min = atoi(PL_regcomp_parse);
1470             if (*maxpos == ',')
1471                 maxpos++;
1472             else
1473                 maxpos = PL_regcomp_parse;
1474             max = atoi(maxpos);
1475             if (!max && *maxpos != '0')
1476                 max = REG_INFTY;                /* meaning "infinity" */
1477             else if (max >= REG_INFTY)
1478                 FAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
1479             PL_regcomp_parse = next;
1480             nextchar();
1481
1482         do_curly:
1483             if ((flags&SIMPLE)) {
1484                 PL_regnaughty += 2 + PL_regnaughty / 2;
1485                 reginsert(CURLY, ret);
1486             }
1487             else {
1488                 PL_regnaughty += 4 + PL_regnaughty;     /* compound interest */
1489                 regtail(ret, reg_node(WHILEM));
1490                 if (!SIZE_ONLY && PL_extralen) {
1491                     reginsert(LONGJMP,ret);
1492                     reginsert(NOTHING,ret);
1493                     NEXT_OFF(ret) = 3;  /* Go over LONGJMP. */
1494                 }
1495                 reginsert(CURLYX,ret);
1496                 if (!SIZE_ONLY && PL_extralen)
1497                     NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
1498                 regtail(ret, reg_node(NOTHING));
1499                 if (SIZE_ONLY)
1500                     PL_extralen += 3;
1501             }
1502             ret->flags = 0;
1503
1504             if (min > 0)
1505                 *flagp = WORST;
1506             if (max > 0)
1507                 *flagp |= HASWIDTH;
1508             if (max && max < min)
1509                 FAIL("Can't do {n,m} with n > m");
1510             if (!SIZE_ONLY) {
1511                 ARG1_SET(ret, min);
1512                 ARG2_SET(ret, max);
1513             }
1514
1515             goto nest_check;
1516         }
1517     }
1518
1519     if (!ISMULT1(op)) {
1520         *flagp = flags;
1521         return(ret);
1522     }
1523
1524 #if 0                           /* Now runtime fix should be reliable. */
1525     if (!(flags&HASWIDTH) && op != '?')
1526       FAIL("regexp *+ operand could be empty");
1527 #endif
1528
1529     nextchar();
1530
1531     *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
1532
1533     if (op == '*' && (flags&SIMPLE)) {
1534         reginsert(STAR, ret);
1535         ret->flags = 0;
1536         PL_regnaughty += 4;
1537     }
1538     else if (op == '*') {
1539         min = 0;
1540         goto do_curly;
1541     }
1542     else if (op == '+' && (flags&SIMPLE)) {
1543         reginsert(PLUS, ret);
1544         ret->flags = 0;
1545         PL_regnaughty += 3;
1546     }
1547     else if (op == '+') {
1548         min = 1;
1549         goto do_curly;
1550     }
1551     else if (op == '?') {
1552         min = 0; max = 1;
1553         goto do_curly;
1554     }
1555   nest_check:
1556     if (PL_dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
1557         warn("%.*s matches null string many times",
1558             PL_regcomp_parse - origparse, origparse);
1559     }
1560
1561     if (*PL_regcomp_parse == '?') {
1562         nextchar();
1563         reginsert(MINMOD, ret);
1564         regtail(ret, ret + NODE_STEP_REGNODE);
1565     }
1566     if (ISMULT2(PL_regcomp_parse))
1567         FAIL("nested *?+ in regexp");
1568
1569     return(ret);
1570 }
1571
1572 /*
1573  - regatom - the lowest level
1574  *
1575  * Optimization:  gobbles an entire sequence of ordinary characters so that
1576  * it can turn them into a single node, which is smaller to store and
1577  * faster to run.  Backslashed characters are exceptions, each becoming a
1578  * separate node; the code is simpler that way and it's not worth fixing.
1579  *
1580  * [Yes, it is worth fixing, some scripts can run twice the speed.]
1581  */
1582 STATIC regnode *
1583 regatom(I32 *flagp)
1584 {
1585     dTHR;
1586     register regnode *ret = 0;
1587     I32 flags;
1588
1589     *flagp = WORST;             /* Tentatively. */
1590
1591 tryagain:
1592     switch (*PL_regcomp_parse) {
1593     case '^':
1594         PL_seen_zerolen++;
1595         nextchar();
1596         if (PL_regflags & PMf_MULTILINE)
1597             ret = reg_node(MBOL);
1598         else if (PL_regflags & PMf_SINGLELINE)
1599             ret = reg_node(SBOL);
1600         else
1601             ret = reg_node(BOL);
1602         break;
1603     case '$':
1604         if (PL_regcomp_parse[1])
1605             PL_seen_zerolen++;
1606         nextchar();
1607         if (PL_regflags & PMf_MULTILINE)
1608             ret = reg_node(MEOL);
1609         else if (PL_regflags & PMf_SINGLELINE)
1610             ret = reg_node(SEOL);
1611         else
1612             ret = reg_node(EOL);
1613         break;
1614     case '.':
1615         nextchar();
1616         if (UTF) {
1617             if (PL_regflags & PMf_SINGLELINE)
1618                 ret = reg_node(SANYUTF8);
1619             else
1620                 ret = reg_node(ANYUTF8);
1621             *flagp |= HASWIDTH;
1622         }
1623         else {
1624             if (PL_regflags & PMf_SINGLELINE)
1625                 ret = reg_node(SANY);
1626             else
1627                 ret = reg_node(ANY);
1628             *flagp |= HASWIDTH|SIMPLE;
1629         }
1630         PL_regnaughty++;
1631         break;
1632     case '[':
1633         PL_regcomp_parse++;
1634         ret = (UTF ? regclassutf8() : regclass());
1635         *flagp |= HASWIDTH|SIMPLE;
1636         break;
1637     case '(':
1638         nextchar();
1639         ret = reg(1, &flags);
1640         if (ret == NULL) {
1641                 if (flags & TRYAGAIN)
1642                     goto tryagain;
1643                 return(NULL);
1644         }
1645         *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
1646         break;
1647     case '|':
1648     case ')':
1649         if (flags & TRYAGAIN) {
1650             *flagp |= TRYAGAIN;
1651             return NULL;
1652         }
1653         FAIL2("internal urp in regexp at /%s/", PL_regcomp_parse);
1654                                 /* Supposed to be caught earlier. */
1655         break;
1656     case '{':
1657         if (!regcurly(PL_regcomp_parse)) {
1658             PL_regcomp_parse++;
1659             goto defchar;
1660         }
1661         /* FALL THROUGH */
1662     case '?':
1663     case '+':
1664     case '*':
1665         FAIL("?+*{} follows nothing in regexp");
1666         break;
1667     case '\\':
1668         switch (*++PL_regcomp_parse) {
1669         case 'A':
1670             PL_seen_zerolen++;
1671             ret = reg_node(SBOL);
1672             *flagp |= SIMPLE;
1673             nextchar();
1674             break;
1675         case 'G':
1676             ret = reg_node(GPOS);
1677             PL_regseen |= REG_SEEN_GPOS;
1678             *flagp |= SIMPLE;
1679             nextchar();
1680             break;
1681         case 'Z':
1682             ret = reg_node(SEOL);
1683             *flagp |= SIMPLE;
1684             nextchar();
1685             break;
1686         case 'z':
1687             ret = reg_node(EOS);
1688             *flagp |= SIMPLE;
1689             PL_seen_zerolen++;          /* Do not optimize RE away */
1690             nextchar();
1691             break;
1692         case 'C':
1693             ret = reg_node(SANY);
1694             *flagp |= HASWIDTH|SIMPLE;
1695             nextchar();
1696             break;
1697         case 'X':
1698             ret = reg_node(CLUMP);
1699             *flagp |= HASWIDTH;
1700             nextchar();
1701             if (UTF && !PL_utf8_mark)
1702                 is_utf8_mark("~");      /* preload table */
1703             break;
1704         case 'w':
1705             ret = reg_node(
1706                 UTF
1707                     ? (LOC ? ALNUMLUTF8 : ALNUMUTF8)
1708                     : (LOC ? ALNUML     : ALNUM));
1709             *flagp |= HASWIDTH|SIMPLE;
1710             nextchar();
1711             if (UTF && !PL_utf8_alnum)
1712                 is_utf8_alnum("a");     /* preload table */
1713             break;
1714         case 'W':
1715             ret = reg_node(
1716                 UTF
1717                     ? (LOC ? NALNUMLUTF8 : NALNUMUTF8)
1718                     : (LOC ? NALNUML     : NALNUM));
1719             *flagp |= HASWIDTH|SIMPLE;
1720             nextchar();
1721             if (UTF && !PL_utf8_alnum)
1722                 is_utf8_alnum("a");     /* preload table */
1723             break;
1724         case 'b':
1725             PL_seen_zerolen++;
1726             ret = reg_node(
1727                 UTF
1728                     ? (LOC ? BOUNDLUTF8 : BOUNDUTF8)
1729                     : (LOC ? BOUNDL     : BOUND));
1730             *flagp |= SIMPLE;
1731             nextchar();
1732             if (UTF && !PL_utf8_alnum)
1733                 is_utf8_alnum("a");     /* preload table */
1734             break;
1735         case 'B':
1736             PL_seen_zerolen++;
1737             ret = reg_node(
1738                 UTF
1739                     ? (LOC ? NBOUNDLUTF8 : NBOUNDUTF8)
1740                     : (LOC ? NBOUNDL     : NBOUND));
1741             *flagp |= SIMPLE;
1742             nextchar();
1743             if (UTF && !PL_utf8_alnum)
1744                 is_utf8_alnum("a");     /* preload table */
1745             break;
1746         case 's':
1747             ret = reg_node(
1748                 UTF
1749                     ? (LOC ? SPACELUTF8 : SPACEUTF8)
1750                     : (LOC ? SPACEL     : SPACE));
1751             *flagp |= HASWIDTH|SIMPLE;
1752             nextchar();
1753             if (UTF && !PL_utf8_space)
1754                 is_utf8_space(" ");     /* preload table */
1755             break;
1756         case 'S':
1757             ret = reg_node(
1758                 UTF
1759                     ? (LOC ? NSPACELUTF8 : NSPACEUTF8)
1760                     : (LOC ? NSPACEL     : NSPACE));
1761             *flagp |= HASWIDTH|SIMPLE;
1762             nextchar();
1763             if (UTF && !PL_utf8_space)
1764                 is_utf8_space(" ");     /* preload table */
1765             break;
1766         case 'd':
1767             ret = reg_node(UTF ? DIGITUTF8 : DIGIT);
1768             *flagp |= HASWIDTH|SIMPLE;
1769             nextchar();
1770             if (UTF && !PL_utf8_digit)
1771                 is_utf8_digit("1");     /* preload table */
1772             break;
1773         case 'D':
1774             ret = reg_node(UTF ? NDIGITUTF8 : NDIGIT);
1775             *flagp |= HASWIDTH|SIMPLE;
1776             nextchar();
1777             if (UTF && !PL_utf8_digit)
1778                 is_utf8_digit("1");     /* preload table */
1779             break;
1780         case 'n':
1781         case 'r':
1782         case 't':
1783         case 'f':
1784         case 'e':
1785         case 'a':
1786         case 'x':
1787         case 'c':
1788         case '0':
1789             goto defchar;
1790         case '1': case '2': case '3': case '4':
1791         case '5': case '6': case '7': case '8': case '9':
1792             {
1793                 I32 num = atoi(PL_regcomp_parse);
1794
1795                 if (num > 9 && num >= PL_regnpar)
1796                     goto defchar;
1797                 else {
1798                     if (!SIZE_ONLY && num > PL_regcomp_rx->nparens)
1799                         FAIL("reference to nonexistent group");
1800                     PL_regsawback = 1;
1801                     ret = reganode(FOLD
1802                                    ? (LOC ? REFFL : REFF)
1803                                    : REF, num);
1804                     *flagp |= HASWIDTH;
1805                     while (isDIGIT(*PL_regcomp_parse))
1806                         PL_regcomp_parse++;
1807                     PL_regcomp_parse--;
1808                     nextchar();
1809                 }
1810             }
1811             break;
1812         case '\0':
1813             if (PL_regcomp_parse >= PL_regxend)
1814                 FAIL("trailing \\ in regexp");
1815             /* FALL THROUGH */
1816         default:
1817             goto defchar;
1818         }
1819         break;
1820
1821     case '#':
1822         if (PL_regflags & PMf_EXTENDED) {
1823             while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '\n') PL_regcomp_parse++;
1824             if (PL_regcomp_parse < PL_regxend)
1825                 goto tryagain;
1826         }
1827         /* FALL THROUGH */
1828
1829     default: {
1830             register I32 len;
1831             register UV ender;
1832             register char *p;
1833             char *oldp, *s;
1834             I32 numlen;
1835
1836             PL_regcomp_parse++;
1837
1838         defchar:
1839             ret = reg_node(FOLD
1840                           ? (LOC ? EXACTFL : EXACTF)
1841                           : EXACT);
1842             s = (char *) OPERAND(ret);
1843             regc(0, s++);               /* save spot for len */
1844             for (len = 0, p = PL_regcomp_parse - 1;
1845               len < 127 && p < PL_regxend;
1846               len++)
1847             {
1848                 oldp = p;
1849
1850                 if (PL_regflags & PMf_EXTENDED)
1851                     p = regwhite(p, PL_regxend);
1852                 switch (*p) {
1853                 case '^':
1854                 case '$':
1855                 case '.':
1856                 case '[':
1857                 case '(':
1858                 case ')':
1859                 case '|':
1860                     goto loopdone;
1861                 case '\\':
1862                     switch (*++p) {
1863                     case 'A':
1864                     case 'G':
1865                     case 'Z':
1866                     case 'z':
1867                     case 'w':
1868                     case 'W':
1869                     case 'b':
1870                     case 'B':
1871                     case 's':
1872                     case 'S':
1873                     case 'd':
1874                     case 'D':
1875                         --p;
1876                         goto loopdone;
1877                     case 'n':
1878                         ender = '\n';
1879                         p++;
1880                         break;
1881                     case 'r':
1882                         ender = '\r';
1883                         p++;
1884                         break;
1885                     case 't':
1886                         ender = '\t';
1887                         p++;
1888                         break;
1889                     case 'f':
1890                         ender = '\f';
1891                         p++;
1892                         break;
1893                     case 'e':
1894                         ender = '\033';
1895                         p++;
1896                         break;
1897                     case 'a':
1898                         ender = '\007';
1899                         p++;
1900                         break;
1901                     case 'x':
1902                         if (*++p == '{') {
1903                             char* e = strchr(p, '}');
1904
1905                             if (!e)
1906                                 FAIL("Missing right brace on \\x{}");
1907                             else if (UTF) {
1908                                 ender = scan_hex(p + 1, e - p, &numlen);
1909                                 if (numlen + len >= 127) {      /* numlen is generous */
1910                                     p--;
1911                                     goto loopdone;
1912                                 }
1913                                 p = e + 1;
1914                             }
1915                             else
1916                                 FAIL("Can't use \\x{} without 'use utf8' declaration");
1917                         }
1918                         else {
1919                             ender = scan_hex(p, 2, &numlen);
1920                             p += numlen;
1921                         }
1922                         break;
1923                     case 'c':
1924                         p++;
1925                         ender = UCHARAT(p++);
1926                         ender = toCTRL(ender);
1927                         break;
1928                     case '0': case '1': case '2': case '3':case '4':
1929                     case '5': case '6': case '7': case '8':case '9':
1930                         if (*p == '0' ||
1931                           (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
1932                             ender = scan_oct(p, 3, &numlen);
1933                             p += numlen;
1934                         }
1935                         else {
1936                             --p;
1937                             goto loopdone;
1938                         }
1939                         break;
1940                     case '\0':
1941                         if (p >= PL_regxend)
1942                             FAIL("trailing \\ in regexp");
1943                         /* FALL THROUGH */
1944                     default:
1945                         goto normal_default;
1946                     }
1947                     break;
1948                 default:
1949                   normal_default:
1950                     if ((*p & 0xc0) == 0xc0 && UTF) {
1951                         ender = utf8_to_uv(p, &numlen);
1952                         p += numlen;
1953                     }
1954                     else
1955                         ender = *p++;
1956                     break;
1957                 }
1958                 if (PL_regflags & PMf_EXTENDED)
1959                     p = regwhite(p, PL_regxend);
1960                 if (UTF && FOLD) {
1961                     if (LOC)
1962                         ender = toLOWER_LC_uni(ender);
1963                     else
1964                         ender = toLOWER_uni(ender);
1965                 }
1966                 if (ISMULT2(p)) { /* Back off on ?+*. */
1967                     if (len)
1968                         p = oldp;
1969                     else if (ender >= 0x80 && UTF) {
1970                         reguni(ender, s, &numlen);
1971                         s += numlen;
1972                         len += numlen;
1973                     }
1974                     else {
1975                         len++;
1976                         regc(ender, s++);
1977                     }
1978                     break;
1979                 }
1980                 if (ender >= 0x80 && UTF) {
1981                     reguni(ender, s, &numlen);
1982                     s += numlen;
1983                     len += numlen - 1;
1984                 }
1985                 else
1986                     regc(ender, s++);
1987             }
1988         loopdone:
1989             PL_regcomp_parse = p - 1;
1990             nextchar();
1991             if (len < 0)
1992                 FAIL("internal disaster in regexp");
1993             if (len > 0)
1994                 *flagp |= HASWIDTH;
1995             if (len == 1)
1996                 *flagp |= SIMPLE;
1997             if (!SIZE_ONLY)
1998                 *OPERAND(ret) = len;
1999             regc('\0', s++);
2000             if (SIZE_ONLY) {
2001                 PL_regsize += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
2002             }
2003             else {
2004                 PL_regcode += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
2005             }
2006         }
2007         break;
2008     }
2009
2010     return(ret);
2011 }
2012
2013 STATIC char *
2014 regwhite(char *p, char *e)
2015 {
2016     while (p < e) {
2017         if (isSPACE(*p))
2018             ++p;
2019         else if (*p == '#') {
2020             do {
2021                 p++;
2022             } while (p < e && *p != '\n');
2023         }
2024         else
2025             break;
2026     }
2027     return p;
2028 }
2029
2030 STATIC regnode *
2031 regclass(void)
2032 {
2033     dTHR;
2034     register char *opnd, *s;
2035     register I32 value;
2036     register I32 lastvalue = 1234;
2037     register I32 range = 0;
2038     register regnode *ret;
2039     register I32 def;
2040     I32 numlen;
2041
2042     s = opnd = (char *) OPERAND(PL_regcode);
2043     ret = reg_node(ANYOF);
2044     for (value = 0; value < 33; value++)
2045         regc(0, s++);
2046     if (*PL_regcomp_parse == '^') {     /* Complement of range. */
2047         PL_regnaughty++;
2048         PL_regcomp_parse++;
2049         if (!SIZE_ONLY)
2050             *opnd |= ANYOF_INVERT;
2051     }
2052     if (!SIZE_ONLY) {
2053         PL_regcode += ANY_SKIP;
2054         if (FOLD)
2055             *opnd |= ANYOF_FOLD;
2056         if (LOC)
2057             *opnd |= ANYOF_LOCALE;
2058     }
2059     else {
2060         PL_regsize += ANY_SKIP;
2061     }
2062     if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
2063         goto skipcond;          /* allow 1st char to be ] or - */
2064     while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
2065        skipcond:
2066         value = UCHARAT(PL_regcomp_parse++);
2067         if (value == '[' && PL_regcomp_parse + 1 < PL_regxend &&
2068             /* I smell either [: or [= or [. -- POSIX has been here, right? */
2069             (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) {
2070             char  posixccc = *PL_regcomp_parse;
2071             char* posixccs = PL_regcomp_parse++;
2072
2073             while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != posixccc)
2074                 PL_regcomp_parse++;
2075             if (PL_regcomp_parse == PL_regxend)
2076                 /* Grandfather lone [:, [=, [. */
2077                 PL_regcomp_parse = posixccs;
2078             else {
2079                 PL_regcomp_parse++; /* skip over the posixccc */
2080                 if (*PL_regcomp_parse == ']') {
2081                     /* Not Implemented Yet.
2082                      * (POSIX Extended Character Classes, that is)
2083                      * The text between e.g. [: and :] would start
2084                      * at posixccs + 1 and stop at regcomp_parse - 2. */
2085                     if (dowarn && !SIZE_ONLY)
2086                         warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
2087                     PL_regcomp_parse++; /* skip over the ending ] */
2088                 }
2089             }
2090         }
2091         if (value == '\\') {
2092             value = UCHARAT(PL_regcomp_parse++);
2093             switch (value) {
2094             case 'w':
2095                 if (!SIZE_ONLY) {
2096                     if (LOC)
2097                         *opnd |= ANYOF_ALNUML;
2098                     else {
2099                         for (value = 0; value < 256; value++)
2100                             if (isALNUM(value))
2101                                 ANYOF_SET(opnd, value);
2102                     }
2103                 }
2104                 lastvalue = 1234;
2105                 continue;
2106             case 'W':
2107                 if (!SIZE_ONLY) {
2108                     if (LOC)
2109                         *opnd |= ANYOF_NALNUML;
2110                     else {
2111                         for (value = 0; value < 256; value++)
2112                             if (!isALNUM(value))
2113                                 ANYOF_SET(opnd, value);
2114                     }
2115                 }
2116                 lastvalue = 1234;
2117                 continue;
2118             case 's':
2119                 if (!SIZE_ONLY) {
2120                     if (LOC)
2121                         *opnd |= ANYOF_SPACEL;
2122                     else {
2123                         for (value = 0; value < 256; value++)
2124                             if (isSPACE(value))
2125                                 ANYOF_SET(opnd, value);
2126                     }
2127                 }
2128                 lastvalue = 1234;
2129                 continue;
2130             case 'S':
2131                 if (!SIZE_ONLY) {
2132                     if (LOC)
2133                         *opnd |= ANYOF_NSPACEL;
2134                     else {
2135                         for (value = 0; value < 256; value++)
2136                             if (!isSPACE(value))
2137                                 ANYOF_SET(opnd, value);
2138                     }
2139                 }
2140                 lastvalue = 1234;
2141                 continue;
2142             case 'd':
2143                 if (!SIZE_ONLY) {
2144                     for (value = '0'; value <= '9'; value++)
2145                         ANYOF_SET(opnd, value);
2146                 }
2147                 lastvalue = 1234;
2148                 continue;
2149             case 'D':
2150                 if (!SIZE_ONLY) {
2151                     for (value = 0; value < '0'; value++)
2152                         ANYOF_SET(opnd, value);
2153                     for (value = '9' + 1; value < 256; value++)
2154                         ANYOF_SET(opnd, value);
2155                 }
2156                 lastvalue = 1234;
2157                 continue;
2158             case 'n':
2159                 value = '\n';
2160                 break;
2161             case 'r':
2162                 value = '\r';
2163                 break;
2164             case 't':
2165                 value = '\t';
2166                 break;
2167             case 'f':
2168                 value = '\f';
2169                 break;
2170             case 'b':
2171                 value = '\b';
2172                 break;
2173             case 'e':
2174                 value = '\033';
2175                 break;
2176             case 'a':
2177                 value = '\007';
2178                 break;
2179             case 'x':
2180                 value = scan_hex(PL_regcomp_parse, 2, &numlen);
2181                 PL_regcomp_parse += numlen;
2182                 break;
2183             case 'c':
2184                 value = UCHARAT(PL_regcomp_parse++);
2185                 value = toCTRL(value);
2186                 break;
2187             case '0': case '1': case '2': case '3': case '4':
2188             case '5': case '6': case '7': case '8': case '9':
2189                 value = scan_oct(--PL_regcomp_parse, 3, &numlen);
2190                 PL_regcomp_parse += numlen;
2191                 break;
2192             }
2193         }
2194         if (range) {
2195             if (lastvalue > value)
2196                 FAIL("invalid [] range in regexp");
2197             range = 0;
2198         }
2199         else {
2200             lastvalue = value;
2201             if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
2202               PL_regcomp_parse[1] != ']') {
2203                 PL_regcomp_parse++;
2204                 range = 1;
2205                 continue;       /* do it next time */
2206             }
2207         }
2208         if (!SIZE_ONLY) {
2209             for ( ; lastvalue <= value; lastvalue++)
2210                 ANYOF_SET(opnd, lastvalue);
2211         }
2212         lastvalue = value;
2213     }
2214     if (*PL_regcomp_parse != ']')
2215         FAIL("unmatched [] in regexp");
2216     nextchar();
2217     /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
2218     if (!SIZE_ONLY && (*opnd & (0xFF ^ ANYOF_INVERT)) == ANYOF_FOLD) {
2219         for (value = 0; value < 256; ++value) {
2220             if (ANYOF_TEST(opnd, value)) {
2221                 I32 cf = fold[value];
2222                 ANYOF_SET(opnd, cf);
2223             }
2224         }
2225         *opnd &= ~ANYOF_FOLD;
2226     }
2227     /* optimize inverted simple patterns (e.g. [^a-z]) */
2228     if (!SIZE_ONLY && (*opnd & 0xFF) == ANYOF_INVERT) {
2229         for (value = 0; value < 32; ++value)
2230             opnd[1 + value] ^= 0xFF;
2231         *opnd = 0;
2232     }
2233     return ret;
2234 }
2235
2236 STATIC regnode *
2237 regclassutf8(void)
2238 {
2239     register char *opnd, *e;
2240     register U32 value;
2241     register U32 lastvalue = 123456;
2242     register I32 range = 0;
2243     register regnode *ret;
2244     I32 numlen;
2245     I32 n;
2246     SV *listsv;
2247     U8 flags = 0;
2248
2249     if (*PL_regcomp_parse == '^') {     /* Complement of range. */
2250         PL_regnaughty++;
2251         PL_regcomp_parse++;
2252         if (!SIZE_ONLY)
2253             flags |= ANYOF_INVERT;
2254     }
2255     if (!SIZE_ONLY) {
2256         if (FOLD)
2257             flags |= ANYOF_FOLD;
2258         if (LOC)
2259             flags |= ANYOF_LOCALE;
2260         listsv = newSVpv("# comment\n",0);
2261     }
2262
2263     if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
2264         goto skipcond;          /* allow 1st char to be ] or - */
2265
2266     while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
2267        skipcond:
2268         value = utf8_to_uv(PL_regcomp_parse, &numlen);
2269         PL_regcomp_parse += numlen;
2270
2271         if (value == '[' && PL_regcomp_parse + 1 < PL_regxend &&
2272             /* I smell either [: or [= or [. -- POSIX has been here, right? */
2273             (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) {
2274             char  posixccc = *PL_regcomp_parse;
2275             char* posixccs = PL_regcomp_parse++;
2276
2277             while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != posixccc)
2278                 PL_regcomp_parse++;
2279             if (PL_regcomp_parse == PL_regxend)
2280                 /* Grandfather lone [:, [=, [. */
2281                 PL_regcomp_parse = posixccs;
2282             else {
2283                 PL_regcomp_parse++; /* skip over the posixccc */
2284                 if (*PL_regcomp_parse == ']') {
2285                     /* Not Implemented Yet.
2286                      * (POSIX Extended Character Classes, that is)
2287                      * The text between e.g. [: and :] would start
2288                      * at posixccs + 1 and stop at regcomp_parse - 2. */
2289                     if (dowarn && !SIZE_ONLY)
2290                         warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
2291                     PL_regcomp_parse++; /* skip over the ending ] */
2292                 }
2293             }
2294         }
2295
2296         if (value == '\\') {
2297             value = utf8_to_uv(PL_regcomp_parse, &numlen);
2298             PL_regcomp_parse += numlen;
2299             switch (value) {
2300             case 'w':
2301                 if (!SIZE_ONLY) {
2302                     if (LOC)
2303                         flags |= ANYOF_ALNUML;
2304
2305                     sv_catpvf(listsv, "+utf8::IsAlnum\n");
2306                 }
2307                 lastvalue = 123456;
2308                 continue;
2309             case 'W':
2310                 if (!SIZE_ONLY) {
2311                     if (LOC)
2312                         flags |= ANYOF_NALNUML;
2313
2314                     sv_catpvf(listsv,
2315                         "-utf8::IsAlpha\n-utf8::IsDigit\n0000\t%04x\n%04x\tffff\n",
2316                         '_' - 1,
2317                         '_' + 1);
2318                 }
2319                 lastvalue = 123456;
2320                 continue;
2321             case 's':
2322                 if (!SIZE_ONLY) {
2323                     if (LOC)
2324                         flags |= ANYOF_SPACEL;
2325                     sv_catpvf(listsv, "+utf8::IsSpace\n");
2326                     if (!PL_utf8_space)
2327                         is_utf8_space(" ");
2328                 }
2329                 lastvalue = 123456;
2330                 continue;
2331             case 'S':
2332                 if (!SIZE_ONLY) {
2333                     if (LOC)
2334                         flags |= ANYOF_NSPACEL;
2335                     sv_catpvf(listsv,
2336                         "!utf8::IsSpace\n");
2337                     if (!PL_utf8_space)
2338                         is_utf8_space(" ");
2339                 }
2340                 lastvalue = 123456;
2341                 continue;
2342             case 'd':
2343                 if (!SIZE_ONLY) {
2344                     sv_catpvf(listsv, "+utf8::IsDigit\n");
2345                 }
2346                 lastvalue = 123456;
2347                 continue;
2348             case 'D':
2349                 if (!SIZE_ONLY) {
2350                     sv_catpvf(listsv,
2351                         "!utf8::IsDigit\n");
2352                 }
2353                 lastvalue = 123456;
2354                 continue;
2355             case 'p':
2356             case 'P':
2357                 if (*PL_regcomp_parse == '{') {
2358                     e = strchr(PL_regcomp_parse++, '}');
2359                     if (!e)
2360                         FAIL("Missing right brace on \\p{}");
2361                     n = e - PL_regcomp_parse;
2362                 }
2363                 else {
2364                     e = PL_regcomp_parse;
2365                     n = 1;
2366                 }
2367                 if (!SIZE_ONLY) {
2368                     if (value == 'p')
2369                         sv_catpvf(listsv, "+utf8::%.*s\n", n, PL_regcomp_parse);
2370                     else
2371                         sv_catpvf(listsv,
2372                             "!utf8::%.*s\n", n, PL_regcomp_parse);
2373                 }
2374                 PL_regcomp_parse = e + 1;
2375                 lastvalue = 123456;
2376                 continue;
2377             case 'n':
2378                 value = '\n';
2379                 break;
2380             case 'r':
2381                 value = '\r';
2382                 break;
2383             case 't':
2384                 value = '\t';
2385                 break;
2386             case 'f':
2387                 value = '\f';
2388                 break;
2389             case 'b':
2390                 value = '\b';
2391                 break;
2392             case 'e':
2393                 value = '\033';
2394                 break;
2395             case 'a':
2396                 value = '\007';
2397                 break;
2398             case 'x':
2399                 if (*PL_regcomp_parse == '{') {
2400                     e = strchr(PL_regcomp_parse++, '}');
2401                     if (!e)
2402                         FAIL("Missing right brace on \\x{}");
2403                     value = scan_hex(PL_regcomp_parse + 1, e - PL_regcomp_parse, &numlen);
2404                     PL_regcomp_parse = e + 1;
2405                 }
2406                 else {
2407                     value = scan_hex(PL_regcomp_parse, 2, &numlen);
2408                     PL_regcomp_parse += numlen;
2409                 }
2410                 break;
2411             case 'c':
2412                 value = UCHARAT(PL_regcomp_parse++);
2413                 value = toCTRL(value);
2414                 break;
2415             case '0': case '1': case '2': case '3': case '4':
2416             case '5': case '6': case '7': case '8': case '9':
2417                 value = scan_oct(--PL_regcomp_parse, 3, &numlen);
2418                 PL_regcomp_parse += numlen;
2419                 break;
2420             }
2421         }
2422         if (range) {
2423             if (lastvalue > value)
2424                 FAIL("invalid [] range in regexp");
2425             if (!SIZE_ONLY)
2426                 sv_catpvf(listsv, "%04x\t%04x\n", lastvalue, value);
2427             lastvalue = value;
2428             range = 0;
2429         }
2430         else {
2431             lastvalue = value;
2432             if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
2433               PL_regcomp_parse[1] != ']') {
2434                 PL_regcomp_parse++;
2435                 range = 1;
2436                 continue;       /* do it next time */
2437             }
2438             if (!SIZE_ONLY)
2439                 sv_catpvf(listsv, "%04x\n", value);
2440         }
2441     }
2442     if (*PL_regcomp_parse != ']')
2443         FAIL("unmatched [] in regexp");
2444     nextchar();
2445
2446     ret = reganode(ANYOFUTF8, 0);
2447
2448     if (!SIZE_ONLY) {
2449         SV *rv = swash_init("utf8", "", listsv, 1, 0);
2450         SvREFCNT_dec(listsv);
2451         n = add_data(1,"s");
2452         PL_regcomp_rx->data->data[n] = (void*)rv;
2453         ARG1_SET(ret, flags);
2454         ARG2_SET(ret, n);
2455     }
2456
2457     return ret;
2458 }
2459
2460 STATIC char*
2461 nextchar(void)
2462 {
2463     dTHR;
2464     char* retval = PL_regcomp_parse++;
2465
2466     for (;;) {
2467         if (*PL_regcomp_parse == '(' && PL_regcomp_parse[1] == '?' &&
2468                 PL_regcomp_parse[2] == '#') {
2469             while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
2470                 PL_regcomp_parse++;
2471             PL_regcomp_parse++;
2472             continue;
2473         }
2474         if (PL_regflags & PMf_EXTENDED) {
2475             if (isSPACE(*PL_regcomp_parse)) {
2476                 PL_regcomp_parse++;
2477                 continue;
2478             }
2479             else if (*PL_regcomp_parse == '#') {
2480                 while (*PL_regcomp_parse && *PL_regcomp_parse != '\n')
2481                     PL_regcomp_parse++;
2482                 PL_regcomp_parse++;
2483                 continue;
2484             }
2485         }
2486         return retval;
2487     }
2488 }
2489
2490 /*
2491 - reg_node - emit a node
2492 */
2493 STATIC regnode *                        /* Location. */
2494 reg_node(U8 op)
2495 {
2496     dTHR;
2497     register regnode *ret;
2498     register regnode *ptr;
2499
2500     ret = PL_regcode;
2501     if (SIZE_ONLY) {
2502         SIZE_ALIGN(PL_regsize);
2503         PL_regsize += 1;
2504         return(ret);
2505     }
2506
2507     NODE_ALIGN_FILL(ret);
2508     ptr = ret;
2509     FILL_ADVANCE_NODE(ptr, op);
2510     PL_regcode = ptr;
2511
2512     return(ret);
2513 }
2514
2515 /*
2516 - reganode - emit a node with an argument
2517 */
2518 STATIC regnode *                        /* Location. */
2519 reganode(U8 op, U32 arg)
2520 {
2521     dTHR;
2522     register regnode *ret;
2523     register regnode *ptr;
2524
2525     ret = PL_regcode;
2526     if (SIZE_ONLY) {
2527         SIZE_ALIGN(PL_regsize);
2528         PL_regsize += 2;
2529         return(ret);
2530     }
2531
2532     NODE_ALIGN_FILL(ret);
2533     ptr = ret;
2534     FILL_ADVANCE_NODE_ARG(ptr, op, arg);
2535     PL_regcode = ptr;
2536
2537     return(ret);
2538 }
2539
2540 /*
2541 - regc - emit (if appropriate) a Unicode character
2542 */
2543 STATIC void
2544 reguni(UV uv, char* s, I32* lenp)
2545 {
2546     if (SIZE_ONLY) {
2547         char tmpbuf[10];
2548         *lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf;
2549     }
2550     else
2551         *lenp = uv_to_utf8(s, uv) - s;
2552
2553 }
2554
2555 /*
2556 - regc - emit (if appropriate) a byte of code
2557 */
2558 STATIC void
2559 regc(U8 b, char* s)
2560 {
2561     dTHR;
2562     if (!SIZE_ONLY)
2563         *s = b;
2564 }
2565
2566 /*
2567 - reginsert - insert an operator in front of already-emitted operand
2568 *
2569 * Means relocating the operand.
2570 */
2571 STATIC void
2572 reginsert(U8 op, regnode *opnd)
2573 {
2574     dTHR;
2575     register regnode *src;
2576     register regnode *dst;
2577     register regnode *place;
2578     register int offset = regarglen[(U8)op];
2579
2580 /* (regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
2581
2582     if (SIZE_ONLY) {
2583         PL_regsize += NODE_STEP_REGNODE + offset;
2584         return;
2585     }
2586
2587     src = PL_regcode;
2588     PL_regcode += NODE_STEP_REGNODE + offset;
2589     dst = PL_regcode;
2590     while (src > opnd)
2591         StructCopy(--src, --dst, regnode);
2592
2593     place = opnd;               /* Op node, where operand used to be. */
2594     src = NEXTOPER(place);
2595     FILL_ADVANCE_NODE(place, op);
2596     Zero(src, offset, regnode);
2597 }
2598
2599 /*
2600 - regtail - set the next-pointer at the end of a node chain of p to val.
2601 */
2602 STATIC void
2603 regtail(regnode *p, regnode *val)
2604 {
2605     dTHR;
2606     register regnode *scan;
2607     register regnode *temp;
2608     register I32 offset;
2609
2610     if (SIZE_ONLY)
2611         return;
2612
2613     /* Find last node. */
2614     scan = p;
2615     for (;;) {
2616         temp = regnext(scan);
2617         if (temp == NULL)
2618             break;
2619         scan = temp;
2620     }
2621
2622     if (reg_off_by_arg[OP(scan)]) {
2623         ARG_SET(scan, val - scan);
2624     }
2625     else {
2626         NEXT_OFF(scan) = val - scan;
2627     }
2628 }
2629
2630 /*
2631 - regoptail - regtail on operand of first argument; nop if operandless
2632 */
2633 STATIC void
2634 regoptail(regnode *p, regnode *val)
2635 {
2636     dTHR;
2637     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
2638     if (p == NULL || SIZE_ONLY)
2639         return;
2640     if (regkind[(U8)OP(p)] == BRANCH) {
2641         regtail(NEXTOPER(p), val);
2642     }
2643     else if ( regkind[(U8)OP(p)] == BRANCHJ) {
2644         regtail(NEXTOPER(NEXTOPER(p)), val);
2645     }
2646     else
2647         return;
2648 }
2649
2650 /*
2651  - regcurly - a little FSA that accepts {\d+,?\d*}
2652  */
2653 STATIC I32
2654 regcurly(register char *s)
2655 {
2656     if (*s++ != '{')
2657         return FALSE;
2658     if (!isDIGIT(*s))
2659         return FALSE;
2660     while (isDIGIT(*s))
2661         s++;
2662     if (*s == ',')
2663         s++;
2664     while (isDIGIT(*s))
2665         s++;
2666     if (*s != '}')
2667         return FALSE;
2668     return TRUE;
2669 }
2670
2671
2672 STATIC regnode *
2673 dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
2674 {
2675 #ifdef DEBUGGING
2676     register char op = EXACT;   /* Arbitrary non-END op. */
2677     register regnode *next, *onode;
2678
2679     while (op != END && (!last || node < last)) {
2680         /* While that wasn't END last time... */
2681
2682         NODE_ALIGN(node);
2683         op = OP(node);
2684         if (op == CLOSE)
2685             l--;
2686         next = regnext(node);
2687         /* Where, what. */
2688         if (OP(node) == OPTIMIZED)
2689             goto after_print;
2690         regprop(sv, node);
2691         PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start,
2692                       2*l + 1, "", SvPVX(sv));
2693         if (next == NULL)               /* Next ptr. */
2694             PerlIO_printf(Perl_debug_log, "(0)");
2695         else
2696             PerlIO_printf(Perl_debug_log, "(%d)", next - start);
2697         (void)PerlIO_putc(Perl_debug_log, '\n');
2698       after_print:
2699         if (regkind[(U8)op] == BRANCHJ) {
2700             register regnode *nnode = (OP(next) == LONGJMP
2701                                        ? regnext(next)
2702                                        : next);
2703             if (last && nnode > last)
2704                 nnode = last;
2705             node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
2706         }
2707         else if (regkind[(U8)op] == BRANCH) {
2708             node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
2709         }
2710         else if ( op == CURLY) {   /* `next' might be very big: optimizer */
2711             node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
2712                              NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
2713         }
2714         else if (regkind[(U8)op] == CURLY && op != CURLYX) {
2715             node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
2716                              next, sv, l + 1);
2717         }
2718         else if ( op == PLUS || op == STAR) {
2719             node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
2720         }
2721         else if (op == ANYOF) {
2722             node = NEXTOPER(node);
2723             node += ANY_SKIP;
2724         }
2725         else if (regkind[(U8)op] == EXACT) {
2726             /* Literal string, where present. */
2727             node += ((*OPERAND(node)) + 2 + sizeof(regnode) - 1) / sizeof(regnode);
2728             node = NEXTOPER(node);
2729         }
2730         else {
2731             node = NEXTOPER(node);
2732             node += regarglen[(U8)op];
2733         }
2734         if (op == CURLYX || op == OPEN)
2735             l++;
2736         else if (op == WHILEM)
2737             l--;
2738     }
2739 #endif  /* DEBUGGING */
2740     return node;
2741 }
2742
2743 /*
2744  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
2745  */
2746 void
2747 regdump(regexp *r)
2748 {
2749 #ifdef DEBUGGING
2750     dTHR;
2751     SV *sv = sv_newmortal();
2752
2753     (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
2754
2755     /* Header fields of interest. */
2756     if (r->anchored_substr)
2757         PerlIO_printf(Perl_debug_log, "anchored `%s%s%s'%s at %d ",
2758                       PL_colors[0],
2759                       SvPVX(r->anchored_substr),
2760                       PL_colors[1],
2761                       SvTAIL(r->anchored_substr) ? "$" : "",
2762                       r->anchored_offset);
2763     if (r->float_substr)
2764         PerlIO_printf(Perl_debug_log, "floating `%s%s%s'%s at %d..%u ",
2765                       PL_colors[0],
2766                       SvPVX(r->float_substr),
2767                       PL_colors[1],
2768                       SvTAIL(r->float_substr) ? "$" : "",
2769                       r->float_min_offset, r->float_max_offset);
2770     if (r->check_substr)
2771         PerlIO_printf(Perl_debug_log,
2772                       r->check_substr == r->float_substr
2773                       ? "(checking floating" : "(checking anchored");
2774     if (r->reganch & ROPT_NOSCAN)
2775         PerlIO_printf(Perl_debug_log, " noscan");
2776     if (r->reganch & ROPT_CHECK_ALL)
2777         PerlIO_printf(Perl_debug_log, " isall");
2778     if (r->check_substr)
2779         PerlIO_printf(Perl_debug_log, ") ");
2780
2781     if (r->regstclass) {
2782         regprop(sv, r->regstclass);
2783         PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
2784     }
2785     if (r->reganch & ROPT_ANCH) {
2786         PerlIO_printf(Perl_debug_log, "anchored");
2787         if (r->reganch & ROPT_ANCH_BOL)
2788             PerlIO_printf(Perl_debug_log, "(BOL)");
2789         if (r->reganch & ROPT_ANCH_MBOL)
2790             PerlIO_printf(Perl_debug_log, "(MBOL)");
2791         if (r->reganch & ROPT_ANCH_GPOS)
2792             PerlIO_printf(Perl_debug_log, "(GPOS)");
2793         PerlIO_putc(Perl_debug_log, ' ');
2794     }
2795     if (r->reganch & ROPT_GPOS_SEEN)
2796         PerlIO_printf(Perl_debug_log, "GPOS ");
2797     if (r->reganch & ROPT_SKIP)
2798         PerlIO_printf(Perl_debug_log, "plus ");
2799     if (r->reganch & ROPT_IMPLICIT)
2800         PerlIO_printf(Perl_debug_log, "implicit ");
2801     PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
2802     if (r->reganch & ROPT_EVAL_SEEN)
2803         PerlIO_printf(Perl_debug_log, "with eval ");
2804     PerlIO_printf(Perl_debug_log, "\n");
2805 #endif  /* DEBUGGING */
2806 }
2807
2808 /*
2809 - regprop - printable representation of opcode
2810 */
2811 void
2812 regprop(SV *sv, regnode *o)
2813 {
2814 #ifdef DEBUGGING
2815     dTHR;
2816     register char *p = 0;
2817
2818     sv_setpvn(sv, "", 0);
2819     switch (OP(o)) {
2820     case BOL:
2821         p = "BOL";
2822         break;
2823     case MBOL:
2824         p = "MBOL";
2825         break;
2826     case SBOL:
2827         p = "SBOL";
2828         break;
2829     case EOL:
2830         p = "EOL";
2831         break;
2832     case EOS:
2833         p = "EOS";
2834         break;
2835     case MEOL:
2836         p = "MEOL";
2837         break;
2838     case SEOL:
2839         p = "SEOL";
2840         break;
2841     case ANY:
2842         p = "ANY";
2843         break;
2844     case SANY:
2845         p = "SANY";
2846         break;
2847     case ANYUTF8:
2848         p = "ANYUTF8";
2849         break;
2850     case SANYUTF8:
2851         p = "SANYUTF8";
2852         break;
2853     case ANYOFUTF8:
2854         p = "ANYOFUTF8";
2855         break;
2856     case ANYOF:
2857         p = "ANYOF";
2858         break;
2859     case BRANCH:
2860         p = "BRANCH";
2861         break;
2862     case EXACT:
2863         sv_catpvf(sv, "EXACT <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
2864         break;
2865     case EXACTF:
2866         sv_catpvf(sv, "EXACTF <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
2867         break;
2868     case EXACTFL:
2869         sv_catpvf(sv, "EXACTFL <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
2870         break;
2871     case NOTHING:
2872         p = "NOTHING";
2873         break;
2874     case TAIL:
2875         p = "TAIL";
2876         break;
2877     case BACK:
2878         p = "BACK";
2879         break;
2880     case END:
2881         p = "END";
2882         break;
2883     case BOUND:
2884         p = "BOUND";
2885         break;
2886     case BOUNDL:
2887         p = "BOUNDL";
2888         break;
2889     case NBOUND:
2890         p = "NBOUND";
2891         break;
2892     case NBOUNDL:
2893         p = "NBOUNDL";
2894         break;
2895     case CURLY:
2896         sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
2897         break;
2898     case CURLYM:
2899         sv_catpvf(sv, "CURLYM[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
2900         break;
2901     case CURLYN:
2902         sv_catpvf(sv, "CURLYN[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
2903         break;
2904     case CURLYX:
2905         sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
2906         break;
2907     case REF:
2908         sv_catpvf(sv, "REF%d", ARG(o));
2909         break;
2910     case REFF:
2911         sv_catpvf(sv, "REFF%d", ARG(o));
2912         break;
2913     case REFFL:
2914         sv_catpvf(sv, "REFFL%d", ARG(o));
2915         break;
2916     case OPEN:
2917         sv_catpvf(sv, "OPEN%d", ARG(o));
2918         break;
2919     case CLOSE:
2920         sv_catpvf(sv, "CLOSE%d", ARG(o));
2921         p = NULL;
2922         break;
2923     case STAR:
2924         p = "STAR";
2925         break;
2926     case PLUS:
2927         p = "PLUS";
2928         break;
2929     case MINMOD:
2930         p = "MINMOD";
2931         break;
2932     case GPOS:
2933         p = "GPOS";
2934         break;
2935     case UNLESSM:
2936         sv_catpvf(sv, "UNLESSM[-%d]", o->flags);
2937         break;
2938     case IFMATCH:
2939         sv_catpvf(sv, "IFMATCH[-%d]", o->flags);
2940         break;
2941     case SUCCEED:
2942         p = "SUCCEED";
2943         break;
2944     case WHILEM:
2945         p = "WHILEM";
2946         break;
2947     case DIGIT:
2948         p = "DIGIT";
2949         break;
2950     case NDIGIT:
2951         p = "NDIGIT";
2952         break;
2953     case ALNUM:
2954         p = "ALNUM";
2955         break;
2956     case NALNUM:
2957         p = "NALNUM";
2958         break;
2959     case SPACE:
2960         p = "SPACE";
2961         break;
2962     case NSPACE:
2963         p = "NSPACE";
2964         break;
2965     case ALNUML:
2966         p = "ALNUML";
2967         break;
2968     case NALNUML:
2969         p = "NALNUML";
2970         break;
2971     case SPACEL:
2972         p = "SPACEL";
2973         break;
2974     case NSPACEL:
2975         p = "NSPACEL";
2976         break;
2977     case EVAL:
2978         p = "EVAL";
2979         break;
2980     case LONGJMP:
2981         p = "LONGJMP";
2982         break;
2983     case BRANCHJ:
2984         p = "BRANCHJ";
2985         break;
2986     case IFTHEN:
2987         p = "IFTHEN";
2988         break;
2989     case GROUPP:
2990         sv_catpvf(sv, "GROUPP%d", ARG(o));
2991         break;
2992     case LOGICAL:
2993         p = "LOGICAL";
2994         break;
2995     case SUSPEND:
2996         p = "SUSPEND";
2997         break;
2998     case RENUM:
2999         p = "RENUM";
3000         break;
3001     case OPTIMIZED:
3002         p = "OPTIMIZED";
3003         break;
3004     default:
3005         FAIL("corrupted regexp opcode");
3006     }
3007     if (p)
3008         sv_catpv(sv, p);
3009 #endif  /* DEBUGGING */
3010 }
3011
3012 void
3013 pregfree(struct regexp *r)
3014 {
3015     dTHR;
3016     if (!r || (--r->refcnt > 0))
3017         return;
3018     if (r->precomp)
3019         Safefree(r->precomp);
3020     if (r->subbase)
3021         Safefree(r->subbase);
3022     if (r->substrs) {
3023         if (r->anchored_substr)
3024             SvREFCNT_dec(r->anchored_substr);
3025         if (r->float_substr)
3026             SvREFCNT_dec(r->float_substr);
3027         Safefree(r->substrs);
3028     }
3029     if (r->data) {
3030         int n = r->data->count;
3031         while (--n >= 0) {
3032             switch (r->data->what[n]) {
3033             case 's':
3034                 SvREFCNT_dec((SV*)r->data->data[n]);
3035                 break;
3036             case 'o':
3037                 op_free((OP_4tree*)r->data->data[n]);
3038                 break;
3039             case 'n':
3040                 break;
3041             default:
3042                 FAIL2("panic: regfree data code '%c'", r->data->what[n]);
3043             }
3044         }
3045         Safefree(r->data->what);
3046         Safefree(r->data);
3047     }
3048     Safefree(r->startp);
3049     Safefree(r->endp);
3050     Safefree(r);
3051 }
3052
3053 /*
3054  - regnext - dig the "next" pointer out of a node
3055  *
3056  * [Note, when REGALIGN is defined there are two places in regmatch()
3057  * that bypass this code for speed.]
3058  */
3059 regnode *
3060 regnext(register regnode *p)
3061 {
3062     dTHR;
3063     register I32 offset;
3064
3065     if (p == &PL_regdummy)
3066         return(NULL);
3067
3068     offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
3069     if (offset == 0)
3070         return(NULL);
3071
3072     return(p+offset);
3073 }
3074
3075 STATIC void
3076 re_croak2(const char* pat1,const char* pat2,...)
3077 {
3078     va_list args;
3079     STRLEN l1 = strlen(pat1);
3080     STRLEN l2 = strlen(pat2);
3081     char buf[512];
3082     char *message;
3083
3084     if (l1 > 510)
3085         l1 = 510;
3086     if (l1 + l2 > 510)
3087         l2 = 510 - l1;
3088     Copy(pat1, buf, l1 , char);
3089     Copy(pat2, buf + l1, l2 , char);
3090     buf[l1 + l2] = '\n';
3091     buf[l1 + l2 + 1] = '\0';
3092     va_start(args, pat2);
3093     message = mess(buf, &args);
3094     va_end(args);
3095     l1 = strlen(message);
3096     if (l1 > 512)
3097         l1 = 512;
3098     Copy(message, buf, l1 , char);
3099     buf[l1] = '\0';                     /* Overwrite \n */
3100     croak("%s", buf);
3101 }
3102
3103 /* XXX Here's a total kludge.  But we need to re-enter for swash routines. */
3104
3105 void
3106 save_re_context(void)
3107 {
3108     SAVEPPTR(PL_bostr);
3109     SAVEPPTR(PL_regprecomp);            /* uncompiled string. */
3110     SAVEI32(PL_regnpar);                /* () count. */
3111     SAVEI32(PL_regsize);                /* Code size. */
3112     SAVEI16(PL_regflags);               /* are we folding, multilining? */
3113     SAVEPPTR(PL_reginput);              /* String-input pointer. */
3114     SAVEPPTR(PL_regbol);                /* Beginning of input, for ^ check. */
3115     SAVEPPTR(PL_regeol);                /* End of input, for $ check. */
3116     SAVESPTR(PL_regstartp);             /* Pointer to startp array. */
3117     SAVESPTR(PL_regendp);               /* Ditto for endp. */
3118     SAVESPTR(PL_reglastparen);          /* Similarly for lastparen. */
3119     SAVEPPTR(PL_regtill);               /* How far we are required to go. */
3120     SAVEI32(PL_regprev);                /* char before regbol, \n if none */
3121     SAVESPTR(PL_reg_start_tmp);         /* from regexec.c */
3122     PL_reg_start_tmp = 0;
3123     SAVEFREEPV(PL_reg_start_tmp);
3124     SAVEI32(PL_reg_start_tmpl);         /* from regexec.c */
3125     PL_reg_start_tmpl = 0;
3126     SAVESPTR(PL_regdata);
3127     SAVEI32(PL_reg_flags);              /* from regexec.c */
3128     SAVEI32(PL_reg_eval_set);           /* from regexec.c */
3129     SAVEI32(PL_regnarrate);             /* from regexec.c */
3130     SAVESPTR(PL_regprogram);            /* from regexec.c */
3131     SAVEINT(PL_regindent);              /* from regexec.c */
3132     SAVESPTR(PL_regcc);                 /* from regexec.c */
3133     SAVESPTR(PL_curcop);
3134     SAVESPTR(PL_regcomp_rx);            /* from regcomp.c */
3135     SAVEI32(PL_regseen);                /* from regcomp.c */
3136     SAVEI32(PL_regsawback);             /* Did we see \1, ...? */
3137     SAVEI32(PL_regnaughty);             /* How bad is this pattern? */
3138     SAVESPTR(PL_regcode);               /* Code-emit pointer; &regdummy = don't */
3139     SAVEPPTR(PL_regxend);               /* End of input for compile */
3140     SAVEPPTR(PL_regcomp_parse);         /* Input-scan pointer. */
3141 }