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