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