regcomp.c

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