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 #  if defined(PERL_EXT_RE_DEBUG) && !defined(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 #  define Perl_pregfree my_regfree
  39 #  define Perl_re_intuit_string my_re_intuit_string
  40 /* *These* symbols are masked to allow static link. */
  41 #  define Perl_regnext my_regnext
  42 #  define Perl_save_re_context my_save_re_context
  43 #  define Perl_reginitcolors my_reginitcolors
  44
  45 #  define PERL_NO_GET_CONTEXT
  46 #endif
  47
  48 /*SUPPRESS 112*/
  49 /*
  50  * pregcomp and pregexec -- regsub and regerror are not used in perl
  51  *
  52  *      Copyright (c) 1986 by University of Toronto.
  53  *      Written by Henry Spencer.  Not derived from licensed software.
  54  *
  55  *      Permission is granted to anyone to use this software for any
  56  *      purpose on any computer system, and to redistribute it freely,
  57  *      subject to the following restrictions:
  58  *
  59  *      1. The author is not responsible for the consequences of use of
  60  *              this software, no matter how awful, even if they arise
  61  *              from defects in it.
  62  *
  63  *      2. The origin of this software must not be misrepresented, either
  64  *              by explicit claim or by omission.
  65  *
  66  *      3. Altered versions must be plainly marked as such, and must not
  67  *              be misrepresented as being the original software.
  68  *
  69  *
  70  ****    Alterations to Henry's code are...
  71  ****
  72  ****    Copyright (c) 1991-2000, Larry Wall
  73  ****
  74  ****    You may distribute under the terms of either the GNU General Public
  75  ****    License or the Artistic License, as specified in the README file.
  76
  77  *
  78  * Beware that some of this code is subtly aware of the way operator
  79  * precedence is structured in regular expressions.  Serious changes in
  80  * regular-expression syntax might require a total rethink.
  81  */
  82 #include "EXTERN.h"
  83 #define PERL_IN_REGCOMP_C
  84 #include "perl.h"
  85
  86 #ifdef PERL_IN_XSUB_RE
  87 #  if defined(PERL_CAPI) || defined(PERL_OBJECT)
  88 #    include "XSUB.h"
  89 #  endif
  90 #else
  91 #  include "INTERN.h"
  92 #endif
  93
  94 #define REG_COMP_C
  95 #include "regcomp.h"
  96
  97 #ifdef op
  98 #undef op
  99 #endif /* op */
 100
 101 #ifdef MSDOS
 102 # if defined(BUGGY_MSC6)
 103  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
 104  # pragma optimize("a",off)
 105  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
 106  # pragma optimize("w",on )
 107 # endif /* BUGGY_MSC6 */
 108 #endif /* MSDOS */
 109
 110 #ifndef STATIC
 111 #define STATIC  static
 112 #endif
 113
 114 typedef struct RExC_state_t {
 115     U16         flags16;                /* are we folding, multilining? */
 116     char        *precomp;               /* uncompiled string. */
 117     regexp      *rx;
 118     char        *end;                   /* End of input for compile */
 119     char        *parse;                 /* Input-scan pointer. */
 120     I32         whilem_seen;            /* number of WHILEM in this expr */
 121     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't */
 122     I32         naughty;                /* How bad is this pattern? */
 123     I32         sawback;                /* Did we see \1, ...? */
 124     U32         seen;
 125     I32         size;                   /* Code size. */
 126     I32         npar;                   /* () count. */
 127     I32         extralen;
 128     I32         seen_zerolen;
 129     I32         seen_evals;
 130 #if ADD_TO_REGEXEC
 131     char        *starttry;              /* -Dr: where regtry was called. */
 132 #define RExC_starttry   (pRExC_state->starttry)
 133 #endif
 134 } RExC_state_t;
 135
 136 #define RExC_flags16    (pRExC_state->flags16)
 137 #define RExC_precomp    (pRExC_state->precomp)
 138 #define RExC_rx         (pRExC_state->rx)
 139 #define RExC_end        (pRExC_state->end)
 140 #define RExC_parse      (pRExC_state->parse)
 141 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
 142 #define RExC_emit       (pRExC_state->emit)
 143 #define RExC_naughty    (pRExC_state->naughty)
 144 #define RExC_sawback    (pRExC_state->sawback)
 145 #define RExC_seen       (pRExC_state->seen)
 146 #define RExC_size       (pRExC_state->size)
 147 #define RExC_npar       (pRExC_state->npar)
 148 #define RExC_extralen   (pRExC_state->extralen)
 149 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
 150 #define RExC_seen_evals (pRExC_state->seen_evals)
 151
 152 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
 153 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
 154         ((*s) == '{' && regcurly(s)))
 155 #ifdef atarist
 156 #define PERL_META       "^$.[()|?+*\\"
 157 #else
 158 #define META    "^$.[()|?+*\\"
 159 #endif
 160
 161 #ifdef SPSTART
 162 #undef SPSTART          /* dratted cpp namespace... */
 163 #endif
 164 /*
 165  * Flags to be passed up and down.
 166  */
 167 #define WORST           0       /* Worst case. */
 168 #define HASWIDTH        0x1     /* Known to match non-null strings. */
 169 #define SIMPLE          0x2     /* Simple enough to be STAR/PLUS operand. */
 170 #define SPSTART         0x4     /* Starts with * or +. */
 171 #define TRYAGAIN        0x8     /* Weeded out a declaration. */
 172
 173 /* Length of a variant. */
 174
 175 typedef struct scan_data_t {
 176     I32 len_min;
 177     I32 len_delta;
 178     I32 pos_min;
 179     I32 pos_delta;
 180     SV *last_found;
 181     I32 last_end;                       /* min value, <0 unless valid. */
 182     I32 last_start_min;
 183     I32 last_start_max;
 184     SV **longest;                       /* Either &l_fixed, or &l_float. */
 185     SV *longest_fixed;
 186     I32 offset_fixed;
 187     SV *longest_float;
 188     I32 offset_float_min;
 189     I32 offset_float_max;
 190     I32 flags;
 191     I32 whilem_c;
 192     I32 *last_closep;
 193     struct regnode_charclass_class *start_class;
 194 } scan_data_t;
 195
 196 /*
 197  * Forward declarations for pregcomp()'s friends.
 198  */
 199
 200 static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 201                                       0, 0, 0, 0, 0, 0};
 202
 203 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
 204 #define SF_BEFORE_SEOL          0x1
 205 #define SF_BEFORE_MEOL          0x2
 206 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
 207 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
 208
 209 #ifdef NO_UNARY_PLUS
 210 #  define SF_FIX_SHIFT_EOL      (0+2)
 211 #  define SF_FL_SHIFT_EOL               (0+4)
 212 #else
 213 #  define SF_FIX_SHIFT_EOL      (+2)
 214 #  define SF_FL_SHIFT_EOL               (+4)
 215 #endif
 216
 217 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
 218 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
 219
 220 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
 221 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
 222 #define SF_IS_INF               0x40
 223 #define SF_HAS_PAR              0x80
 224 #define SF_IN_PAR               0x100
 225 #define SF_HAS_EVAL             0x200
 226 #define SCF_DO_SUBSTR           0x400
 227 #define SCF_DO_STCLASS_AND      0x0800
 228 #define SCF_DO_STCLASS_OR       0x1000
 229 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
 230
 231 #define RF_utf8         8
 232 #define UTF (PL_reg_flags & RF_utf8)
 233 #define LOC (RExC_flags16 & PMf_LOCALE)
 234 #define FOLD (RExC_flags16 & PMf_FOLD)
 235
 236 #define OOB_CHAR8               1234
 237 #define OOB_UTF8                123456
 238 #define OOB_NAMEDCLASS          -1
 239
 240 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 241 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 242
 243
 244 /* length of regex to show in messages that don't mark a position within */
 245 #define RegexLengthToShowInErrorMessages 127
 246
 247 /*
 248  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
 249  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
 250  * op/pragma/warn/regcomp.
 251  */
 252 #define MARKER1 "HERE"      /* marker as it appears in the description */
 253 #define MARKER2 " << HERE "  /* marker as it appears within the regex */
 254
 255 #define REPORT_LOCATION " before " MARKER1 " mark in regex m/%.*s" MARKER2 "%s/"
 256
 257 /*
 258  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
 259  * arg. Show regex, up to a maximum length. If it's too long, chop and add
 260  * "...".
 261  */
 262 #define FAIL(msg)                                                             \
 263     STMT_START {                                                             \
 264         char *ellipses = "";                                                 \
 265         unsigned len = strlen(RExC_precomp);                                \
 266                                                                              \
 267         if (!SIZE_ONLY)                                                      \
 268             SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
 269                                                                              \
 270         if (len > RegexLengthToShowInErrorMessages) {                        \
 271             /* chop 10 shorter than the max, to ensure meaning of "..." */   \
 272             len = RegexLengthToShowInErrorMessages - 10;                     \
 273             ellipses = "...";                                                \
 274         }                                                                    \
 275         Perl_croak(aTHX_ "%s in regex m/%.*s%s/",                            \
 276                    msg, (int)len, RExC_precomp, ellipses);                  \
 277     } STMT_END
 278
 279 /*
 280  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
 281  * args. Show regex, up to a maximum length. If it's too long, chop and add
 282  * "...".
 283  */
 284 #define FAIL2(pat,msg)                                                        \
 285     STMT_START {                                                             \
 286         char *ellipses = "";                                                 \
 287         unsigned len = strlen(RExC_precomp);                                \
 288                                                                              \
 289         if (!SIZE_ONLY)                                                      \
 290             SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
 291                                                                              \
 292         if (len > RegexLengthToShowInErrorMessages) {                        \
 293             /* chop 10 shorter than the max, to ensure meaning of "..." */   \
 294             len = RegexLengthToShowInErrorMessages - 10;                     \
 295             ellipses = "...";                                                \
 296         }                                                                    \
 297         S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/",                        \
 298                     msg, (int)len, RExC_precomp, ellipses);                \
 299     } STMT_END
 300
 301
 302 /*
 303  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
 304  */
 305 #define Simple_vFAIL(m)                                                      \
 306     STMT_START {                                                             \
 307       unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
 308                                                                              \
 309       Perl_croak(aTHX_ "%s" REPORT_LOCATION,               \
 310                  m, (int)offset, RExC_precomp, RExC_precomp + offset);     \
 311     } STMT_END
 312
 313 /*
 314  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
 315  */
 316 #define vFAIL(m)                                                             \
 317     STMT_START {                                                             \
 318       if (!SIZE_ONLY)                                                        \
 319             SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
 320       Simple_vFAIL(m);                                                       \
 321     } STMT_END
 322
 323 /*
 324  * Like Simple_vFAIL(), but accepts two arguments.
 325  */
 326 #define Simple_vFAIL2(m,a1)                                                  \
 327     STMT_START {                                                             \
 328       unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
 329                                                                              \
 330       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,       \
 331                   (int)offset, RExC_precomp, RExC_precomp + offset);       \
 332     } STMT_END
 333
 334 /*
 335  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
 336  */
 337 #define vFAIL2(m,a1)                                                         \
 338     STMT_START {                                                             \
 339       if (!SIZE_ONLY)                                                        \
 340             SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
 341       Simple_vFAIL2(m, a1);                                                  \
 342     } STMT_END
 343
 344
 345 /*
 346  * Like Simple_vFAIL(), but accepts three arguments.
 347  */
 348 #define Simple_vFAIL3(m, a1, a2)                                             \
 349     STMT_START {                                                             \
 350       unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
 351                                                                              \
 352       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,   \
 353                   (int)offset, RExC_precomp, RExC_precomp + offset);       \
 354     } STMT_END
 355
 356 /*
 357  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
 358  */
 359 #define vFAIL3(m,a1,a2)                                                      \
 360     STMT_START {                                                             \
 361       if (!SIZE_ONLY)                                                        \
 362             SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
 363       Simple_vFAIL3(m, a1, a2);                                              \
 364     } STMT_END
 365
 366 /*
 367  * Like Simple_vFAIL(), but accepts four arguments.
 368  */
 369 #define Simple_vFAIL4(m, a1, a2, a3)                                         \
 370     STMT_START {                                                             \
 371       unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
 372                                                                              \
 373       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,\
 374                   (int)offset, RExC_precomp, RExC_precomp + offset);       \
 375     } STMT_END
 376
 377 /*
 378  * Like Simple_vFAIL(), but accepts five arguments.
 379  */
 380 #define Simple_vFAIL5(m, a1, a2, a3, a4)                                     \
 381     STMT_START {                                                             \
 382       unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
 383       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4,\
 384                   (int)offset, RExC_precomp, RExC_precomp + offset);       \
 385     } STMT_END
 386
 387
 388 #define vWARN(loc,m)                                                         \
 389     STMT_START {                                                             \
 390         unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
 391         Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\
 392                  m, (int)offset, RExC_precomp, RExC_precomp + offset);          \
 393     } STMT_END                                                               \
 394
 395
 396 #define vWARN2(loc, m, a1)                                                   \
 397     STMT_START {                                                             \
 398         unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
 399         Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
 400                  a1,                                                         \
 401                  (int)offset, RExC_precomp, RExC_precomp + offset);        \
 402     } STMT_END
 403
 404 #define vWARN3(loc, m, a1, a2)                                               \
 405     STMT_START {                                                             \
 406       unsigned offset = strlen(RExC_precomp) - (RExC_end - (loc));        \
 407         Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,                    \
 408                  a1, a2,                                                     \
 409                  (int)offset, RExC_precomp, RExC_precomp + offset);        \
 410     } STMT_END
 411
 412 #define vWARN4(loc, m, a1, a2, a3)                                           \
 413     STMT_START {                                                             \
 414       unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));            \
 415         Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
 416                  a1, a2, a3,                                                 \
 417                  (int)offset, RExC_precomp, RExC_precomp + offset);        \
 418     } STMT_END
 419
 420
 421 /* Allow for side effects in s */
 422 #define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (s);} STMT_END
 423
 424 static void clear_re(pTHXo_ void *r);
 425
 426 /* Mark that we cannot extend a found fixed substring at this point.
 427    Updata the longest found anchored substring and the longest found
 428    floating substrings if needed. */
 429
 430 STATIC void
 431 S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
 432 {
 433     dTHR;
 434     STRLEN l = CHR_SVLEN(data->last_found);
 435     STRLEN old_l = CHR_SVLEN(*data->longest);
 436
 437     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
 438         sv_setsv(*data->longest, data->last_found);
 439         if (*data->longest == data->longest_fixed) {
 440             data->offset_fixed = l ? data->last_start_min : data->pos_min;
 441             if (data->flags & SF_BEFORE_EOL)
 442                 data->flags
 443                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
 444             else
 445                 data->flags &= ~SF_FIX_BEFORE_EOL;
 446         }
 447         else {
 448             data->offset_float_min = l ? data->last_start_min : data->pos_min;
 449             data->offset_float_max = (l
 450                                       ? data->last_start_max
 451                                       : data->pos_min + data->pos_delta);
 452             if (data->flags & SF_BEFORE_EOL)
 453                 data->flags
 454                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
 455             else
 456                 data->flags &= ~SF_FL_BEFORE_EOL;
 457         }
 458     }
 459     SvCUR_set(data->last_found, 0);
 460     data->last_end = -1;
 461     data->flags &= ~SF_BEFORE_EOL;
 462 }
 463
 464 /* Can match anything (initialization) */
 465 STATIC void
 466 S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
 467 {
 468     int value;
 469
 470     ANYOF_CLASS_ZERO(cl);
 471     for (value = 0; value < 256; ++value)
 472         ANYOF_BITMAP_SET(cl, value);
 473     cl->flags = ANYOF_EOS;
 474     if (LOC)
 475         cl->flags |= ANYOF_LOCALE;
 476 }
 477
 478 /* Can match anything (initialization) */
 479 STATIC int
 480 S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
 481 {
 482     int value;
 483
 484     for (value = 0; value <= ANYOF_MAX; value += 2)
 485         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
 486             return 1;
 487     for (value = 0; value < 256; ++value)
 488         if (!ANYOF_BITMAP_TEST(cl, value))
 489             return 0;
 490     return 1;
 491 }
 492
 493 /* Can match anything (initialization) */
 494 STATIC void
 495 S_cl_init(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
 496 {
 497     Zero(cl, 1, struct regnode_charclass_class);
 498     cl->type = ANYOF;
 499     cl_anything(pRExC_state, cl);
 500 }
 501
 502 STATIC void
 503 S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
 504 {
 505     Zero(cl, 1, struct regnode_charclass_class);
 506     cl->type = ANYOF;
 507     cl_anything(pRExC_state, cl);
 508     if (LOC)
 509         cl->flags |= ANYOF_LOCALE;
 510 }
 511
 512 /* 'And' a given class with another one.  Can create false positives */
 513 /* We assume that cl is not inverted */
 514 STATIC void
 515 S_cl_and(pTHX_ struct regnode_charclass_class *cl,
 516          struct regnode_charclass_class *and_with)
 517 {
 518     if (!(and_with->flags & ANYOF_CLASS)
 519         && !(cl->flags & ANYOF_CLASS)
 520         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
 521         && !(and_with->flags & ANYOF_FOLD)
 522         && !(cl->flags & ANYOF_FOLD)) {
 523         int i;
 524
 525         if (and_with->flags & ANYOF_INVERT)
 526             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
 527                 cl->bitmap[i] &= ~and_with->bitmap[i];
 528         else
 529             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
 530                 cl->bitmap[i] &= and_with->bitmap[i];
 531     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
 532     if (!(and_with->flags & ANYOF_EOS))
 533         cl->flags &= ~ANYOF_EOS;
 534 }
 535
 536 /* 'OR' a given class with another one.  Can create false positives */
 537 /* We assume that cl is not inverted */
 538 STATIC void
 539 S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with)
 540 {
 541     if (or_with->flags & ANYOF_INVERT) {
 542         /* We do not use
 543          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
 544          *   <= (B1 | !B2) | (CL1 | !CL2)
 545          * which is wasteful if CL2 is small, but we ignore CL2:
 546          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
 547          * XXXX Can we handle case-fold?  Unclear:
 548          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
 549          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
 550          */
 551         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
 552              && !(or_with->flags & ANYOF_FOLD)
 553              && !(cl->flags & ANYOF_FOLD) ) {
 554             int i;
 555
 556             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
 557                 cl->bitmap[i] |= ~or_with->bitmap[i];
 558         } /* XXXX: logic is complicated otherwise */
 559         else {
 560             cl_anything(pRExC_state, cl);
 561         }
 562     } else {
 563         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
 564         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
 565              && (!(or_with->flags & ANYOF_FOLD)
 566                  || (cl->flags & ANYOF_FOLD)) ) {
 567             int i;
 568
 569             /* OR char bitmap and class bitmap separately */
 570             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
 571                 cl->bitmap[i] |= or_with->bitmap[i];
 572             if (or_with->flags & ANYOF_CLASS) {
 573                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
 574                     cl->classflags[i] |= or_with->classflags[i];
 575                 cl->flags |= ANYOF_CLASS;
 576             }
 577         }
 578         else { /* XXXX: logic is complicated, leave it along for a moment. */
 579             cl_anything(pRExC_state, cl);
 580         }
 581     }
 582     if (or_with->flags & ANYOF_EOS)
 583         cl->flags |= ANYOF_EOS;
 584 }
 585
 586 /* REx optimizer.  Converts nodes into quickier variants "in place".
 587    Finds fixed substrings.  */
 588
 589 /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
 590    to the position after last scanned or to NULL. */
 591
 592 STATIC I32
 593 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
 594                         /* scanp: Start here (read-write). */
 595                         /* deltap: Write maxlen-minlen here. */
 596                         /* last: Stop before this one. */
 597 {
 598     dTHR;
 599     I32 min = 0, pars = 0, code;
 600     regnode *scan = *scanp, *next;
 601     I32 delta = 0;
 602     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
 603     int is_inf_internal = 0;            /* The studied chunk is infinite */
 604     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
 605     scan_data_t data_fake;
 606     struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
 607
 608     while (scan && OP(scan) != END && scan < last) {
 609         /* Peephole optimizer: */
 610
 611         if (PL_regkind[(U8)OP(scan)] == EXACT) {
 612             /* Merge several consecutive EXACTish nodes into one. */
 613             regnode *n = regnext(scan);
 614             U32 stringok = 1;
 615 #ifdef DEBUGGING
 616             regnode *stop = scan;
 617 #endif
 618
 619             next = scan + NODE_SZ_STR(scan);
 620             /* Skip NOTHING, merge EXACT*. */
 621             while (n &&
 622                    ( PL_regkind[(U8)OP(n)] == NOTHING ||
 623                      (stringok && (OP(n) == OP(scan))))
 624                    && NEXT_OFF(n)
 625                    && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
 626                 if (OP(n) == TAIL || n > next)
 627                     stringok = 0;
 628                 if (PL_regkind[(U8)OP(n)] == NOTHING) {
 629                     NEXT_OFF(scan) += NEXT_OFF(n);
 630                     next = n + NODE_STEP_REGNODE;
 631 #ifdef DEBUGGING
 632                     if (stringok)
 633                         stop = n;
 634 #endif
 635                     n = regnext(n);
 636                 }
 637                 else {
 638                     int oldl = STR_LEN(scan);
 639                     regnode *nnext = regnext(n);
 640
 641                     if (oldl + STR_LEN(n) > U8_MAX)
 642                         break;
 643                     NEXT_OFF(scan) += NEXT_OFF(n);
 644                     STR_LEN(scan) += STR_LEN(n);
 645                     next = n + NODE_SZ_STR(n);
 646                     /* Now we can overwrite *n : */
 647                     Move(STRING(n), STRING(scan) + oldl,
 648                          STR_LEN(n), char);
 649 #ifdef DEBUGGING
 650                     if (stringok)
 651                         stop = next - 1;
 652 #endif
 653                     n = nnext;
 654                 }
 655             }
 656 #ifdef DEBUGGING
 657             /* Allow dumping */
 658             n = scan + NODE_SZ_STR(scan);
 659             while (n <= stop) {
 660                 if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
 661                     OP(n) = OPTIMIZED;
 662                     NEXT_OFF(n) = 0;
 663                 }
 664                 n++;
 665             }
 666 #endif
 667         }
 668         /* Follow the next-chain of the current node and optimize
 669            away all the NOTHINGs from it.  */
 670         if (OP(scan) != CURLYX) {
 671             int max = (reg_off_by_arg[OP(scan)]
 672                        ? I32_MAX
 673                        /* I32 may be smaller than U16 on CRAYs! */
 674                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
 675             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
 676             int noff;
 677             regnode *n = scan;
 678
 679             /* Skip NOTHING and LONGJMP. */
 680             while ((n = regnext(n))
 681                    && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
 682                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
 683                    && off + noff < max)
 684                 off += noff;
 685             if (reg_off_by_arg[OP(scan)])
 686                 ARG(scan) = off;
 687             else
 688                 NEXT_OFF(scan) = off;
 689         }
 690         /* The principal pseudo-switch.  Cannot be a switch, since we
 691            look into several different things.  */
 692         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
 693                    || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
 694             next = regnext(scan);
 695             code = OP(scan);
 696
 697             if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
 698                 I32 max1 = 0, min1 = I32_MAX, num = 0;
 699                 struct regnode_charclass_class accum;
 700
 701                 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
 702                     scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
 703                 if (flags & SCF_DO_STCLASS)
 704                     cl_init_zero(pRExC_state, &accum);
 705                 while (OP(scan) == code) {
 706                     I32 deltanext, minnext, f = 0, fake;
 707                     struct regnode_charclass_class this_class;
 708
 709                     num++;
 710                     data_fake.flags = 0;
 711                     if (data) {
 712                         data_fake.whilem_c = data->whilem_c;
 713                         data_fake.last_closep = data->last_closep;
 714                     }
 715                     else
 716                         data_fake.last_closep = &fake;
 717                     next = regnext(scan);
 718                     scan = NEXTOPER(scan);
 719                     if (code != BRANCH)
 720                         scan = NEXTOPER(scan);
 721                     if (flags & SCF_DO_STCLASS) {
 722                         cl_init(pRExC_state, &this_class);
 723                         data_fake.start_class = &this_class;
 724                         f = SCF_DO_STCLASS_AND;
 725                     }
 726                     /* we suppose the run is continuous, last=next...*/
 727                     minnext = study_chunk(pRExC_state, &scan, &deltanext,
 728                                           next, &data_fake, f);
 729                     if (min1 > minnext)
 730                         min1 = minnext;
 731                     if (max1 < minnext + deltanext)
 732                         max1 = minnext + deltanext;
 733                     if (deltanext == I32_MAX)
 734                         is_inf = is_inf_internal = 1;
 735                     scan = next;
 736                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
 737                         pars++;
 738                     if (data && (data_fake.flags & SF_HAS_EVAL))
 739                         data->flags |= SF_HAS_EVAL;
 740                     if (data)
 741                         data->whilem_c = data_fake.whilem_c;
 742                     if (flags & SCF_DO_STCLASS)
 743                         cl_or(pRExC_state, &accum, &this_class);
 744                     if (code == SUSPEND)
 745                         break;
 746                 }
 747                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
 748                     min1 = 0;
 749                 if (flags & SCF_DO_SUBSTR) {
 750                     data->pos_min += min1;
 751                     data->pos_delta += max1 - min1;
 752                     if (max1 != min1 || is_inf)
 753                         data->longest = &(data->longest_float);
 754                 }
 755                 min += min1;
 756                 delta += max1 - min1;
 757                 if (flags & SCF_DO_STCLASS_OR) {
 758                     cl_or(pRExC_state, data->start_class, &accum);
 759                     if (min1) {
 760                         cl_and(data->start_class, &and_with);
 761                         flags &= ~SCF_DO_STCLASS;
 762                     }
 763                 }
 764                 else if (flags & SCF_DO_STCLASS_AND) {
 765                     if (min1) {
 766                         cl_and(data->start_class, &accum);
 767                         flags &= ~SCF_DO_STCLASS;
 768                     }
 769                     else {
 770                         /* Switch to OR mode: cache the old value of
 771                          * data->start_class */
 772                         StructCopy(data->start_class, &and_with,
 773                                    struct regnode_charclass_class);
 774                         flags &= ~SCF_DO_STCLASS_AND;
 775                         StructCopy(&accum, data->start_class,
 776                                    struct regnode_charclass_class);
 777                         flags |= SCF_DO_STCLASS_OR;
 778                         data->start_class->flags |= ANYOF_EOS;
 779                     }
 780                 }
 781             }
 782             else if (code == BRANCHJ)   /* single branch is optimized. */
 783                 scan = NEXTOPER(NEXTOPER(scan));
 784             else                        /* single branch is optimized. */
 785                 scan = NEXTOPER(scan);
 786             continue;
 787         }
 788         else if (OP(scan) == EXACT) {
 789             I32 l = STR_LEN(scan);
 790             if (UTF) {
 791                 unsigned char *s = (unsigned char *)STRING(scan);
 792                 unsigned char *e = s + l;
 793                 I32 newl = 0;
 794                 while (s < e) {
 795                     newl++;
 796                     s += UTF8SKIP(s);
 797                 }
 798                 l = newl;
 799             }
 800             min += l;
 801             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
 802                 /* The code below prefers earlier match for fixed
 803                    offset, later match for variable offset.  */
 804                 if (data->last_end == -1) { /* Update the start info. */
 805                     data->last_start_min = data->pos_min;
 806                     data->last_start_max = is_inf
 807                         ? I32_MAX : data->pos_min + data->pos_delta;
 808                 }
 809                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
 810                 data->last_end = data->pos_min + l;
 811                 data->pos_min += l; /* As in the first entry. */
 812                 data->flags &= ~SF_BEFORE_EOL;
 813             }
 814             if (flags & SCF_DO_STCLASS_AND) {
 815                 /* Check whether it is compatible with what we know already! */
 816                 int compat = 1;
 817
 818                 if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
 819                     && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
 820                     && (!(data->start_class->flags & ANYOF_FOLD)
 821                         || !ANYOF_BITMAP_TEST(data->start_class,
 822                                               PL_fold[*(U8*)STRING(scan)])))
 823                     compat = 0;
 824                 ANYOF_CLASS_ZERO(data->start_class);
 825                 ANYOF_BITMAP_ZERO(data->start_class);
 826                 if (compat)
 827                     ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
 828                 data->start_class->flags &= ~ANYOF_EOS;
 829             }
 830             else if (flags & SCF_DO_STCLASS_OR) {
 831                 /* false positive possible if the class is case-folded */
 832                 ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
 833                 data->start_class->flags &= ~ANYOF_EOS;
 834                 cl_and(data->start_class, &and_with);
 835             }
 836             flags &= ~SCF_DO_STCLASS;
 837         }
 838         else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
 839             I32 l = STR_LEN(scan);
 840
 841             /* Search for fixed substrings supports EXACT only. */
 842             if (flags & SCF_DO_SUBSTR)
 843                 scan_commit(pRExC_state, data);
 844             if (UTF) {
 845                 unsigned char *s = (unsigned char *)STRING(scan);
 846                 unsigned char *e = s + l;
 847                 I32 newl = 0;
 848                 while (s < e) {
 849                     newl++;
 850                     s += UTF8SKIP(s);
 851                 }
 852                 l = newl;
 853             }
 854             min += l;
 855             if (data && (flags & SCF_DO_SUBSTR))
 856                 data->pos_min += l;
 857             if (flags & SCF_DO_STCLASS_AND) {
 858                 /* Check whether it is compatible with what we know already! */
 859                 int compat = 1;
 860
 861                 if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
 862                     && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
 863                     && !ANYOF_BITMAP_TEST(data->start_class,
 864                                           PL_fold[*(U8*)STRING(scan)]))
 865                     compat = 0;
 866                 ANYOF_CLASS_ZERO(data->start_class);
 867                 ANYOF_BITMAP_ZERO(data->start_class);
 868                 if (compat) {
 869                     ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
 870                     data->start_class->flags &= ~ANYOF_EOS;
 871                     data->start_class->flags |= ANYOF_FOLD;
 872                     if (OP(scan) == EXACTFL)
 873                         data->start_class->flags |= ANYOF_LOCALE;
 874                 }
 875             }
 876             else if (flags & SCF_DO_STCLASS_OR) {
 877                 if (data->start_class->flags & ANYOF_FOLD) {
 878                     /* false positive possible if the class is case-folded.
 879                        Assume that the locale settings are the same... */
 880                     ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
 881                     data->start_class->flags &= ~ANYOF_EOS;
 882                 }
 883                 cl_and(data->start_class, &and_with);
 884             }
 885             flags &= ~SCF_DO_STCLASS;
 886         }
 887         else if (strchr((char*)PL_varies,OP(scan))) {
 888             I32 mincount, maxcount, minnext, deltanext, fl;
 889             I32 f = flags, pos_before = 0;
 890             regnode *oscan = scan;
 891             struct regnode_charclass_class this_class;
 892             struct regnode_charclass_class *oclass = NULL;
 893
 894             switch (PL_regkind[(U8)OP(scan)]) {
 895             case WHILEM:                /* End of (?:...)* . */
 896                 scan = NEXTOPER(scan);
 897                 goto finish;
 898             case PLUS:
 899                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
 900                     next = NEXTOPER(scan);
 901                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
 902                         mincount = 1;
 903                         maxcount = REG_INFTY;
 904                         next = regnext(scan);
 905                         scan = NEXTOPER(scan);
 906                         goto do_curly;
 907                     }
 908                 }
 909                 if (flags & SCF_DO_SUBSTR)
 910                     data->pos_min++;
 911                 min++;
 912                 /* Fall through. */
 913             case STAR:
 914                 if (flags & SCF_DO_STCLASS) {
 915                     mincount = 0;
 916                     maxcount = REG_INFTY;
 917                     next = regnext(scan);
 918                     scan = NEXTOPER(scan);
 919                     goto do_curly;
 920                 }
 921                 is_inf = is_inf_internal = 1;
 922                 scan = regnext(scan);
 923                 if (flags & SCF_DO_SUBSTR) {
 924                     scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
 925                     data->longest = &(data->longest_float);
 926                 }
 927                 goto optimize_curly_tail;
 928             case CURLY:
 929                 mincount = ARG1(scan);
 930                 maxcount = ARG2(scan);
 931                 next = regnext(scan);
 932                 if (OP(scan) == CURLYX) {
 933                     I32 lp = (data ? *(data->last_closep) : 0);
 934
 935                     scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
 936                 }
 937                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
 938               do_curly:
 939                 if (flags & SCF_DO_SUBSTR) {
 940                     if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
 941                     pos_before = data->pos_min;
 942                 }
 943                 if (data) {
 944                     fl = data->flags;
 945                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
 946                     if (is_inf)
 947                         data->flags |= SF_IS_INF;
 948                 }
 949                 if (flags & SCF_DO_STCLASS) {
 950                     cl_init(pRExC_state, &this_class);
 951                     oclass = data->start_class;
 952                     data->start_class = &this_class;
 953                     f |= SCF_DO_STCLASS_AND;
 954                     f &= ~SCF_DO_STCLASS_OR;
 955                 }
 956
 957                 /* This will finish on WHILEM, setting scan, or on NULL: */
 958                 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
 959                                       mincount == 0
 960                                         ? (f & ~SCF_DO_SUBSTR) : f);
 961
 962                 if (flags & SCF_DO_STCLASS)
 963                     data->start_class = oclass;
 964                 if (mincount == 0 || minnext == 0) {
 965                     if (flags & SCF_DO_STCLASS_OR) {
 966                         cl_or(pRExC_state, data->start_class, &this_class);
 967                     }
 968                     else if (flags & SCF_DO_STCLASS_AND) {
 969                         /* Switch to OR mode: cache the old value of
 970                          * data->start_class */
 971                         StructCopy(data->start_class, &and_with,
 972                                    struct regnode_charclass_class);
 973                         flags &= ~SCF_DO_STCLASS_AND;
 974                         StructCopy(&this_class, data->start_class,
 975                                    struct regnode_charclass_class);
 976                         flags |= SCF_DO_STCLASS_OR;
 977                         data->start_class->flags |= ANYOF_EOS;
 978                     }
 979                 } else {                /* Non-zero len */
 980                     if (flags & SCF_DO_STCLASS_OR) {
 981                         cl_or(pRExC_state, data->start_class, &this_class);
 982                         cl_and(data->start_class, &and_with);
 983                     }
 984                     else if (flags & SCF_DO_STCLASS_AND)
 985                         cl_and(data->start_class, &this_class);
 986                     flags &= ~SCF_DO_STCLASS;
 987                 }
 988                 if (!scan)              /* It was not CURLYX, but CURLY. */
 989                     scan = next;
 990                 if (ckWARN(WARN_REGEXP) && (minnext + deltanext == 0)
 991                     && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
 992                     && maxcount <= REG_INFTY/3) /* Complement check for big count */
 993                 {
 994                     vWARN(RExC_parse,
 995                           "Quantifier unexpected on zero-length expression");
 996                 }
 997
 998                 min += minnext * mincount;
 999                 is_inf_internal |= ((maxcount == REG_INFTY
1000                                      && (minnext + deltanext) > 0)
1001                                     || deltanext == I32_MAX);
1002                 is_inf |= is_inf_internal;
1003                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
1004
1005                 /* Try powerful optimization CURLYX => CURLYN. */
1006                 if (  OP(oscan) == CURLYX && data
1007                       && data->flags & SF_IN_PAR
1008                       && !(data->flags & SF_HAS_EVAL)
1009                       && !deltanext && minnext == 1 ) {
1010                     /* Try to optimize to CURLYN.  */
1011                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
1012                     regnode *nxt1 = nxt, *nxt2;
1013
1014                     /* Skip open. */
1015                     nxt = regnext(nxt);
1016                     if (!strchr((char*)PL_simple,OP(nxt))
1017                         && !(PL_regkind[(U8)OP(nxt)] == EXACT
1018                              && STR_LEN(nxt) == 1))
1019                         goto nogo;
1020                     nxt2 = nxt;
1021                     nxt = regnext(nxt);
1022                     if (OP(nxt) != CLOSE)
1023                         goto nogo;
1024                     /* Now we know that nxt2 is the only contents: */
1025                     oscan->flags = ARG(nxt);
1026                     OP(oscan) = CURLYN;
1027                     OP(nxt1) = NOTHING; /* was OPEN. */
1028 #ifdef DEBUGGING
1029                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1030                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
1031                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
1032                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
1033                     OP(nxt + 1) = OPTIMIZED; /* was count. */
1034                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
1035 #endif
1036                 }
1037               nogo:
1038
1039                 /* Try optimization CURLYX => CURLYM. */
1040                 if (  OP(oscan) == CURLYX && data
1041                       && !(data->flags & SF_HAS_PAR)
1042                       && !(data->flags & SF_HAS_EVAL)
1043                       && !deltanext  ) {
1044                     /* XXXX How to optimize if data == 0? */
1045                     /* Optimize to a simpler form.  */
1046                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
1047                     regnode *nxt2;
1048
1049                     OP(oscan) = CURLYM;
1050                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
1051                             && (OP(nxt2) != WHILEM))
1052                         nxt = nxt2;
1053                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
1054                     /* Need to optimize away parenths. */
1055                     if (data->flags & SF_IN_PAR) {
1056                         /* Set the parenth number.  */
1057                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
1058
1059                         if (OP(nxt) != CLOSE)
1060                             FAIL("Panic opt close");
1061                         oscan->flags = ARG(nxt);
1062                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
1063                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
1064 #ifdef DEBUGGING
1065                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1066                         OP(nxt + 1) = OPTIMIZED; /* was count. */
1067                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
1068                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
1069 #endif
1070 #if 0
1071                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
1072                             regnode *nnxt = regnext(nxt1);
1073
1074                             if (nnxt == nxt) {
1075                                 if (reg_off_by_arg[OP(nxt1)])
1076                                     ARG_SET(nxt1, nxt2 - nxt1);
1077                                 else if (nxt2 - nxt1 < U16_MAX)
1078                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
1079                                 else
1080                                     OP(nxt) = NOTHING;  /* Cannot beautify */
1081                             }
1082                             nxt1 = nnxt;
1083                         }
1084 #endif
1085                         /* Optimize again: */
1086                         study_chunk(pRExC_state, &nxt1, &deltanext, nxt, NULL, 0);
1087                     }
1088                     else
1089                         oscan->flags = 0;
1090                 }
1091                 else if (OP(oscan) == CURLYX && data && ++data->whilem_c < 16) {
1092                     /* This stays as CURLYX, and can put the count/of pair. */
1093                     /* Find WHILEM (as in regexec.c) */
1094                     regnode *nxt = oscan + NEXT_OFF(oscan);
1095
1096                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
1097                         nxt += ARG(nxt);
1098                     PREVOPER(nxt)->flags = data->whilem_c
1099                         | (RExC_whilem_seen << 4); /* On WHILEM */
1100                 }
1101                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
1102                     pars++;
1103                 if (flags & SCF_DO_SUBSTR) {
1104                     SV *last_str = Nullsv;
1105                     int counted = mincount != 0;
1106
1107                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
1108                         I32 b = pos_before >= data->last_start_min
1109                             ? pos_before : data->last_start_min;
1110                         STRLEN l;
1111                         char *s = SvPV(data->last_found, l);
1112                         I32 old = b - data->last_start_min;
1113
1114                         if (UTF)
1115                             old = utf8_hop((U8*)s, old) - (U8*)s;
1116
1117                         l -= old;
1118                         /* Get the added string: */
1119                         last_str = newSVpvn(s  + old, l);
1120                         if (deltanext == 0 && pos_before == b) {
1121                             /* What was added is a constant string */
1122                             if (mincount > 1) {
1123                                 SvGROW(last_str, (mincount * l) + 1);
1124                                 repeatcpy(SvPVX(last_str) + l,
1125                                           SvPVX(last_str), l, mincount - 1);
1126                                 SvCUR(last_str) *= mincount;
1127                                 /* Add additional parts. */
1128                                 SvCUR_set(data->last_found,
1129                                           SvCUR(data->last_found) - l);
1130                                 sv_catsv(data->last_found, last_str);
1131                                 data->last_end += l * (mincount - 1);
1132                             }
1133                         } else {
1134                             /* start offset must point into the last copy */
1135                             data->last_start_min += minnext * (mincount - 1);
1136                             data->last_start_max += is_inf ? 0 : (maxcount - 1)
1137                                 * (minnext + data->pos_delta);
1138                         }
1139                     }
1140                     /* It is counted once already... */
1141                     data->pos_min += minnext * (mincount - counted);
1142                     data->pos_delta += - counted * deltanext +
1143                         (minnext + deltanext) * maxcount - minnext * mincount;
1144                     if (mincount != maxcount) {
1145                          /* Cannot extend fixed substrings found inside
1146                             the group.  */
1147                         scan_commit(pRExC_state,data);
1148                         if (mincount && last_str) {
1149                             sv_setsv(data->last_found, last_str);
1150                             data->last_end = data->pos_min;
1151                             data->last_start_min =
1152                                 data->pos_min - CHR_SVLEN(last_str);
1153                             data->last_start_max = is_inf
1154                                 ? I32_MAX
1155                                 : data->pos_min + data->pos_delta
1156                                 - CHR_SVLEN(last_str);
1157                         }
1158                         data->longest = &(data->longest_float);
1159                     }
1160                     SvREFCNT_dec(last_str);
1161                 }
1162                 if (data && (fl & SF_HAS_EVAL))
1163                     data->flags |= SF_HAS_EVAL;
1164               optimize_curly_tail:
1165                 if (OP(oscan) != CURLYX) {
1166                     while (PL_regkind[(U8)OP(next = regnext(oscan))] == NOTHING
1167                            && NEXT_OFF(next))
1168                         NEXT_OFF(oscan) += NEXT_OFF(next);
1169                 }
1170                 continue;
1171             default:                    /* REF and CLUMP only? */
1172                 if (flags & SCF_DO_SUBSTR) {
1173                     scan_commit(pRExC_state,data);      /* Cannot expect anything... */
1174                     data->longest = &(data->longest_float);
1175                 }
1176                 is_inf = is_inf_internal = 1;
1177                 if (flags & SCF_DO_STCLASS_OR)
1178                     cl_anything(pRExC_state, data->start_class);
1179                 flags &= ~SCF_DO_STCLASS;
1180                 break;
1181             }
1182         }
1183         else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
1184             int value;
1185
1186             if (flags & SCF_DO_SUBSTR) {
1187                 scan_commit(pRExC_state,data);
1188                 data->pos_min++;
1189             }
1190             min++;
1191             if (flags & SCF_DO_STCLASS) {
1192                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
1193
1194                 /* Some of the logic below assumes that switching
1195                    locale on will only add false positives. */
1196                 switch (PL_regkind[(U8)OP(scan)]) {
1197                 case ANYUTF8:
1198                 case SANY:
1199                 case SANYUTF8:
1200                 case ALNUMUTF8:
1201                 case ANYOFUTF8:
1202                 case ALNUMLUTF8:
1203                 case NALNUMUTF8:
1204                 case NALNUMLUTF8:
1205                 case SPACEUTF8:
1206                 case NSPACEUTF8:
1207                 case SPACELUTF8:
1208                 case NSPACELUTF8:
1209                 case DIGITUTF8:
1210                 case NDIGITUTF8:
1211                 default:
1212                   do_default:
1213                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
1214                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
1215                         cl_anything(pRExC_state, data->start_class);
1216                     break;
1217                 case REG_ANY:
1218                     if (OP(scan) == SANY)
1219                         goto do_default;
1220                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
1221                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
1222                                  || (data->start_class->flags & ANYOF_CLASS));
1223                         cl_anything(pRExC_state, data->start_class);
1224                     }
1225                     if (flags & SCF_DO_STCLASS_AND || !value)
1226                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
1227                     break;
1228                 case ANYOF:
1229                     if (flags & SCF_DO_STCLASS_AND)
1230                         cl_and(data->start_class,
1231                                (struct regnode_charclass_class*)scan);
1232                     else
1233                         cl_or(pRExC_state, data->start_class,
1234                               (struct regnode_charclass_class*)scan);
1235                     break;
1236                 case ALNUM:
1237                     if (flags & SCF_DO_STCLASS_AND) {
1238                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
1239                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1240                             for (value = 0; value < 256; value++)
1241                                 if (!isALNUM(value))
1242                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
1243                         }
1244                     }
1245                     else {
1246                         if (data->start_class->flags & ANYOF_LOCALE)
1247                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1248                         else {
1249                             for (value = 0; value < 256; value++)
1250                                 if (isALNUM(value))
1251                                     ANYOF_BITMAP_SET(data->start_class, value);
1252                         }
1253                     }
1254                     break;
1255                 case ALNUML:
1256                     if (flags & SCF_DO_STCLASS_AND) {
1257                         if (data->start_class->flags & ANYOF_LOCALE)
1258                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1259                     }
1260                     else {
1261                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1262                         data->start_class->flags |= ANYOF_LOCALE;
1263                     }
1264                     break;
1265                 case NALNUM:
1266                     if (flags & SCF_DO_STCLASS_AND) {
1267                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
1268                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1269                             for (value = 0; value < 256; value++)
1270                                 if (isALNUM(value))
1271                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
1272                         }
1273                     }
1274                     else {
1275                         if (data->start_class->flags & ANYOF_LOCALE)
1276                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1277                         else {
1278                             for (value = 0; value < 256; value++)
1279                                 if (!isALNUM(value))
1280                                     ANYOF_BITMAP_SET(data->start_class, value);
1281                         }
1282                     }
1283                     break;
1284                 case NALNUML:
1285                     if (flags & SCF_DO_STCLASS_AND) {
1286                         if (data->start_class->flags & ANYOF_LOCALE)
1287                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1288                     }
1289                     else {
1290                         data->start_class->flags |= ANYOF_LOCALE;
1291                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1292                     }
1293                     break;
1294                 case SPACE:
1295                     if (flags & SCF_DO_STCLASS_AND) {
1296                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
1297                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1298                             for (value = 0; value < 256; value++)
1299                                 if (!isSPACE(value))
1300                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
1301                         }
1302                     }
1303                     else {
1304                         if (data->start_class->flags & ANYOF_LOCALE)
1305                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1306                         else {
1307                             for (value = 0; value < 256; value++)
1308                                 if (isSPACE(value))
1309                                     ANYOF_BITMAP_SET(data->start_class, value);
1310                         }
1311                     }
1312                     break;
1313                 case SPACEL:
1314                     if (flags & SCF_DO_STCLASS_AND) {
1315                         if (data->start_class->flags & ANYOF_LOCALE)
1316                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1317                     }
1318                     else {
1319                         data->start_class->flags |= ANYOF_LOCALE;
1320                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1321                     }
1322                     break;
1323                 case NSPACE:
1324                     if (flags & SCF_DO_STCLASS_AND) {
1325                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
1326                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1327                             for (value = 0; value < 256; value++)
1328                                 if (isSPACE(value))
1329                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
1330                         }
1331                     }
1332                     else {
1333                         if (data->start_class->flags & ANYOF_LOCALE)
1334                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1335                         else {
1336                             for (value = 0; value < 256; value++)
1337                                 if (!isSPACE(value))
1338                                     ANYOF_BITMAP_SET(data->start_class, value);
1339                         }
1340                     }
1341                     break;
1342                 case NSPACEL:
1343                     if (flags & SCF_DO_STCLASS_AND) {
1344                         if (data->start_class->flags & ANYOF_LOCALE) {
1345                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1346                             for (value = 0; value < 256; value++)
1347                                 if (!isSPACE(value))
1348                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
1349                         }
1350                     }
1351                     else {
1352                         data->start_class->flags |= ANYOF_LOCALE;
1353                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1354                     }
1355                     break;
1356                 case DIGIT:
1357                     if (flags & SCF_DO_STCLASS_AND) {
1358                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
1359                         for (value = 0; value < 256; value++)
1360                             if (!isDIGIT(value))
1361                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
1362                     }
1363                     else {
1364                         if (data->start_class->flags & ANYOF_LOCALE)
1365                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
1366                         else {
1367                             for (value = 0; value < 256; value++)
1368                                 if (isDIGIT(value))
1369                                     ANYOF_BITMAP_SET(data->start_class, value);
1370                         }
1371                     }
1372                     break;
1373                 case NDIGIT:
1374                     if (flags & SCF_DO_STCLASS_AND) {
1375                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
1376                         for (value = 0; value < 256; value++)
1377                             if (isDIGIT(value))
1378                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
1379                     }
1380                     else {
1381                         if (data->start_class->flags & ANYOF_LOCALE)
1382                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
1383                         else {
1384                             for (value = 0; value < 256; value++)
1385                                 if (!isDIGIT(value))
1386                                     ANYOF_BITMAP_SET(data->start_class, value);
1387                         }
1388                     }
1389                     break;
1390                 }
1391                 if (flags & SCF_DO_STCLASS_OR)
1392                     cl_and(data->start_class, &and_with);
1393                 flags &= ~SCF_DO_STCLASS;
1394             }
1395         }
1396         else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
1397             data->flags |= (OP(scan) == MEOL
1398                             ? SF_BEFORE_MEOL
1399                             : SF_BEFORE_SEOL);
1400         }
1401         else if (  PL_regkind[(U8)OP(scan)] == BRANCHJ
1402                  /* Lookbehind, or need to calculate parens/evals/stclass: */
1403                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
1404                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
1405             /* Lookahead/lookbehind */
1406             I32 deltanext, minnext, fake = 0;
1407             regnode *nscan;
1408             struct regnode_charclass_class intrnl;
1409             int f = 0;
1410
1411             data_fake.flags = 0;
1412             if (data) {
1413                 data_fake.whilem_c = data->whilem_c;
1414                 data_fake.last_closep = data->last_closep;
1415             }
1416             else
1417                 data_fake.last_closep = &fake;
1418             if ( flags & SCF_DO_STCLASS && !scan->flags
1419                  && OP(scan) == IFMATCH ) { /* Lookahead */
1420                 cl_init(pRExC_state, &intrnl);
1421                 data_fake.start_class = &intrnl;
1422                 f = SCF_DO_STCLASS_AND;
1423             }
1424             next = regnext(scan);
1425             nscan = NEXTOPER(NEXTOPER(scan));
1426             minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f);
1427             if (scan->flags) {
1428                 if (deltanext) {
1429                     vFAIL("Variable length lookbehind not implemented");
1430                 }
1431                 else if (minnext > U8_MAX) {
1432                     vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
1433                 }
1434                 scan->flags = minnext;
1435             }
1436             if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
1437                 pars++;
1438             if (data && (data_fake.flags & SF_HAS_EVAL))
1439                 data->flags |= SF_HAS_EVAL;
1440             if (data)
1441                 data->whilem_c = data_fake.whilem_c;
1442             if (f) {
1443                 int was = (data->start_class->flags & ANYOF_EOS);
1444
1445                 cl_and(data->start_class, &intrnl);
1446                 if (was)
1447                     data->start_class->flags |= ANYOF_EOS;
1448             }
1449         }
1450         else if (OP(scan) == OPEN) {
1451             pars++;
1452         }
1453         else if (OP(scan) == CLOSE) {
1454             if (ARG(scan) == is_par) {
1455                 next = regnext(scan);
1456
1457                 if ( next && (OP(next) != WHILEM) && next < last)
1458                     is_par = 0;         /* Disable optimization */
1459             }
1460             if (data)
1461                 *(data->last_closep) = ARG(scan);
1462         }
1463         else if (OP(scan) == EVAL) {
1464                 if (data)
1465                     data->flags |= SF_HAS_EVAL;
1466         }
1467         else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
1468                 if (flags & SCF_DO_SUBSTR) {
1469                     scan_commit(pRExC_state,data);
1470                     data->longest = &(data->longest_float);
1471                 }
1472                 is_inf = is_inf_internal = 1;
1473                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
1474                     cl_anything(pRExC_state, data->start_class);
1475                 flags &= ~SCF_DO_STCLASS;
1476         }
1477         /* Else: zero-length, ignore. */
1478         scan = regnext(scan);
1479     }
1480
1481   finish:
1482     *scanp = scan;
1483     *deltap = is_inf_internal ? I32_MAX : delta;
1484     if (flags & SCF_DO_SUBSTR && is_inf)
1485         data->pos_delta = I32_MAX - data->pos_min;
1486     if (is_par > U8_MAX)
1487         is_par = 0;
1488     if (is_par && pars==1 && data) {
1489         data->flags |= SF_IN_PAR;
1490         data->flags &= ~SF_HAS_PAR;
1491     }
1492     else if (pars && data) {
1493         data->flags |= SF_HAS_PAR;
1494         data->flags &= ~SF_IN_PAR;
1495     }
1496     if (flags & SCF_DO_STCLASS_OR)
1497         cl_and(data->start_class, &and_with);
1498     return min;
1499 }
1500
1501 STATIC I32
1502 S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s)
1503 {
1504     dTHR;
1505     if (RExC_rx->data) {
1506         Renewc(RExC_rx->data,
1507                sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
1508                char, struct reg_data);
1509         Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
1510         RExC_rx->data->count += n;
1511     }
1512     else {
1513         Newc(1207, RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
1514              char, struct reg_data);
1515         New(1208, RExC_rx->data->what, n, U8);
1516         RExC_rx->data->count = n;
1517     }
1518     Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
1519     return RExC_rx->data->count - n;
1520 }
1521
1522 void
1523 Perl_reginitcolors(pTHX)
1524 {
1525     dTHR;
1526     int i = 0;
1527     char *s = PerlEnv_getenv("PERL_RE_COLORS");
1528
1529     if (s) {
1530         PL_colors[0] = s = savepv(s);
1531         while (++i < 6) {
1532             s = strchr(s, '\t');
1533             if (s) {
1534                 *s = '\0';
1535                 PL_colors[i] = ++s;
1536             }
1537             else
1538                 PL_colors[i] = s = "";
1539         }
1540     } else {
1541         while (i < 6)
1542             PL_colors[i++] = "";
1543     }
1544     PL_colorset = 1;
1545 }
1546
1547
1548 /*
1549  - pregcomp - compile a regular expression into internal code
1550  *
1551  * We can't allocate space until we know how big the compiled form will be,
1552  * but we can't compile it (and thus know how big it is) until we've got a
1553  * place to put the code.  So we cheat:  we compile it twice, once with code
1554  * generation turned off and size counting turned on, and once "for real".
1555  * This also means that we don't allocate space until we are sure that the
1556  * thing really will compile successfully, and we never have to move the
1557  * code and thus invalidate pointers into it.  (Note that it has to be in
1558  * one piece because free() must be able to free it all.) [NB: not true in perl]
1559  *
1560  * Beware that the optimization-preparation code in here knows about some
1561  * of the structure of the compiled regexp.  [I'll say.]
1562  */
1563 regexp *
1564 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
1565 {
1566     dTHR;
1567     register regexp *r;
1568     regnode *scan;
1569     regnode *first;
1570     I32 flags;
1571     I32 minlen = 0;
1572     I32 sawplus = 0;
1573     I32 sawopen = 0;
1574     scan_data_t data;
1575     RExC_state_t RExC_state;
1576     RExC_state_t *pRExC_state = &RExC_state;
1577
1578     if (exp == NULL)
1579         FAIL("NULL regexp argument");
1580
1581     /* XXXX This looks very suspicious... */
1582     if (pm->op_pmdynflags & PMdf_UTF8) {
1583         PL_reg_flags |= RF_utf8;
1584     }
1585     else
1586         PL_reg_flags = 0;
1587
1588     RExC_precomp = savepvn(exp, xend - exp);
1589     DEBUG_r(if (!PL_colorset) reginitcolors());
1590     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
1591                       PL_colors[4],PL_colors[5],PL_colors[0],
1592                       (int)(xend - exp), RExC_precomp, PL_colors[1]));
1593     RExC_flags16 = pm->op_pmflags;
1594     RExC_sawback = 0;
1595
1596     RExC_seen = 0;
1597     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
1598     RExC_seen_evals = 0;
1599     RExC_extralen = 0;
1600
1601     /* First pass: determine size, legality. */
1602     RExC_parse = exp;
1603     RExC_end = xend;
1604     RExC_naughty = 0;
1605     RExC_npar = 1;
1606     RExC_size = 0L;
1607     RExC_emit = &PL_regdummy;
1608     RExC_whilem_seen = 0;
1609 #if 0 /* REGC() is (currently) a NOP at the first pass.
1610        * Clever compilers notice this and complain. --jhi */
1611     REGC((U8)REG_MAGIC, (char*)RExC_emit);
1612 #endif
1613     if (reg(pRExC_state, 0, &flags) == NULL) {
1614         Safefree(RExC_precomp);
1615         RExC_precomp = Nullch;
1616         return(NULL);
1617     }
1618     DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
1619
1620     /* Small enough for pointer-storage convention?
1621        If extralen==0, this means that we will not need long jumps. */
1622     if (RExC_size >= 0x10000L && RExC_extralen)
1623         RExC_size += RExC_extralen;
1624     else
1625         RExC_extralen = 0;
1626     if (RExC_whilem_seen > 15)
1627         RExC_whilem_seen = 15;
1628
1629     /* Allocate space and initialize. */
1630     Newc(1001, r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
1631          char, regexp);
1632     if (r == NULL)
1633         FAIL("Regexp out of space");
1634
1635 #ifdef DEBUGGING
1636     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
1637     Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
1638 #endif
1639     r->refcnt = 1;
1640     r->prelen = xend - exp;
1641     r->precomp = RExC_precomp;
1642     r->subbeg = NULL;
1643     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
1644     r->nparens = RExC_npar - 1; /* set early to validate backrefs */
1645
1646     r->substrs = 0;                     /* Useful during FAIL. */
1647     r->startp = 0;                      /* Useful during FAIL. */
1648     r->endp = 0;                        /* Useful during FAIL. */
1649
1650     RExC_rx = r;
1651
1652     /* Second pass: emit code. */
1653     RExC_parse = exp;
1654     RExC_end = xend;
1655     RExC_naughty = 0;
1656     RExC_npar = 1;
1657     RExC_emit = r->program;
1658     /* Store the count of eval-groups for security checks: */
1659     RExC_emit->next_off = ((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
1660     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
1661     r->data = 0;
1662     if (reg(pRExC_state, 0, &flags) == NULL)
1663         return(NULL);
1664
1665     /* Dig out information for optimizations. */
1666     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
1667     pm->op_pmflags = RExC_flags16;
1668     if (UTF)
1669         r->reganch |= ROPT_UTF8;
1670     r->regstclass = NULL;
1671     if (RExC_naughty >= 10)     /* Probably an expensive pattern. */
1672         r->reganch |= ROPT_NAUGHTY;
1673     scan = r->program + 1;              /* First BRANCH. */
1674
1675     /* XXXX To minimize changes to RE engine we always allocate
1676        3-units-long substrs field. */
1677     Newz(1004, r->substrs, 1, struct reg_substr_data);
1678
1679     StructCopy(&zero_scan_data, &data, scan_data_t);
1680     /* XXXX Should not we check for something else?  Usually it is OPEN1... */
1681     if (OP(scan) != BRANCH) {   /* Only one top-level choice. */
1682         I32 fake;
1683         STRLEN longest_float_length, longest_fixed_length;
1684         struct regnode_charclass_class ch_class;
1685         int stclass_flag;
1686         I32 last_close = 0;
1687
1688         first = scan;
1689         /* Skip introductions and multiplicators >= 1. */
1690         while ((OP(first) == OPEN && (sawopen = 1)) ||
1691                /* An OR of *one* alternative - should not happen now. */
1692             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
1693             (OP(first) == PLUS) ||
1694             (OP(first) == MINMOD) ||
1695                /* An {n,m} with n>0 */
1696             (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
1697                 if (OP(first) == PLUS)
1698                     sawplus = 1;
1699                 else
1700                     first += regarglen[(U8)OP(first)];
1701                 first = NEXTOPER(first);
1702         }
1703
1704         /* Starting-point info. */
1705       again:
1706         if (PL_regkind[(U8)OP(first)] == EXACT) {
1707             if (OP(first) == EXACT);    /* Empty, get anchored substr later. */
1708             else if ((OP(first) == EXACTF || OP(first) == EXACTFL)
1709                      && !UTF)
1710                 r->regstclass = first;
1711         }
1712         else if (strchr((char*)PL_simple,OP(first)))
1713             r->regstclass = first;
1714         else if (PL_regkind[(U8)OP(first)] == BOUND ||
1715                  PL_regkind[(U8)OP(first)] == NBOUND)
1716             r->regstclass = first;
1717         else if (PL_regkind[(U8)OP(first)] == BOL) {
1718             r->reganch |= (OP(first) == MBOL
1719                            ? ROPT_ANCH_MBOL
1720                            : (OP(first) == SBOL
1721                               ? ROPT_ANCH_SBOL
1722                               : ROPT_ANCH_BOL));
1723             first = NEXTOPER(first);
1724             goto again;
1725         }
1726         else if (OP(first) == GPOS) {
1727             r->reganch |= ROPT_ANCH_GPOS;
1728             first = NEXTOPER(first);
1729             goto again;
1730         }
1731         else if ((OP(first) == STAR &&
1732             PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
1733             !(r->reganch & ROPT_ANCH) )
1734         {
1735             /* turn .* into ^.* with an implied $*=1 */
1736             int type = OP(NEXTOPER(first));
1737
1738             if (type == REG_ANY || type == ANYUTF8)
1739                 type = ROPT_ANCH_MBOL;
1740             else
1741                 type = ROPT_ANCH_SBOL;
1742
1743             r->reganch |= type | ROPT_IMPLICIT;
1744             first = NEXTOPER(first);
1745             goto again;
1746         }
1747         if (sawplus && (!sawopen || !RExC_sawback)
1748             && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
1749             /* x+ must match at the 1st pos of run of x's */
1750             r->reganch |= ROPT_SKIP;
1751
1752         /* Scan is after the zeroth branch, first is atomic matcher. */
1753         DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
1754                               (IV)(first - scan + 1)));
1755         /*
1756         * If there's something expensive in the r.e., find the
1757         * longest literal string that must appear and make it the
1758         * regmust.  Resolve ties in favor of later strings, since
1759         * the regstart check works with the beginning of the r.e.
1760         * and avoiding duplication strengthens checking.  Not a
1761         * strong reason, but sufficient in the absence of others.
1762         * [Now we resolve ties in favor of the earlier string if
1763         * it happens that c_offset_min has been invalidated, since the
1764         * earlier string may buy us something the later one won't.]
1765         */
1766         minlen = 0;
1767
1768         data.longest_fixed = newSVpvn("",0);
1769         data.longest_float = newSVpvn("",0);
1770         data.last_found = newSVpvn("",0);
1771         data.longest = &(data.longest_fixed);
1772         first = scan;
1773         if (!r->regstclass) {
1774             cl_init(pRExC_state, &ch_class);
1775             data.start_class = &ch_class;
1776             stclass_flag = SCF_DO_STCLASS_AND;
1777         } else                          /* XXXX Check for BOUND? */
1778             stclass_flag = 0;
1779         data.last_closep = &last_close;
1780
1781         minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
1782                              &data, SCF_DO_SUBSTR | stclass_flag);
1783         if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
1784              && data.last_start_min == 0 && data.last_end > 0
1785              && !RExC_seen_zerolen
1786              && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
1787             r->reganch |= ROPT_CHECK_ALL;
1788         scan_commit(pRExC_state, &data);
1789         SvREFCNT_dec(data.last_found);
1790
1791         longest_float_length = CHR_SVLEN(data.longest_float);
1792         if (longest_float_length
1793             || (data.flags & SF_FL_BEFORE_EOL
1794                 && (!(data.flags & SF_FL_BEFORE_MEOL)
1795                     || (RExC_flags16 & PMf_MULTILINE)))) {
1796             int t;
1797
1798             if (SvCUR(data.longest_fixed)                       /* ok to leave SvCUR */
1799                 && data.offset_fixed == data.offset_float_min
1800                 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
1801                     goto remove_float;          /* As in (a)+. */
1802
1803             r->float_substr = data.longest_float;
1804             r->float_min_offset = data.offset_float_min;
1805             r->float_max_offset = data.offset_float_max;
1806             t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
1807                        && (!(data.flags & SF_FL_BEFORE_MEOL)
1808                            || (RExC_flags16 & PMf_MULTILINE)));
1809             fbm_compile(r->float_substr, t ? FBMcf_TAIL : 0);
1810         }
1811         else {
1812           remove_float:
1813             r->float_substr = Nullsv;
1814             SvREFCNT_dec(data.longest_float);
1815             longest_float_length = 0;
1816         }
1817
1818         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
1819         if (longest_fixed_length
1820             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
1821                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
1822                     || (RExC_flags16 & PMf_MULTILINE)))) {
1823             int t;
1824
1825             r->anchored_substr = data.longest_fixed;
1826             r->anchored_offset = data.offset_fixed;
1827             t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
1828                  && (!(data.flags & SF_FIX_BEFORE_MEOL)
1829                      || (RExC_flags16 & PMf_MULTILINE)));
1830             fbm_compile(r->anchored_substr, t ? FBMcf_TAIL : 0);
1831         }
1832         else {
1833             r->anchored_substr = Nullsv;
1834             SvREFCNT_dec(data.longest_fixed);
1835             longest_fixed_length = 0;
1836         }
1837         if (r->regstclass
1838             && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == ANYUTF8
1839                 || OP(r->regstclass) == SANYUTF8 || OP(r->regstclass) == SANY))
1840             r->regstclass = NULL;
1841         if ((!r->anchored_substr || r->anchored_offset) && stclass_flag
1842             && !(data.start_class->flags & ANYOF_EOS)
1843             && !cl_is_anything(data.start_class)) {
1844             SV *sv;
1845             I32 n = add_data(pRExC_state, 1, "f");
1846
1847             New(1006, RExC_rx->data->data[n], 1,
1848                 struct regnode_charclass_class);
1849             StructCopy(data.start_class,
1850                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
1851                        struct regnode_charclass_class);
1852             r->regstclass = (regnode*)RExC_rx->data->data[n];
1853             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
1854             DEBUG_r((sv = sv_newmortal(),
1855                      regprop(sv, (regnode*)data.start_class),
1856                      PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
1857                                    SvPVX(sv))));
1858         }
1859
1860         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
1861         if (longest_fixed_length > longest_float_length) {
1862             r->check_substr = r->anchored_substr;
1863             r->check_offset_min = r->check_offset_max = r->anchored_offset;
1864             if (r->reganch & ROPT_ANCH_SINGLE)
1865                 r->reganch |= ROPT_NOSCAN;
1866         }
1867         else {
1868             r->check_substr = r->float_substr;
1869             r->check_offset_min = data.offset_float_min;
1870             r->check_offset_max = data.offset_float_max;
1871         }
1872         /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
1873            This should be changed ASAP!  */
1874         if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) {
1875             r->reganch |= RE_USE_INTUIT;
1876             if (SvTAIL(r->check_substr))
1877                 r->reganch |= RE_INTUIT_TAIL;
1878         }
1879     }
1880     else {
1881         /* Several toplevels. Best we can is to set minlen. */
1882         I32 fake;
1883         struct regnode_charclass_class ch_class;
1884         I32 last_close = 0;
1885
1886         DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
1887         scan = r->program + 1;
1888         cl_init(pRExC_state, &ch_class);
1889         data.start_class = &ch_class;
1890         data.last_closep = &last_close;
1891         minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND);
1892         r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
1893         if (!(data.start_class->flags & ANYOF_EOS)
1894             && !cl_is_anything(data.start_class)) {
1895             SV *sv;
1896             I32 n = add_data(pRExC_state, 1, "f");
1897
1898             New(1006, RExC_rx->data->data[n], 1,
1899                 struct regnode_charclass_class);
1900             StructCopy(data.start_class,
1901                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
1902                        struct regnode_charclass_class);
1903             r->regstclass = (regnode*)RExC_rx->data->data[n];
1904             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
1905             DEBUG_r((sv = sv_newmortal(),
1906                      regprop(sv, (regnode*)data.start_class),
1907                      PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
1908                                    SvPVX(sv))));
1909         }
1910     }
1911
1912     r->minlen = minlen;
1913     if (RExC_seen & REG_SEEN_GPOS)
1914         r->reganch |= ROPT_GPOS_SEEN;
1915     if (RExC_seen & REG_SEEN_LOOKBEHIND)
1916         r->reganch |= ROPT_LOOKBEHIND_SEEN;
1917     if (RExC_seen & REG_SEEN_EVAL)
1918         r->reganch |= ROPT_EVAL_SEEN;
1919     Newz(1002, r->startp, RExC_npar, I32);
1920     Newz(1002, r->endp, RExC_npar, I32);
1921     DEBUG_r(regdump(r));
1922     return(r);
1923 }
1924
1925 /*
1926  - reg - regular expression, i.e. main body or parenthesized thing
1927  *
1928  * Caller must absorb opening parenthesis.
1929  *
1930  * Combining parenthesis handling with the base level of regular expression
1931  * is a trifle forced, but the need to tie the tails of the branches to what
1932  * follows makes it hard to avoid.
1933  */
1934 STATIC regnode *
1935 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
1936     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
1937 {
1938     dTHR;
1939     register regnode *ret;              /* Will be the head of the group. */
1940     register regnode *br;
1941     register regnode *lastbr;
1942     register regnode *ender = 0;
1943     register I32 parno = 0;
1944     I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0;
1945     char *oregcomp_parse = RExC_parse;
1946     char c;
1947
1948     *flagp = 0;                         /* Tentatively. */
1949
1950     /* Make an OPEN node, if parenthesized. */
1951     if (paren) {
1952         if (*RExC_parse == '?') {
1953             U16 posflags = 0, negflags = 0;
1954             U16 *flagsp = &posflags;
1955             int logical = 0;
1956             char *seqstart = RExC_parse;
1957
1958             RExC_parse++;
1959             paren = *RExC_parse++;
1960             ret = NULL;                 /* For look-ahead/behind. */
1961             switch (paren) {
1962             case '<':
1963                 RExC_seen |= REG_SEEN_LOOKBEHIND;
1964                 if (*RExC_parse == '!')
1965                     paren = ',';
1966                 if (*RExC_parse != '=' && *RExC_parse != '!')
1967                     goto unknown;
1968                 RExC_parse++;
1969             case '=':
1970             case '!':
1971                 RExC_seen_zerolen++;
1972             case ':':
1973             case '>':
1974                 break;
1975             case '$':
1976             case '@':
1977                 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
1978                 break;
1979             case '#':
1980                 while (*RExC_parse && *RExC_parse != ')')
1981                     RExC_parse++;
1982                 if (*RExC_parse != ')')
1983                     FAIL("Sequence (?#... not terminated");
1984                 nextchar(pRExC_state);
1985                 *flagp = TRYAGAIN;
1986                 return NULL;
1987             case 'p':
1988                 if (SIZE_ONLY)
1989                     vWARN(RExC_parse, "(?p{}) is deprecated - use (??{})");
1990                 /* FALL THROUGH*/
1991             case '?':
1992                 logical = 1;
1993                 paren = *RExC_parse++;
1994                 /* FALL THROUGH */
1995             case '{':
1996             {
1997                 dTHR;
1998                 I32 count = 1, n = 0;
1999                 char c;
2000                 char *s = RExC_parse;
2001                 SV *sv;
2002                 OP_4tree *sop, *rop;
2003
2004                 RExC_seen_zerolen++;
2005                 RExC_seen |= REG_SEEN_EVAL;
2006                 while (count && (c = *RExC_parse)) {
2007                     if (c == '\\' && RExC_parse[1])
2008                         RExC_parse++;
2009                     else if (c == '{')
2010                         count++;
2011                     else if (c == '}')
2012                         count--;
2013                     RExC_parse++;
2014                 }
2015                 if (*RExC_parse != ')')
2016                 {
2017                     RExC_parse = s;
2018                     vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
2019                 }
2020                 if (!SIZE_ONLY) {
2021                     AV *av;
2022
2023                     if (RExC_parse - 1 - s)
2024                         sv = newSVpvn(s, RExC_parse - 1 - s);
2025                     else
2026                         sv = newSVpvn("", 0);
2027
2028                     ENTER;
2029                     Perl_save_re_context(aTHX);
2030                     rop = sv_compile_2op(sv, &sop, "re", &av);
2031                     LEAVE;
2032
2033                     n = add_data(pRExC_state, 3, "nop");
2034                     RExC_rx->data->data[n] = (void*)rop;
2035                     RExC_rx->data->data[n+1] = (void*)sop;
2036                     RExC_rx->data->data[n+2] = (void*)av;
2037                     SvREFCNT_dec(sv);
2038                 }
2039                 else {                                          /* First pass */
2040                     if (PL_reginterp_cnt < ++RExC_seen_evals
2041                         && PL_curcop != &PL_compiling)
2042                         /* No compiled RE interpolated, has runtime
2043                            components ===> unsafe.  */
2044                         FAIL("Eval-group not allowed at runtime, use re 'eval'");
2045                     if (PL_tainted)
2046                         FAIL("Eval-group in insecure regular expression");
2047                 }
2048
2049                 nextchar(pRExC_state);
2050                 if (logical) {
2051                     ret = reg_node(pRExC_state, LOGICAL);
2052                     if (!SIZE_ONLY)
2053                         ret->flags = 2;
2054                     regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
2055                     return ret;
2056                 }
2057                 return reganode(pRExC_state, EVAL, n);
2058             }
2059             case '(':
2060             {
2061                 if (RExC_parse[0] == '?') {
2062                     if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
2063                         || RExC_parse[1] == '<'
2064                         || RExC_parse[1] == '{') { /* Lookahead or eval. */
2065                         I32 flag;
2066
2067                         ret = reg_node(pRExC_state, LOGICAL);
2068                         if (!SIZE_ONLY)
2069                             ret->flags = 1;
2070                         regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag));
2071                         goto insert_if;
2072                     }
2073                 }
2074                 else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
2075                     parno = atoi(RExC_parse++);
2076
2077                     while (isDIGIT(*RExC_parse))
2078                         RExC_parse++;
2079                     ret = reganode(pRExC_state, GROUPP, parno);
2080                     if ((c = *nextchar(pRExC_state)) != ')')
2081                         vFAIL("Switch condition not recognized");
2082                   insert_if:
2083                     regtail(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
2084                     br = regbranch(pRExC_state, &flags, 1);
2085                     if (br == NULL)
2086                         br = reganode(pRExC_state, LONGJMP, 0);
2087                     else
2088                         regtail(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
2089                     c = *nextchar(pRExC_state);
2090                     if (flags&HASWIDTH)
2091                         *flagp |= HASWIDTH;
2092                     if (c == '|') {
2093                         lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
2094                         regbranch(pRExC_state, &flags, 1);
2095                         regtail(pRExC_state, ret, lastbr);
2096                         if (flags&HASWIDTH)
2097                             *flagp |= HASWIDTH;
2098                         c = *nextchar(pRExC_state);
2099                     }
2100                     else
2101                         lastbr = NULL;
2102                     if (c != ')')
2103                         vFAIL("Switch (?(condition)... contains too many branches");
2104                     ender = reg_node(pRExC_state, TAIL);
2105                     regtail(pRExC_state, br, ender);
2106                     if (lastbr) {
2107                         regtail(pRExC_state, lastbr, ender);
2108                         regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
2109                     }
2110                     else
2111                         regtail(pRExC_state, ret, ender);
2112                     return ret;
2113                 }
2114                 else {
2115                     vFAIL2("Unknown switch condition (?(%.2s", RExC_parse);
2116                 }
2117             }
2118             case 0:
2119                 RExC_parse--; /* for vFAIL to print correctly */
2120                 vFAIL("Sequence (? incomplete");
2121                 break;
2122             default:
2123                 --RExC_parse;
2124               parse_flags:
2125                 while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
2126                     if (*RExC_parse != 'o')
2127                         pmflag(flagsp, *RExC_parse);
2128                     ++RExC_parse;
2129                 }
2130                 if (*RExC_parse == '-') {
2131                     flagsp = &negflags;
2132                     ++RExC_parse;
2133                     goto parse_flags;
2134                 }
2135                 RExC_flags16 |= posflags;
2136                 RExC_flags16 &= ~negflags;
2137                 if (*RExC_parse == ':') {
2138                     RExC_parse++;
2139                     paren = ':';
2140                     break;
2141                 }
2142               unknown:
2143                 if (*RExC_parse != ')') {
2144                     RExC_parse++;
2145                     vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
2146                 }
2147                 nextchar(pRExC_state);
2148                 *flagp = TRYAGAIN;
2149                 return NULL;
2150             }
2151         }
2152         else {
2153             parno = RExC_npar;
2154             RExC_npar++;
2155             ret = reganode(pRExC_state, OPEN, parno);
2156             open = 1;
2157         }
2158     }
2159     else
2160         ret = NULL;
2161
2162     /* Pick up the branches, linking them together. */
2163     br = regbranch(pRExC_state, &flags, 1);
2164     if (br == NULL)
2165         return(NULL);
2166     if (*RExC_parse == '|') {
2167         if (!SIZE_ONLY && RExC_extralen) {
2168             reginsert(pRExC_state, BRANCHJ, br);
2169         }
2170         else
2171             reginsert(pRExC_state, BRANCH, br);
2172         have_branch = 1;
2173         if (SIZE_ONLY)
2174             RExC_extralen += 1;         /* For BRANCHJ-BRANCH. */
2175     }
2176     else if (paren == ':') {
2177         *flagp |= flags&SIMPLE;
2178     }
2179     if (open) {                         /* Starts with OPEN. */
2180         regtail(pRExC_state, ret, br);          /* OPEN -> first. */
2181     }
2182     else if (paren != '?')              /* Not Conditional */
2183         ret = br;
2184     if (flags&HASWIDTH)
2185         *flagp |= HASWIDTH;
2186     *flagp |= flags&SPSTART;
2187     lastbr = br;
2188     while (*RExC_parse == '|') {
2189         if (!SIZE_ONLY && RExC_extralen) {
2190             ender = reganode(pRExC_state, LONGJMP,0);
2191             regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
2192         }
2193         if (SIZE_ONLY)
2194             RExC_extralen += 2;         /* Account for LONGJMP. */
2195         nextchar(pRExC_state);
2196         br = regbranch(pRExC_state, &flags, 0);
2197         if (br == NULL)
2198             return(NULL);
2199         regtail(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
2200         lastbr = br;
2201         if (flags&HASWIDTH)
2202             *flagp |= HASWIDTH;
2203         *flagp |= flags&SPSTART;
2204     }
2205
2206     if (have_branch || paren != ':') {
2207         /* Make a closing node, and hook it on the end. */
2208         switch (paren) {
2209         case ':':
2210             ender = reg_node(pRExC_state, TAIL);
2211             break;
2212         case 1:
2213             ender = reganode(pRExC_state, CLOSE, parno);
2214             break;
2215         case '<':
2216         case ',':
2217         case '=':
2218         case '!':
2219             *flagp &= ~HASWIDTH;
2220             /* FALL THROUGH */
2221         case '>':
2222             ender = reg_node(pRExC_state, SUCCEED);
2223             break;
2224         case 0:
2225             ender = reg_node(pRExC_state, END);
2226             break;
2227         }
2228         regtail(pRExC_state, lastbr, ender);
2229
2230         if (have_branch) {
2231             /* Hook the tails of the branches to the closing node. */
2232             for (br = ret; br != NULL; br = regnext(br)) {
2233                 regoptail(pRExC_state, br, ender);
2234             }
2235         }
2236     }
2237
2238     {
2239         char *p;
2240         static char parens[] = "=!<,>";
2241
2242         if (paren && (p = strchr(parens, paren))) {
2243             int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
2244             int flag = (p - parens) > 1;
2245
2246             if (paren == '>')
2247                 node = SUSPEND, flag = 0;
2248             reginsert(pRExC_state, node,ret);
2249             ret->flags = flag;
2250             regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
2251         }
2252     }
2253
2254     /* Check for proper termination. */
2255     if (paren) {
2256         RExC_flags16 = oregflags;
2257         if (RExC_parse >= RExC_end || *nextchar(pRExC_state) != ')') {
2258             RExC_parse = oregcomp_parse;
2259             vFAIL("Unmatched (");
2260         }
2261     }
2262     else if (!paren && RExC_parse < RExC_end) {
2263         if (*RExC_parse == ')') {
2264             RExC_parse++;
2265             vFAIL("Unmatched )");
2266         }
2267         else
2268             FAIL("Junk on end of regexp");      /* "Can't happen". */
2269         /* NOTREACHED */
2270     }
2271
2272     return(ret);
2273 }
2274
2275 /*
2276  - regbranch - one alternative of an | operator
2277  *
2278  * Implements the concatenation operator.
2279  */
2280 STATIC regnode *
2281 S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
2282 {
2283     dTHR;
2284     register regnode *ret;
2285     register regnode *chain = NULL;
2286     register regnode *latest;
2287     I32 flags = 0, c = 0;
2288
2289     if (first)
2290         ret = NULL;
2291     else {
2292         if (!SIZE_ONLY && RExC_extralen)
2293             ret = reganode(pRExC_state, BRANCHJ,0);
2294         else
2295             ret = reg_node(pRExC_state, BRANCH);
2296     }
2297
2298     if (!first && SIZE_ONLY)
2299         RExC_extralen += 1;                     /* BRANCHJ */
2300
2301     *flagp = WORST;                     /* Tentatively. */
2302
2303     RExC_parse--;
2304     nextchar(pRExC_state);
2305     while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
2306         flags &= ~TRYAGAIN;
2307         latest = regpiece(pRExC_state, &flags);
2308         if (latest == NULL) {
2309             if (flags & TRYAGAIN)
2310                 continue;
2311             return(NULL);
2312         }
2313         else if (ret == NULL)
2314             ret = latest;
2315         *flagp |= flags&HASWIDTH;
2316         if (chain == NULL)      /* First piece. */
2317             *flagp |= flags&SPSTART;
2318         else {
2319             RExC_naughty++;
2320             regtail(pRExC_state, chain, latest);
2321         }
2322         chain = latest;
2323         c++;
2324     }
2325     if (chain == NULL) {        /* Loop ran zero times. */
2326         chain = reg_node(pRExC_state, NOTHING);
2327         if (ret == NULL)
2328             ret = chain;
2329     }
2330     if (c == 1) {
2331         *flagp |= flags&SIMPLE;
2332     }
2333
2334     return(ret);
2335 }
2336
2337 /*
2338  - regpiece - something followed by possible [*+?]
2339  *
2340  * Note that the branching code sequences used for ? and the general cases
2341  * of * and + are somewhat optimized:  they use the same NOTHING node as
2342  * both the endmarker for their branch list and the body of the last branch.
2343  * It might seem that this node could be dispensed with entirely, but the
2344  * endmarker role is not redundant.
2345  */
2346 STATIC regnode *
2347 S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
2348 {
2349     dTHR;
2350     register regnode *ret;
2351     register char op;
2352     register char *next;
2353     I32 flags;
2354     char *origparse = RExC_parse;
2355     char *maxpos;
2356     I32 min;
2357     I32 max = REG_INFTY;
2358
2359     ret = regatom(pRExC_state, &flags);
2360     if (ret == NULL) {
2361         if (flags & TRYAGAIN)
2362             *flagp |= TRYAGAIN;
2363         return(NULL);
2364     }
2365
2366     op = *RExC_parse;
2367
2368     if (op == '{' && regcurly(RExC_parse)) {
2369         next = RExC_parse + 1;
2370         maxpos = Nullch;
2371         while (isDIGIT(*next) || *next == ',') {
2372             if (*next == ',') {
2373                 if (maxpos)
2374                     break;
2375                 else
2376                     maxpos = next;
2377             }
2378             next++;
2379         }
2380         if (*next == '}') {             /* got one */
2381             if (!maxpos)
2382                 maxpos = next;
2383             RExC_parse++;
2384             min = atoi(RExC_parse);
2385             if (*maxpos == ',')
2386                 maxpos++;
2387             else
2388                 maxpos = RExC_parse;
2389             max = atoi(maxpos);
2390             if (!max && *maxpos != '0')
2391                 max = REG_INFTY;                /* meaning "infinity" */
2392             else if (max >= REG_INFTY)
2393                 vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
2394             RExC_parse = next;
2395             nextchar(pRExC_state);
2396
2397         do_curly:
2398             if ((flags&SIMPLE)) {
2399                 RExC_naughty += 2 + RExC_naughty / 2;
2400                 reginsert(pRExC_state, CURLY, ret);
2401             }
2402             else {
2403                 regnode *w = reg_node(pRExC_state, WHILEM);
2404
2405                 w->flags = 0;
2406                 regtail(pRExC_state, ret, w);
2407                 if (!SIZE_ONLY && RExC_extralen) {
2408                     reginsert(pRExC_state, LONGJMP,ret);
2409                     reginsert(pRExC_state, NOTHING,ret);
2410                     NEXT_OFF(ret) = 3;  /* Go over LONGJMP. */
2411                 }
2412                 reginsert(pRExC_state, CURLYX,ret);
2413                 if (!SIZE_ONLY && RExC_extralen)
2414                     NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
2415                 regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
2416                 if (SIZE_ONLY)
2417                     RExC_whilem_seen++, RExC_extralen += 3;
2418                 RExC_naughty += 4 + RExC_naughty;       /* compound interest */
2419             }
2420             ret->flags = 0;
2421
2422             if (min > 0)
2423                 *flagp = WORST;
2424             if (max > 0)
2425                 *flagp |= HASWIDTH;
2426             if (max && max < min)
2427                 vFAIL("Can't do {n,m} with n > m");
2428             if (!SIZE_ONLY) {
2429                 ARG1_SET(ret, min);
2430                 ARG2_SET(ret, max);
2431             }
2432
2433             goto nest_check;
2434         }
2435     }
2436
2437     if (!ISMULT1(op)) {
2438         *flagp = flags;
2439         return(ret);
2440     }
2441
2442 #if 0                           /* Now runtime fix should be reliable. */
2443
2444     /* if this is reinstated, don't forget to put this back into perldiag:
2445
2446             =item Regexp *+ operand could be empty at {#} in regex m/%s/
2447
2448            (F) The part of the regexp subject to either the * or + quantifier
2449            could match an empty string. The {#} shows in the regular
2450            expression about where the problem was discovered.
2451
2452     */
2453
2454     if (!(flags&HASWIDTH) && op != '?')
2455       vFAIL("Regexp *+ operand could be empty");
2456 #endif
2457
2458     nextchar(pRExC_state);
2459
2460     *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
2461
2462     if (op == '*' && (flags&SIMPLE)) {
2463         reginsert(pRExC_state, STAR, ret);
2464         ret->flags = 0;
2465         RExC_naughty += 4;
2466     }
2467     else if (op == '*') {
2468         min = 0;
2469         goto do_curly;
2470     }
2471     else if (op == '+' && (flags&SIMPLE)) {
2472         reginsert(pRExC_state, PLUS, ret);
2473         ret->flags = 0;
2474         RExC_naughty += 3;
2475     }
2476     else if (op == '+') {
2477         min = 1;
2478         goto do_curly;
2479     }
2480     else if (op == '?') {
2481         min = 0; max = 1;
2482         goto do_curly;
2483     }
2484   nest_check:
2485     if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
2486         vWARN3(RExC_parse,
2487                "%.*s matches null string many times",
2488                RExC_parse - origparse,
2489                origparse);
2490     }
2491
2492     if (*RExC_parse == '?') {
2493         nextchar(pRExC_state);
2494         reginsert(pRExC_state, MINMOD, ret);
2495         regtail(pRExC_state, ret, ret + NODE_STEP_REGNODE);
2496     }
2497     if (ISMULT2(RExC_parse)) {
2498         RExC_parse++;
2499         vFAIL("Nested quantifiers");
2500     }
2501
2502     return(ret);
2503 }
2504
2505 /*
2506  - regatom - the lowest level
2507  *
2508  * Optimization:  gobbles an entire sequence of ordinary characters so that
2509  * it can turn them into a single node, which is smaller to store and
2510  * faster to run.  Backslashed characters are exceptions, each becoming a
2511  * separate node; the code is simpler that way and it's not worth fixing.
2512  *
2513  * [Yes, it is worth fixing, some scripts can run twice the speed.] */
2514 STATIC regnode *
2515 S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
2516 {
2517     dTHR;
2518     register regnode *ret = 0;
2519     I32 flags;
2520
2521     *flagp = WORST;             /* Tentatively. */
2522
2523 tryagain:
2524     switch (*RExC_parse) {
2525     case '^':
2526         RExC_seen_zerolen++;
2527         nextchar(pRExC_state);
2528         if (RExC_flags16 & PMf_MULTILINE)
2529             ret = reg_node(pRExC_state, MBOL);
2530         else if (RExC_flags16 & PMf_SINGLELINE)
2531             ret = reg_node(pRExC_state, SBOL);
2532         else
2533             ret = reg_node(pRExC_state, BOL);
2534         break;
2535     case '$':
2536         nextchar(pRExC_state);
2537         if (*RExC_parse)
2538             RExC_seen_zerolen++;
2539         if (RExC_flags16 & PMf_MULTILINE)
2540             ret = reg_node(pRExC_state, MEOL);
2541         else if (RExC_flags16 & PMf_SINGLELINE)
2542             ret = reg_node(pRExC_state, SEOL);
2543         else
2544             ret = reg_node(pRExC_state, EOL);
2545         break;
2546     case '.':
2547         nextchar(pRExC_state);
2548         if (UTF) {
2549             if (RExC_flags16 & PMf_SINGLELINE)
2550                 ret = reg_node(pRExC_state, SANYUTF8);
2551             else
2552                 ret = reg_node(pRExC_state, ANYUTF8);
2553             *flagp |= HASWIDTH;
2554         }
2555         else {
2556             if (RExC_flags16 & PMf_SINGLELINE)
2557                 ret = reg_node(pRExC_state, SANY);
2558             else
2559                 ret = reg_node(pRExC_state, REG_ANY);
2560             *flagp |= HASWIDTH|SIMPLE;
2561         }
2562         RExC_naughty++;
2563         break;
2564     case '[':
2565     {
2566         char *oregcomp_parse = ++RExC_parse;
2567         ret = (UTF ? regclassutf8(pRExC_state) : regclass(pRExC_state));
2568         if (*RExC_parse != ']') {
2569             RExC_parse = oregcomp_parse;
2570             vFAIL("Unmatched [");
2571         }
2572         nextchar(pRExC_state);
2573         *flagp |= HASWIDTH|SIMPLE;
2574         break;
2575     }
2576     case '(':
2577         nextchar(pRExC_state);
2578         ret = reg(pRExC_state, 1, &flags);
2579         if (ret == NULL) {
2580                 if (flags & TRYAGAIN) {
2581                     if (RExC_parse == RExC_end) {
2582                          /* Make parent create an empty node if needed. */
2583                         *flagp |= TRYAGAIN;
2584                         return(NULL);
2585                     }
2586                     goto tryagain;
2587                 }
2588                 return(NULL);
2589         }
2590         *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
2591         break;
2592     case '|':
2593     case ')':
2594         if (flags & TRYAGAIN) {
2595             *flagp |= TRYAGAIN;
2596             return NULL;
2597         }
2598         vFAIL("Internal urp");
2599                                 /* Supposed to be caught earlier. */
2600         break;
2601     case '{':
2602         if (!regcurly(RExC_parse)) {
2603             RExC_parse++;
2604             goto defchar;
2605         }
2606         /* FALL THROUGH */
2607     case '?':
2608     case '+':
2609     case '*':
2610         RExC_parse++;
2611         vFAIL("Quantifier follows nothing");
2612         break;
2613     case '\\':
2614         switch (*++RExC_parse) {
2615         case 'A':
2616             RExC_seen_zerolen++;
2617             ret = reg_node(pRExC_state, SBOL);
2618             *flagp |= SIMPLE;
2619             nextchar(pRExC_state);
2620             break;
2621         case 'G':
2622             ret = reg_node(pRExC_state, GPOS);
2623             RExC_seen |= REG_SEEN_GPOS;
2624             *flagp |= SIMPLE;
2625             nextchar(pRExC_state);
2626             break;
2627         case 'Z':
2628             ret = reg_node(pRExC_state, SEOL);
2629             *flagp |= SIMPLE;
2630             nextchar(pRExC_state);
2631             break;
2632         case 'z':
2633             ret = reg_node(pRExC_state, EOS);
2634             *flagp |= SIMPLE;
2635             RExC_seen_zerolen++;                /* Do not optimize RE away */
2636             nextchar(pRExC_state);
2637             break;
2638         case 'C':
2639             ret = reg_node(pRExC_state, SANY);
2640             *flagp |= HASWIDTH|SIMPLE;
2641             nextchar(pRExC_state);
2642             break;
2643         case 'X':
2644             ret = reg_node(pRExC_state, CLUMP);
2645             *flagp |= HASWIDTH;
2646             nextchar(pRExC_state);
2647             if (UTF && !PL_utf8_mark)
2648                 is_utf8_mark((U8*)"~");         /* preload table */
2649             break;
2650         case 'w':
2651             ret = reg_node(pRExC_state,
2652                 UTF
2653                     ? (LOC ? ALNUMLUTF8 : ALNUMUTF8)
2654                     : (LOC ? ALNUML     : ALNUM));
2655             *flagp |= HASWIDTH|SIMPLE;
2656             nextchar(pRExC_state);
2657             if (UTF && !PL_utf8_alnum)
2658                 is_utf8_alnum((U8*)"a");        /* preload table */
2659             break;
2660         case 'W':
2661             ret = reg_node(pRExC_state,
2662                 UTF
2663                     ? (LOC ? NALNUMLUTF8 : NALNUMUTF8)
2664                     : (LOC ? NALNUML     : NALNUM));
2665             *flagp |= HASWIDTH|SIMPLE;
2666             nextchar(pRExC_state);
2667             if (UTF && !PL_utf8_alnum)
2668                 is_utf8_alnum((U8*)"a");        /* preload table */
2669             break;
2670         case 'b':
2671             RExC_seen_zerolen++;
2672             RExC_seen |= REG_SEEN_LOOKBEHIND;
2673             ret = reg_node(pRExC_state,
2674                 UTF
2675                     ? (LOC ? BOUNDLUTF8 : BOUNDUTF8)
2676                     : (LOC ? BOUNDL     : BOUND));
2677             *flagp |= SIMPLE;
2678             nextchar(pRExC_state);
2679             if (UTF && !PL_utf8_alnum)
2680                 is_utf8_alnum((U8*)"a");        /* preload table */
2681             break;
2682         case 'B':
2683             RExC_seen_zerolen++;
2684             RExC_seen |= REG_SEEN_LOOKBEHIND;
2685             ret = reg_node(pRExC_state,
2686                 UTF
2687                     ? (LOC ? NBOUNDLUTF8 : NBOUNDUTF8)
2688                     : (LOC ? NBOUNDL     : NBOUND));
2689             *flagp |= SIMPLE;
2690             nextchar(pRExC_state);
2691             if (UTF && !PL_utf8_alnum)
2692                 is_utf8_alnum((U8*)"a");        /* preload table */
2693             break;
2694         case 's':
2695             ret = reg_node(pRExC_state,
2696                 UTF
2697                     ? (LOC ? SPACELUTF8 : SPACEUTF8)
2698                     : (LOC ? SPACEL     : SPACE));
2699             *flagp |= HASWIDTH|SIMPLE;
2700             nextchar(pRExC_state);
2701             if (UTF && !PL_utf8_space)
2702                 is_utf8_space((U8*)" ");        /* preload table */
2703             break;
2704         case 'S':
2705             ret = reg_node(pRExC_state,
2706                 UTF
2707                     ? (LOC ? NSPACELUTF8 : NSPACEUTF8)
2708                     : (LOC ? NSPACEL     : NSPACE));
2709             *flagp |= HASWIDTH|SIMPLE;
2710             nextchar(pRExC_state);
2711             if (UTF && !PL_utf8_space)
2712                 is_utf8_space((U8*)" ");        /* preload table */
2713             break;
2714         case 'd':
2715             ret = reg_node(pRExC_state, UTF ? DIGITUTF8 : DIGIT);
2716             *flagp |= HASWIDTH|SIMPLE;
2717             nextchar(pRExC_state);
2718             if (UTF && !PL_utf8_digit)
2719                 is_utf8_digit((U8*)"1");        /* preload table */
2720             break;
2721         case 'D':
2722             ret = reg_node(pRExC_state, UTF ? NDIGITUTF8 : NDIGIT);
2723             *flagp |= HASWIDTH|SIMPLE;
2724             nextchar(pRExC_state);
2725             if (UTF && !PL_utf8_digit)
2726                 is_utf8_digit((U8*)"1");        /* preload table */
2727             break;
2728         case 'p':
2729         case 'P':
2730             {   /* a lovely hack--pretend we saw [\pX] instead */
2731                 char* oldregxend = RExC_end;
2732
2733                 if (RExC_parse[1] == '{') {
2734                     RExC_end = strchr(RExC_parse, '}');
2735                     if (!RExC_end) {
2736                         RExC_parse += 2;
2737                         RExC_end = oldregxend;
2738                         vFAIL("Missing right brace on \\p{}");
2739                     }
2740                     RExC_end++;
2741                 }
2742                 else
2743                     RExC_end = RExC_parse + 2;
2744                 RExC_parse--;
2745
2746                 ret = regclassutf8(pRExC_state);
2747
2748                 RExC_end = oldregxend;
2749                 RExC_parse--;
2750                 nextchar(pRExC_state);
2751                 *flagp |= HASWIDTH|SIMPLE;
2752             }
2753             break;
2754         case 'n':
2755         case 'r':
2756         case 't':
2757         case 'f':
2758         case 'e':
2759         case 'a':
2760         case 'x':
2761         case 'c':
2762         case '0':
2763             goto defchar;
2764         case '1': case '2': case '3': case '4':
2765         case '5': case '6': case '7': case '8': case '9':
2766             {
2767                 I32 num = atoi(RExC_parse);
2768
2769                 if (num > 9 && num >= RExC_npar)
2770                     goto defchar;
2771                 else {
2772                     while (isDIGIT(*RExC_parse))
2773                         RExC_parse++;
2774
2775                     if (!SIZE_ONLY && num > RExC_rx->nparens)
2776                         vFAIL("Reference to nonexistent group");
2777                     RExC_sawback = 1;
2778                     ret = reganode(pRExC_state, FOLD
2779                                    ? (LOC ? REFFL : REFF)
2780                                    : REF, num);
2781                     *flagp |= HASWIDTH;
2782                     RExC_parse--;
2783                     nextchar(pRExC_state);
2784                 }
2785             }
2786             break;
2787         case '\0':
2788             if (RExC_parse >= RExC_end)
2789                 FAIL("Trailing \\");
2790             /* FALL THROUGH */
2791         default:
2792             /* Do not generate `unrecognized' warnings here, we fall
2793                back into the quick-grab loop below */
2794             goto defchar;
2795         }
2796         break;
2797
2798     case '#':
2799         if (RExC_flags16 & PMf_EXTENDED) {
2800             while (RExC_parse < RExC_end && *RExC_parse != '\n') RExC_parse++;
2801             if (RExC_parse < RExC_end)
2802                 goto tryagain;
2803         }
2804         /* FALL THROUGH */
2805
2806     default: {
2807             register STRLEN len;
2808             register UV ender;
2809             register char *p;
2810             char *oldp, *s;
2811             STRLEN numlen;
2812
2813             RExC_parse++;
2814
2815         defchar:
2816             ret = reg_node(pRExC_state, FOLD
2817                           ? (LOC ? EXACTFL : EXACTF)
2818                           : EXACT);
2819             s = STRING(ret);
2820             for (len = 0, p = RExC_parse - 1;
2821               len < 127 && p < RExC_end;
2822               len++)
2823             {
2824                 oldp = p;
2825
2826                 if (RExC_flags16 & PMf_EXTENDED)
2827                     p = regwhite(p, RExC_end);
2828                 switch (*p) {
2829                 case '^':
2830                 case '$':
2831                 case '.':
2832                 case '[':
2833                 case '(':
2834                 case ')':
2835                 case '|':
2836                     goto loopdone;
2837                 case '\\':
2838                     switch (*++p) {
2839                     case 'A':
2840                     case 'G':
2841                     case 'Z':
2842                     case 'z':
2843                     case 'w':
2844                     case 'W':
2845                     case 'b':
2846                     case 'B':
2847                     case 's':
2848                     case 'S':
2849                     case 'd':
2850                     case 'D':
2851                     case 'p':
2852                     case 'P':
2853                         --p;
2854                         goto loopdone;
2855                     case 'n':
2856                         ender = '\n';
2857                         p++;
2858                         break;
2859                     case 'r':
2860                         ender = '\r';
2861                         p++;
2862                         break;
2863                     case 't':
2864                         ender = '\t';
2865                         p++;
2866                         break;
2867                     case 'f':
2868                         ender = '\f';
2869                         p++;
2870                         break;
2871                     case 'e':
2872 #ifdef ASCIIish
2873                           ender = '\033';
2874 #else
2875                           ender = '\047';
2876 #endif
2877                         p++;
2878                         break;
2879                     case 'a':
2880 #ifdef ASCIIish
2881                           ender = '\007';
2882 #else
2883                           ender = '\057';
2884 #endif
2885                         p++;
2886                         break;
2887                     case 'x':
2888                         if (*++p == '{') {
2889                             char* e = strchr(p, '}');
2890
2891                             if (!e) {
2892                                 RExC_parse = p + 1;
2893                                 vFAIL("Missing right brace on \\x{}");
2894                             }
2895                             else if (UTF) {
2896                                 numlen = 1;     /* allow underscores */
2897                                 ender = (UV)scan_hex(p + 1, e - p - 1, &numlen);
2898                                 /* numlen is generous */
2899                                 if (numlen + len >= 127) {
2900                                     p--;
2901                                     goto loopdone;
2902                                 }
2903                                 p = e + 1;
2904                             }
2905                             else
2906                             {
2907                                 RExC_parse = e + 1;
2908                                 vFAIL("Can't use \\x{} without 'use utf8' declaration");
2909                             }
2910
2911                         }
2912                         else {
2913                             numlen = 0;         /* disallow underscores */
2914                             ender = (UV)scan_hex(p, 2, &numlen);
2915                             p += numlen;
2916                         }
2917                         break;
2918                     case 'c':
2919                         p++;
2920                         ender = UCHARAT(p++);
2921                         ender = toCTRL(ender);
2922                         break;
2923                     case '0': case '1': case '2': case '3':case '4':
2924                     case '5': case '6': case '7': case '8':case '9':
2925                         if (*p == '0' ||
2926                           (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
2927                             numlen = 0;         /* disallow underscores */
2928                             ender = (UV)scan_oct(p, 3, &numlen);
2929                             p += numlen;
2930                         }
2931                         else {
2932                             --p;
2933                             goto loopdone;
2934                         }
2935                         break;
2936                     case '\0':
2937                         if (p >= RExC_end)
2938                             FAIL("Trailing \\");
2939                         /* FALL THROUGH */
2940                     default:
2941                         if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
2942                             vWARN2(p +1, "Unrecognized escape \\%c passed through", *p);
2943                         goto normal_default;
2944                     }
2945                     break;
2946                 default:
2947                   normal_default:
2948                     if ((*p & 0xc0) == 0xc0 && UTF) {
2949                         ender = utf8_to_uv((U8*)p, RExC_end - p,
2950                                                &numlen, 0);
2951                         p += numlen;
2952                     }
2953                     else
2954                         ender = *p++;
2955                     break;
2956                 }
2957                 if (RExC_flags16 & PMf_EXTENDED)
2958                     p = regwhite(p, RExC_end);
2959                 if (UTF && FOLD) {
2960                     if (LOC)
2961                         ender = toLOWER_LC_uni(ender);
2962                     else
2963                         ender = toLOWER_uni(ender);
2964                 }
2965                 if (ISMULT2(p)) { /* Back off on ?+*. */
2966                     if (len)
2967                         p = oldp;
2968                     else if (ender >= 0x80 && UTF) {
2969                         reguni(pRExC_state, ender, s, &numlen);
2970                         s += numlen;
2971                         len += numlen;
2972                     }
2973                     else {
2974                         len++;
2975                         REGC(ender, s++);
2976                     }
2977                     break;
2978                 }
2979                 if (ender >= 0x80 && UTF) {
2980                     reguni(pRExC_state, ender, s, &numlen);
2981                     s += numlen;
2982                     len += numlen - 1;
2983                 }
2984                 else
2985                     REGC(ender, s++);
2986             }
2987         loopdone:
2988             RExC_parse = p - 1;
2989             nextchar(pRExC_state);
2990             if (len < 0)
2991                 vFAIL("Internal disaster");
2992             if (len > 0)
2993                 *flagp |= HASWIDTH;
2994             if (len == 1)
2995                 *flagp |= SIMPLE;
2996             if (!SIZE_ONLY)
2997                 STR_LEN(ret) = len;
2998             if (SIZE_ONLY)
2999                 RExC_size += STR_SZ(len);
3000             else
3001                 RExC_emit += STR_SZ(len);
3002         }
3003         break;
3004     }
3005
3006     return(ret);
3007 }
3008
3009 STATIC char *
3010 S_regwhite(pTHX_ char *p, char *e)
3011 {
3012     while (p < e) {
3013         if (isSPACE(*p))
3014             ++p;
3015         else if (*p == '#') {
3016             do {
3017                 p++;
3018             } while (p < e && *p != '\n');
3019         }
3020         else
3021             break;
3022     }
3023     return p;
3024 }
3025
3026 /* Parse POSIX character classes: [[:foo:]], [[=foo=]], [[.foo.]].
3027    Character classes ([:foo:]) can also be negated ([:^foo:]).
3028    Returns a named class id (ANYOF_XXX) if successful, -1 otherwise.
3029    Equivalence classes ([=foo=]) and composites ([.foo.]) are parsed,
3030    but trigger warnings because they are currently unimplemented. */
3031 STATIC I32
3032 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
3033 {
3034     dTHR;
3035     char *posixcc = 0;
3036     I32 namedclass = OOB_NAMEDCLASS;
3037
3038     if (value == '[' && RExC_parse + 1 < RExC_end &&
3039         /* I smell either [: or [= or [. -- POSIX has been here, right? */
3040         (*RExC_parse == ':' ||
3041          *RExC_parse == '=' ||
3042          *RExC_parse == '.')) {
3043         char  c = *RExC_parse;
3044         char* s = RExC_parse++;
3045
3046         while (RExC_parse < RExC_end && *RExC_parse != c)
3047             RExC_parse++;
3048         if (RExC_parse == RExC_end)
3049             /* Grandfather lone [:, [=, [. */
3050             RExC_parse = s;
3051         else {
3052             char* t = RExC_parse++; /* skip over the c */
3053
3054             if (*RExC_parse == ']') {
3055                 RExC_parse++; /* skip over the ending ] */
3056                 posixcc = s + 1;
3057                 if (*s == ':') {
3058                     I32 complement = *posixcc == '^' ? *posixcc++ : 0;
3059                     I32 skip = 5; /* the most common skip */
3060
3061                     switch (*posixcc) {
3062                     case 'a':
3063                         if (strnEQ(posixcc, "alnum", 5))
3064                             namedclass =
3065                                 complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
3066                         else if (strnEQ(posixcc, "alpha", 5))
3067                             namedclass =
3068                                 complement ? ANYOF_NALPHA : ANYOF_ALPHA;
3069                         else if (strnEQ(posixcc, "ascii", 5))
3070                             namedclass =
3071                                 complement ? ANYOF_NASCII : ANYOF_ASCII;
3072                         break;
3073                     case 'b':
3074                         if (strnEQ(posixcc, "blank", 5))
3075                             namedclass =
3076                                 complement ? ANYOF_NBLANK : ANYOF_BLANK;
3077                         break;
3078                     case 'c':
3079                         if (strnEQ(posixcc, "cntrl", 5))
3080                             namedclass =
3081                                 complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
3082                         break;
3083                     case 'd':
3084                         if (strnEQ(posixcc, "digit", 5))
3085                             namedclass =
3086                                 complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
3087                         break;
3088                     case 'g':
3089                         if (strnEQ(posixcc, "graph", 5))
3090                             namedclass =
3091                                 complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
3092                         break;
3093                     case 'l':
3094                         if (strnEQ(posixcc, "lower", 5))
3095                             namedclass =
3096                                 complement ? ANYOF_NLOWER : ANYOF_LOWER;
3097                         break;
3098                     case 'p':
3099                         if (strnEQ(posixcc, "print", 5))
3100                             namedclass =
3101                                 complement ? ANYOF_NPRINT : ANYOF_PRINT;
3102                         else if (strnEQ(posixcc, "punct", 5))
3103                             namedclass =
3104                                 complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
3105                         break;
3106                     case 's':
3107                         if (strnEQ(posixcc, "space", 5))
3108                             namedclass =
3109                                 complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
3110                         break;
3111                     case 'u':
3112                         if (strnEQ(posixcc, "upper", 5))
3113                             namedclass =
3114                                 complement ? ANYOF_NUPPER : ANYOF_UPPER;
3115                         break;
3116                     case 'w': /* this is not POSIX, this is the Perl \w */
3117                         if (strnEQ(posixcc, "word", 4)) {
3118                             namedclass =
3119                                 complement ? ANYOF_NALNUM : ANYOF_ALNUM;
3120                             skip = 4;
3121                         }
3122                         break;
3123                     case 'x':
3124                         if (strnEQ(posixcc, "xdigit", 6)) {
3125                             namedclass =
3126                                 complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
3127                             skip = 6;
3128                         }
3129                         break;
3130                     }
3131                     if (namedclass == OOB_NAMEDCLASS ||
3132                         posixcc[skip] != ':' ||
3133                         posixcc[skip+1] != ']')
3134                     {
3135                         Simple_vFAIL3("POSIX class [:%.*s:] unknown",
3136                                       t - s - 1, s + 1);
3137                     }
3138                 } else if (!SIZE_ONLY) {
3139                     /* [[=foo=]] and [[.foo.]] are still future. */
3140
3141                     /* adjust RExC_parse so the warning shows after
3142                        the class closes */
3143                     while (*RExC_parse && *RExC_parse != ']')
3144                         RExC_parse++;
3145                     Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3146                 }
3147             } else {
3148                 /* Maternal grandfather:
3149                  * "[:" ending in ":" but not in ":]" */
3150                 RExC_parse = s;
3151             }
3152         }
3153     }
3154
3155     return namedclass;
3156 }
3157
3158 STATIC void
3159 S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
3160 {
3161     if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
3162         (*RExC_parse == ':' ||
3163          *RExC_parse == '=' ||
3164          *RExC_parse == '.')) {
3165         char *s = RExC_parse;
3166         char  c = *s++;
3167
3168         while(*s && isALNUM(*s))
3169             s++;
3170         if (*s && c == *s && s[1] == ']') {
3171             vWARN3(s+2, "POSIX syntax [%c %c] belongs inside character classes", c, c);
3172
3173             /* [[=foo=]] and [[.foo.]] are still future. */
3174             if (c == '=' || c == '.')
3175             {
3176                 /* adjust RExC_parse so the error shows after
3177                    the class closes */
3178                 while (*RExC_parse && *RExC_parse++ != ']')
3179                     ;
3180                 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3181             }
3182         }
3183     }
3184 }
3185
3186 STATIC regnode *
3187 S_regclass(pTHX_ RExC_state_t *pRExC_state)
3188 {
3189     dTHR;
3190     register U32 value;
3191     register I32 lastvalue = OOB_CHAR8;
3192     register I32 range = 0;
3193     register regnode *ret;
3194     STRLEN numlen;
3195     I32 namedclass;
3196     char *rangebegin;
3197     bool need_class = 0;
3198
3199     ret = reg_node(pRExC_state, ANYOF);
3200     if (SIZE_ONLY)
3201         RExC_size += ANYOF_SKIP;
3202     else {
3203         ret->flags = 0;
3204         ANYOF_BITMAP_ZERO(ret);
3205         RExC_emit += ANYOF_SKIP;
3206         if (FOLD)
3207             ANYOF_FLAGS(ret) |= ANYOF_FOLD;
3208         if (LOC)
3209             ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
3210     }
3211     if (*RExC_parse == '^') {   /* Complement of range. */
3212         RExC_naughty++;
3213         RExC_parse++;
3214         if (!SIZE_ONLY)
3215             ANYOF_FLAGS(ret) |= ANYOF_INVERT;
3216     }
3217
3218     if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
3219         checkposixcc(pRExC_state);
3220
3221     if (*RExC_parse == ']' || *RExC_parse == '-')
3222         goto skipcond;          /* allow 1st char to be ] or - */
3223     while (RExC_parse < RExC_end && *RExC_parse != ']') {
3224        skipcond:
3225         namedclass = OOB_NAMEDCLASS;
3226         if (!range)
3227             rangebegin = RExC_parse;
3228         value = UCHARAT(RExC_parse++);
3229         if (value == '[')
3230             namedclass = regpposixcc(pRExC_state, value);
3231         else if (value == '\\') {
3232             value = UCHARAT(RExC_parse++);
3233             /* Some compilers cannot handle switching on 64-bit integer
3234              * values, therefore the 'value' cannot be an UV. --jhi */
3235             switch (value) {
3236             case 'w':   namedclass = ANYOF_ALNUM;       break;
3237             case 'W':   namedclass = ANYOF_NALNUM;      break;
3238             case 's':   namedclass = ANYOF_SPACE;       break;
3239             case 'S':   namedclass = ANYOF_NSPACE;      break;
3240             case 'd':   namedclass = ANYOF_DIGIT;       break;
3241             case 'D':   namedclass = ANYOF_NDIGIT;      break;
3242             case 'n':   value = '\n';                   break;
3243             case 'r':   value = '\r';                   break;
3244             case 't':   value = '\t';                   break;
3245             case 'f':   value = '\f';                   break;
3246             case 'b':   value = '\b';                   break;
3247 #ifdef ASCIIish
3248             case 'e':   value = '\033';                 break;
3249             case 'a':   value = '\007';                 break;
3250 #else
3251             case 'e':   value = '\047';                 break;
3252             case 'a':   value = '\057';                 break;
3253 #endif
3254             case 'x':
3255                 numlen = 0;             /* disallow underscores */
3256                 value = (UV)scan_hex(RExC_parse, 2, &numlen);
3257                 RExC_parse += numlen;
3258                 break;
3259             case 'c':
3260                 value = UCHARAT(RExC_parse++);
3261                 value = toCTRL(value);
3262                 break;
3263             case '0': case '1': case '2': case '3': case '4':
3264             case '5': case '6': case '7': case '8': case '9':
3265                 numlen = 0;             /* disallow underscores */
3266                 value = (UV)scan_oct(--RExC_parse, 3, &numlen);
3267                 RExC_parse += numlen;
3268                 break;
3269             default:
3270                 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
3271
3272                     vWARN2(RExC_parse, "Unrecognized escape \\%c in character class passed through", (int)value);
3273                 break;
3274             }
3275         }
3276         if (namedclass > OOB_NAMEDCLASS) {
3277             if (!need_class && !SIZE_ONLY)
3278                 ANYOF_CLASS_ZERO(ret);
3279             need_class = 1;
3280             if (range) { /* a-\d, a-[:digit:] */
3281                 if (!SIZE_ONLY) {
3282                     if (ckWARN(WARN_REGEXP))
3283                         vWARN4(RExC_parse,
3284                                "False [] range \"%*.*s\"",
3285                                RExC_parse - rangebegin,
3286                                RExC_parse - rangebegin,
3287                                rangebegin);
3288                     ANYOF_BITMAP_SET(ret, lastvalue);
3289                     ANYOF_BITMAP_SET(ret, '-');
3290                 }
3291                 range = 0; /* this is not a true range */
3292             }
3293             if (!SIZE_ONLY) {
3294                 switch (namedclass) {
3295                 case ANYOF_ALNUM:
3296                     if (LOC)
3297                         ANYOF_CLASS_SET(ret, ANYOF_ALNUM);
3298                     else {
3299                         for (value = 0; value < 256; value++)
3300                             if (isALNUM(value))
3301                                 ANYOF_BITMAP_SET(ret, value);
3302                     }
3303                     break;
3304                 case ANYOF_NALNUM:
3305                     if (LOC)
3306                         ANYOF_CLASS_SET(ret, ANYOF_NALNUM);
3307                     else {
3308                         for (value = 0; value < 256; value++)
3309                             if (!isALNUM(value))
3310                                 ANYOF_BITMAP_SET(ret, value);
3311                     }
3312                     break;
3313                 case ANYOF_SPACE:
3314                     if (LOC)
3315                         ANYOF_CLASS_SET(ret, ANYOF_SPACE);
3316                     else {
3317                         for (value = 0; value < 256; value++)
3318                             if (isSPACE(value))
3319                                 ANYOF_BITMAP_SET(ret, value);
3320                     }
3321                     break;
3322                 case ANYOF_NSPACE:
3323                     if (LOC)
3324                         ANYOF_CLASS_SET(ret, ANYOF_NSPACE);
3325                     else {
3326                         for (value = 0; value < 256; value++)
3327                             if (!isSPACE(value))
3328                                 ANYOF_BITMAP_SET(ret, value);
3329                     }
3330                     break;
3331                 case ANYOF_DIGIT:
3332                     if (LOC)
3333                         ANYOF_CLASS_SET(ret, ANYOF_DIGIT);
3334                     else {
3335                         for (value = '0'; value <= '9'; value++)
3336                             ANYOF_BITMAP_SET(ret, value);
3337                     }
3338                     break;
3339                 case ANYOF_NDIGIT:
3340                     if (LOC)
3341                         ANYOF_CLASS_SET(ret, ANYOF_NDIGIT);
3342                     else {
3343                         for (value = 0; value < '0'; value++)
3344                             ANYOF_BITMAP_SET(ret, value);
3345                         for (value = '9' + 1; value < 256; value++)
3346                             ANYOF_BITMAP_SET(ret, value);
3347                     }
3348                     break;
3349                 case ANYOF_NALNUMC:
3350                     if (LOC)
3351                         ANYOF_CLASS_SET(ret, ANYOF_NALNUMC);
3352                     else {
3353                         for (value = 0; value < 256; value++)
3354                             if (!isALNUMC(value))
3355                                 ANYOF_BITMAP_SET(ret, value);
3356                     }
3357                     break;
3358                 case ANYOF_ALNUMC:
3359                     if (LOC)
3360                         ANYOF_CLASS_SET(ret, ANYOF_ALNUMC);
3361                     else {
3362                         for (value = 0; value < 256; value++)
3363                             if (isALNUMC(value))
3364                                 ANYOF_BITMAP_SET(ret, value);
3365                     }
3366                     break;
3367                 case ANYOF_ALPHA:
3368                     if (LOC)
3369                         ANYOF_CLASS_SET(ret, ANYOF_ALPHA);
3370                     else {
3371                         for (value = 0; value < 256; value++)
3372                             if (isALPHA(value))
3373                                 ANYOF_BITMAP_SET(ret, value);
3374                     }
3375                     break;
3376                 case ANYOF_NALPHA:
3377                     if (LOC)
3378                         ANYOF_CLASS_SET(ret, ANYOF_NALPHA);
3379                     else {
3380                         for (value = 0; value < 256; value++)
3381                             if (!isALPHA(value))
3382                                 ANYOF_BITMAP_SET(ret, value);
3383                     }
3384                     break;
3385                 case ANYOF_ASCII:
3386                     if (LOC)
3387                         ANYOF_CLASS_SET(ret, ANYOF_ASCII);
3388                     else {
3389 #ifdef ASCIIish
3390                         for (value = 0; value < 128; value++)
3391                             ANYOF_BITMAP_SET(ret, value);
3392 #else  /* EBCDIC */
3393                         for (value = 0; value < 256; value++)
3394                             if (isASCII(value))
3395                                 ANYOF_BITMAP_SET(ret, value);
3396 #endif /* EBCDIC */
3397                     }
3398                     break;
3399                 case ANYOF_NASCII:
3400                     if (LOC)
3401                         ANYOF_CLASS_SET(ret, ANYOF_NASCII);
3402                     else {
3403 #ifdef ASCIIish
3404                         for (value = 128; value < 256; value++)
3405                             ANYOF_BITMAP_SET(ret, value);
3406 #else  /* EBCDIC */
3407                         for (value = 0; value < 256; value++)
3408                             if (!isASCII(value))
3409                                 ANYOF_BITMAP_SET(ret, value);
3410 #endif /* EBCDIC */
3411                     }
3412                     break;
3413                 case ANYOF_BLANK:
3414                     if (LOC)
3415                         ANYOF_CLASS_SET(ret, ANYOF_BLANK);
3416                     else {
3417                         for (value = 0; value < 256; value++)
3418                             if (isBLANK(value))
3419                                 ANYOF_BITMAP_SET(ret, value);
3420                     }
3421                     break;
3422                 case ANYOF_NBLANK:
3423                     if (LOC)
3424                         ANYOF_CLASS_SET(ret, ANYOF_NBLANK);
3425                     else {
3426                         for (value = 0; value < 256; value++)
3427                             if (!isBLANK(value))
3428                                 ANYOF_BITMAP_SET(ret, value);
3429                     }
3430                     break;
3431                 case ANYOF_CNTRL:
3432                     if (LOC)
3433                         ANYOF_CLASS_SET(ret, ANYOF_CNTRL);
3434                     else {
3435                         for (value = 0; value < 256; value++)
3436                             if (isCNTRL(value))
3437                                 ANYOF_BITMAP_SET(ret, value);
3438                     }
3439                     lastvalue = OOB_CHAR8;
3440                     break;
3441                 case ANYOF_NCNTRL:
3442                     if (LOC)
3443                         ANYOF_CLASS_SET(ret, ANYOF_NCNTRL);
3444                     else {
3445                         for (value = 0; value < 256; value++)
3446                             if (!isCNTRL(value))
3447                                 ANYOF_BITMAP_SET(ret, value);
3448                     }
3449                     break;
3450                 case ANYOF_GRAPH:
3451                     if (LOC)
3452                         ANYOF_CLASS_SET(ret, ANYOF_GRAPH);
3453                     else {
3454                         for (value = 0; value < 256; value++)
3455                             if (isGRAPH(value))
3456                                 ANYOF_BITMAP_SET(ret, value);
3457                     }
3458                     break;
3459                 case ANYOF_NGRAPH:
3460                     if (LOC)
3461                         ANYOF_CLASS_SET(ret, ANYOF_NGRAPH);
3462                     else {
3463                         for (value = 0; value < 256; value++)
3464                             if (!isGRAPH(value))
3465                                 ANYOF_BITMAP_SET(ret, value);
3466                     }
3467                     break;
3468                 case ANYOF_LOWER:
3469                     if (LOC)
3470                         ANYOF_CLASS_SET(ret, ANYOF_LOWER);
3471                     else {
3472                         for (value = 0; value < 256; value++)
3473                             if (isLOWER(value))
3474                                 ANYOF_BITMAP_SET(ret, value);
3475                     }
3476                     break;
3477                 case ANYOF_NLOWER:
3478                     if (LOC)
3479                         ANYOF_CLASS_SET(ret, ANYOF_NLOWER);
3480                     else {
3481                         for (value = 0; value < 256; value++)
3482                             if (!isLOWER(value))
3483                                 ANYOF_BITMAP_SET(ret, value);
3484                     }
3485                     break;
3486                 case ANYOF_PRINT:
3487                     if (LOC)
3488                         ANYOF_CLASS_SET(ret, ANYOF_PRINT);
3489                     else {
3490                         for (value = 0; value < 256; value++)
3491                             if (isPRINT(value))
3492                                 ANYOF_BITMAP_SET(ret, value);
3493                     }
3494                     break;
3495                 case ANYOF_NPRINT:
3496                     if (LOC)
3497                         ANYOF_CLASS_SET(ret, ANYOF_NPRINT);
3498                     else {
3499                         for (value = 0; value < 256; value++)
3500                             if (!isPRINT(value))
3501                                 ANYOF_BITMAP_SET(ret, value);
3502                     }
3503                     break;
3504                 case ANYOF_PSXSPC:
3505                     if (LOC)
3506                         ANYOF_CLASS_SET(ret, ANYOF_PSXSPC);
3507                     else {
3508                         for (value = 0; value < 256; value++)
3509                             if (isPSXSPC(value))
3510                                 ANYOF_BITMAP_SET(ret, value);
3511                     }
3512                     break;
3513                 case ANYOF_NPSXSPC:
3514                     if (LOC)
3515                         ANYOF_CLASS_SET(ret, ANYOF_NPSXSPC);
3516                     else {
3517                         for (value = 0; value < 256; value++)
3518                             if (!isPSXSPC(value))
3519                                 ANYOF_BITMAP_SET(ret, value);
3520                     }
3521                     break;
3522                 case ANYOF_PUNCT:
3523                     if (LOC)
3524                         ANYOF_CLASS_SET(ret, ANYOF_PUNCT);
3525                     else {
3526                         for (value = 0; value < 256; value++)
3527                             if (isPUNCT(value))
3528                                 ANYOF_BITMAP_SET(ret, value);
3529                     }
3530                     break;
3531                 case ANYOF_NPUNCT:
3532                     if (LOC)
3533                         ANYOF_CLASS_SET(ret, ANYOF_NPUNCT);
3534                     else {
3535                         for (value = 0; value < 256; value++)
3536                             if (!isPUNCT(value))
3537                                 ANYOF_BITMAP_SET(ret, value);
3538                     }
3539                     break;
3540                 case ANYOF_UPPER:
3541                     if (LOC)
3542                         ANYOF_CLASS_SET(ret, ANYOF_UPPER);
3543                     else {
3544                         for (value = 0; value < 256; value++)
3545                             if (isUPPER(value))
3546                                 ANYOF_BITMAP_SET(ret, value);
3547                     }
3548                     break;
3549                 case ANYOF_NUPPER:
3550                     if (LOC)
3551                         ANYOF_CLASS_SET(ret, ANYOF_NUPPER);
3552                     else {
3553                         for (value = 0; value < 256; value++)
3554                             if (!isUPPER(value))
3555                                 ANYOF_BITMAP_SET(ret, value);
3556                     }
3557                     break;
3558                 case ANYOF_XDIGIT:
3559                     if (LOC)
3560                         ANYOF_CLASS_SET(ret, ANYOF_XDIGIT);
3561                     else {
3562                         for (value = 0; value < 256; value++)
3563                             if (isXDIGIT(value))
3564                                 ANYOF_BITMAP_SET(ret, value);
3565                     }
3566                     break;
3567                 case ANYOF_NXDIGIT:
3568                     if (LOC)
3569                         ANYOF_CLASS_SET(ret, ANYOF_NXDIGIT);
3570                     else {
3571                         for (value = 0; value < 256; value++)
3572                             if (!isXDIGIT(value))
3573                                 ANYOF_BITMAP_SET(ret, value);
3574                     }
3575                     break;
3576                 default:
3577                     vFAIL("Invalid [::] class");
3578                     break;
3579                 }
3580                 if (LOC)
3581                     ANYOF_FLAGS(ret) |= ANYOF_CLASS;
3582                 continue;
3583             }
3584         }
3585         if (range) {
3586             if (lastvalue > value) /* b-a */ {
3587                 Simple_vFAIL4("Invalid [] range \"%*.*s\"",
3588                               RExC_parse - rangebegin,
3589                               RExC_parse - rangebegin,
3590                               rangebegin);
3591             }
3592             range = 0;
3593         }
3594         else {
3595             lastvalue = value;
3596             if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
3597                 RExC_parse[1] != ']') {
3598                 RExC_parse++;
3599                 if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
3600                     if (ckWARN(WARN_REGEXP))
3601                         vWARN4(RExC_parse,
3602                                "False [] range \"%*.*s\"",
3603                                RExC_parse - rangebegin,
3604                                RExC_parse - rangebegin,
3605                                rangebegin);
3606                     if (!SIZE_ONLY)
3607                         ANYOF_BITMAP_SET(ret, '-');
3608                 } else
3609                     range = 1;
3610                 continue;       /* do it next time */
3611             }
3612         }
3613         /* now is the next time */
3614         if (!SIZE_ONLY) {
3615 #ifndef ASCIIish /* EBCDIC, for example. */
3616             if ((isLOWER(lastvalue) && isLOWER(value)) ||
3617                 (isUPPER(lastvalue) && isUPPER(value)))
3618             {
3619                 I32 i;
3620                 if (isLOWER(lastvalue)) {
3621                     for (i = lastvalue; i <= value; i++)
3622                         if (isLOWER(i))
3623                             ANYOF_BITMAP_SET(ret, i);
3624                 } else {
3625                     for (i = lastvalue; i <= value; i++)
3626                         if (isUPPER(i))
3627                             ANYOF_BITMAP_SET(ret, i);
3628                 }
3629             }
3630             else
3631 #endif
3632                 for ( ; lastvalue <= value; lastvalue++)
3633                     ANYOF_BITMAP_SET(ret, lastvalue);
3634         }
3635         range = 0;
3636     }
3637     if (need_class) {
3638         if (SIZE_ONLY)
3639             RExC_size += ANYOF_CLASS_ADD_SKIP;
3640         else
3641             RExC_emit += ANYOF_CLASS_ADD_SKIP;
3642     }
3643     /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
3644     if (!SIZE_ONLY &&
3645         (ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) {
3646         for (value = 0; value < 256; ++value) {
3647             if (ANYOF_BITMAP_TEST(ret, value)) {
3648                 I32 cf = PL_fold[value];
3649                 ANYOF_BITMAP_SET(ret, cf);
3650             }
3651         }
3652         ANYOF_FLAGS(ret) &= ~ANYOF_FOLD;
3653     }
3654     /* optimize inverted simple patterns (e.g. [^a-z]) */
3655     if (!SIZE_ONLY && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
3656         for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
3657             ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL;
3658         ANYOF_FLAGS(ret) = 0;
3659     }
3660     return ret;
3661 }
3662
3663 STATIC regnode *
3664 S_regclassutf8(pTHX_ RExC_state_t *pRExC_state)
3665 {
3666     dTHR;
3667     register char *e;
3668     register U32 value;
3669     register U32 lastvalue = OOB_UTF8;
3670     register I32 range = 0;
3671     register regnode *ret;
3672     STRLEN numlen;
3673     I32 n;
3674     SV *listsv;
3675     U8 flags = 0;
3676     I32 namedclass;
3677     char *rangebegin;
3678
3679     if (*RExC_parse == '^') {   /* Complement of range. */
3680         RExC_naughty++;
3681         RExC_parse++;
3682         if (!SIZE_ONLY)
3683             flags |= ANYOF_INVERT;
3684     }
3685     if (!SIZE_ONLY) {
3686         if (FOLD)
3687             flags |= ANYOF_FOLD;
3688         if (LOC)
3689             flags |= ANYOF_LOCALE;
3690         listsv = newSVpvn("# comment\n",10);
3691     }
3692
3693     if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
3694         checkposixcc(pRExC_state);
3695
3696     if (*RExC_parse == ']' || *RExC_parse == '-')
3697         goto skipcond;          /* allow 1st char to be ] or - */
3698
3699     while (RExC_parse < RExC_end && *RExC_parse != ']') {
3700        skipcond:
3701         namedclass = OOB_NAMEDCLASS;
3702         if (!range)
3703             rangebegin = RExC_parse;
3704         value = utf8_to_uv((U8*)RExC_parse,
3705                                RExC_end - RExC_parse,
3706                                &numlen, 0);
3707         RExC_parse += numlen;
3708         if (value == '[')
3709             namedclass = regpposixcc(pRExC_state, value);
3710         else if (value == '\\') {
3711             value = (U32)utf8_to_uv((U8*)RExC_parse,
3712                                         RExC_end - RExC_parse,
3713                                         &numlen, 0);
3714             RExC_parse += numlen;
3715             /* Some compilers cannot handle switching on 64-bit integer
3716              * values, therefore value cannot be an UV.  Yes, this will
3717              * be a problem later if we want switch on Unicode.  --jhi */
3718             switch (value) {
3719             case 'w':           namedclass = ANYOF_ALNUM;               break;
3720             case 'W':           namedclass = ANYOF_NALNUM;              break;
3721             case 's':           namedclass = ANYOF_SPACE;               break;
3722             case 'S':           namedclass = ANYOF_NSPACE;              break;
3723             case 'd':           namedclass = ANYOF_DIGIT;               break;
3724             case 'D':           namedclass = ANYOF_NDIGIT;              break;
3725             case 'p':
3726             case 'P':
3727                 if (*RExC_parse == '{') {
3728                     e = strchr(RExC_parse++, '}');
3729                     if (!e)
3730                         vFAIL("Missing right brace on \\p{}");
3731                     n = e - RExC_parse;
3732                 }
3733                 else {
3734                     e = RExC_parse;
3735                     n = 1;
3736                 }
3737                 if (!SIZE_ONLY) {
3738                     if (value == 'p')
3739                         Perl_sv_catpvf(aTHX_ listsv,
3740                                        "+utf8::%.*s\n", (int)n, RExC_parse);
3741                     else
3742                         Perl_sv_catpvf(aTHX_ listsv,
3743                                        "!utf8::%.*s\n", (int)n, RExC_parse);
3744                 }
3745                 RExC_parse = e + 1;
3746                 lastvalue = OOB_UTF8;
3747                 continue;
3748             case 'n':           value = '\n';           break;
3749             case 'r':           value = '\r';           break;
3750             case 't':           value = '\t';           break;
3751             case 'f':           value = '\f';           break;
3752             case 'b':           value = '\b';           break;
3753 #ifdef ASCIIish
3754             case 'e':           value = '\033';         break;
3755             case 'a':           value = '\007';         break;
3756 #else
3757             case 'e':           value = '\047';         break;
3758             case 'a':           value = '\057';         break;
3759 #endif
3760             case 'x':
3761                 if (*RExC_parse == '{') {
3762                     e = strchr(RExC_parse++, '}');
3763                     if (!e)
3764                         vFAIL("Missing right brace on \\x{}");
3765                     numlen = 1;         /* allow underscores */
3766                     value = (UV)scan_hex(RExC_parse,
3767                                      e - RExC_parse,
3768                                      &numlen);
3769                     RExC_parse = e + 1;
3770                 }
3771                 else {
3772                     numlen = 0;         /* disallow underscores */
3773                     value = (UV)scan_hex(RExC_parse, 2, &numlen);
3774                     RExC_parse += numlen;
3775                 }
3776                 break;
3777             case 'c':
3778                 value = UCHARAT(RExC_parse++);
3779                 value = toCTRL(value);
3780                 break;
3781             case '0': case '1': case '2': case '3': case '4':
3782             case '5': case '6': case '7': case '8': case '9':
3783                 numlen = 0;             /* disallow underscores */
3784                 value = (UV)scan_oct(--RExC_parse, 3, &numlen);
3785                 RExC_parse += numlen;
3786                 break;
3787             default:
3788                 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
3789                     vWARN2(RExC_parse,
3790                            "Unrecognized escape \\%c in character class passed through",
3791                            (int)value);
3792                 break;
3793             }
3794         }
3795         if (namedclass > OOB_NAMEDCLASS) {
3796             if (range) { /* a-\d, a-[:digit:] */
3797                 if (!SIZE_ONLY) {
3798                     if (ckWARN(WARN_REGEXP))
3799                         vWARN4(RExC_parse,
3800                                "False [] range \"%*.*s\"",
3801                                RExC_parse - rangebegin,
3802                                RExC_parse - rangebegin,
3803                                rangebegin);
3804                     Perl_sv_catpvf(aTHX_ listsv,
3805                                    /* 0x002D is Unicode for '-' */
3806                                    "%04"UVxf"\n002D\n", (UV)lastvalue);
3807                 }
3808                 range = 0;
3809             }
3810             if (!SIZE_ONLY) {
3811                 switch (namedclass) {
3812                 case ANYOF_ALNUM:
3813                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n");    break;
3814                 case ANYOF_NALNUM:
3815                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsWord\n");    break;
3816                 case ANYOF_ALNUMC:
3817                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlnum\n");   break;
3818                 case ANYOF_NALNUMC:
3819                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlnum\n");   break;
3820                 case ANYOF_ALPHA:
3821                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlpha\n");   break;
3822                 case ANYOF_NALPHA:
3823                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlpha\n");   break;
3824                 case ANYOF_ASCII:
3825                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n");   break;
3826                 case ANYOF_NASCII:
3827                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n");   break;
3828                 case ANYOF_CNTRL:
3829                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsCntrl\n");   break;
3830                 case ANYOF_NCNTRL:
3831                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsCntrl\n");   break;
3832                 case ANYOF_GRAPH:
3833                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsGraph\n");   break;
3834                 case ANYOF_NGRAPH:
3835                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsGraph\n");   break;
3836                 case ANYOF_DIGIT:
3837                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsDigit\n");   break;
3838                 case ANYOF_NDIGIT:
3839                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsDigit\n");   break;
3840                 case ANYOF_LOWER:
3841                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsLower\n");   break;
3842                 case ANYOF_NLOWER:
3843                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsLower\n");   break;
3844                 case ANYOF_PRINT:
3845                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPrint\n");   break;
3846                 case ANYOF_NPRINT:
3847                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPrint\n");   break;
3848                 case ANYOF_PUNCT:
3849                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPunct\n");   break;
3850                 case ANYOF_NPUNCT:
3851                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n");   break;
3852                 case ANYOF_SPACE:
3853                 case ANYOF_PSXSPC:
3854                 case ANYOF_BLANK:
3855                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n");   break;
3856                 case ANYOF_NSPACE:
3857                 case ANYOF_NPSXSPC:
3858                 case ANYOF_NBLANK:
3859                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n");   break;
3860                 case ANYOF_UPPER:
3861                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n");   break;
3862                 case ANYOF_NUPPER:
3863                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsUpper\n");   break;
3864                 case ANYOF_XDIGIT:
3865                     Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsXDigit\n");  break;
3866                 case ANYOF_NXDIGIT:
3867                     Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n");  break;
3868                 }
3869                 continue;
3870             }
3871         }
3872         if (range) {
3873             if (lastvalue > value) { /* b-a */
3874                 Simple_vFAIL4("invalid [] range \"%*.*s\"",
3875                               RExC_parse - rangebegin,
3876                               RExC_parse - rangebegin,
3877                               rangebegin);
3878             }
3879             range = 0;
3880         }
3881         else {
3882             lastvalue = value;
3883             if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
3884                 RExC_parse[1] != ']') {
3885                 RExC_parse++;
3886                 if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
3887                     if (ckWARN(WARN_REGEXP))
3888                         vWARN4(RExC_parse,
3889                                "False [] range \"%*.*s\"",
3890                                RExC_parse - rangebegin,
3891                                RExC_parse - rangebegin,
3892                                rangebegin);
3893                     if (!SIZE_ONLY)
3894                         Perl_sv_catpvf(aTHX_ listsv,
3895                                        /* 0x002D is Unicode for '-' */
3896                                        "002D\n");
3897                 } else
3898                     range = 1;
3899                 continue;       /* do it next time */
3900             }
3901         }
3902         /* now is the next time */
3903         if (!SIZE_ONLY)
3904             Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
3905                            (UV)lastvalue, (UV)value);
3906         range = 0;
3907     }
3908
3909     ret = reganode(pRExC_state, ANYOFUTF8, 0);
3910
3911     if (!SIZE_ONLY) {
3912         SV *rv = swash_init("utf8", "", listsv, 1, 0);
3913         SvREFCNT_dec(listsv);
3914         n = add_data(pRExC_state, 1,"s");
3915         RExC_rx->data->data[n] = (void*)rv;
3916         ARG1_SET(ret, flags);
3917         ARG2_SET(ret, n);
3918     }
3919
3920     return ret;
3921 }
3922
3923 STATIC char*
3924 S_nextchar(pTHX_ RExC_state_t *pRExC_state)
3925 {
3926     dTHR;
3927     char* retval = RExC_parse++;
3928
3929     for (;;) {
3930         if (*RExC_parse == '(' && RExC_parse[1] == '?' &&
3931                 RExC_parse[2] == '#') {
3932             while (*RExC_parse && *RExC_parse != ')')
3933                 RExC_parse++;
3934             RExC_parse++;
3935             continue;
3936         }
3937         if (RExC_flags16 & PMf_EXTENDED) {
3938             if (isSPACE(*RExC_parse)) {
3939                 RExC_parse++;
3940                 continue;
3941             }
3942             else if (*RExC_parse == '#') {
3943                 while (*RExC_parse && *RExC_parse != '\n')
3944                     RExC_parse++;
3945                 RExC_parse++;
3946                 continue;
3947             }
3948         }
3949         return retval;
3950     }
3951 }
3952
3953 /*
3954 - reg_node - emit a node
3955 */
3956 STATIC regnode *                        /* Location. */
3957 S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
3958 {
3959     dTHR;
3960     register regnode *ret;
3961     register regnode *ptr;
3962
3963     ret = RExC_emit;
3964     if (SIZE_ONLY) {
3965         SIZE_ALIGN(RExC_size);
3966         RExC_size += 1;
3967         return(ret);
3968     }
3969
3970     NODE_ALIGN_FILL(ret);
3971     ptr = ret;
3972     FILL_ADVANCE_NODE(ptr, op);
3973     RExC_emit = ptr;
3974
3975     return(ret);
3976 }
3977
3978 /*
3979 - reganode - emit a node with an argument
3980 */
3981 STATIC regnode *                        /* Location. */
3982 S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
3983 {
3984     dTHR;
3985     register regnode *ret;
3986     register regnode *ptr;
3987
3988     ret = RExC_emit;
3989     if (SIZE_ONLY) {
3990         SIZE_ALIGN(RExC_size);
3991         RExC_size += 2;
3992         return(ret);
3993     }
3994
3995     NODE_ALIGN_FILL(ret);
3996     ptr = ret;
3997     FILL_ADVANCE_NODE_ARG(ptr, op, arg);
3998     RExC_emit = ptr;
3999
4000     return(ret);
4001 }
4002
4003 /*
4004 - reguni - emit (if appropriate) a Unicode character
4005 */
4006 STATIC void
4007 S_reguni(pTHX_ RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp)
4008 {
4009     dTHR;
4010     if (SIZE_ONLY) {
4011         U8 tmpbuf[UTF8_MAXLEN];
4012         *lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf;
4013     }
4014     else
4015         *lenp = uv_to_utf8((U8*)s, uv) - (U8*)s;
4016
4017 }
4018
4019 /*
4020 - reginsert - insert an operator in front of already-emitted operand
4021 *
4022 * Means relocating the operand.
4023 */
4024 STATIC void
4025 S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
4026 {
4027     dTHR;
4028     register regnode *src;
4029     register regnode *dst;
4030     register regnode *place;
4031     register int offset = regarglen[(U8)op];
4032
4033 /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
4034
4035     if (SIZE_ONLY) {
4036         RExC_size += NODE_STEP_REGNODE + offset;
4037         return;
4038     }
4039
4040     src = RExC_emit;
4041     RExC_emit += NODE_STEP_REGNODE + offset;
4042     dst = RExC_emit;
4043     while (src > opnd)
4044         StructCopy(--src, --dst, regnode);
4045
4046     place = opnd;               /* Op node, where operand used to be. */
4047     src = NEXTOPER(place);
4048     FILL_ADVANCE_NODE(place, op);
4049     Zero(src, offset, regnode);
4050 }
4051
4052 /*
4053 - regtail - set the next-pointer at the end of a node chain of p to val.
4054 */
4055 STATIC void
4056 S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val)
4057 {
4058     dTHR;
4059     register regnode *scan;
4060     register regnode *temp;
4061
4062     if (SIZE_ONLY)
4063         return;
4064
4065     /* Find last node. */
4066     scan = p;
4067     for (;;) {
4068         temp = regnext(scan);
4069         if (temp == NULL)
4070             break;
4071         scan = temp;
4072     }
4073
4074     if (reg_off_by_arg[OP(scan)]) {
4075         ARG_SET(scan, val - scan);
4076     }
4077     else {
4078         NEXT_OFF(scan) = val - scan;
4079     }
4080 }
4081
4082 /*
4083 - regoptail - regtail on operand of first argument; nop if operandless
4084 */
4085 STATIC void
4086 S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val)
4087 {
4088     dTHR;
4089     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
4090     if (p == NULL || SIZE_ONLY)
4091         return;
4092     if (PL_regkind[(U8)OP(p)] == BRANCH) {
4093         regtail(pRExC_state, NEXTOPER(p), val);
4094     }
4095     else if ( PL_regkind[(U8)OP(p)] == BRANCHJ) {
4096         regtail(pRExC_state, NEXTOPER(NEXTOPER(p)), val);
4097     }
4098     else
4099         return;
4100 }
4101
4102 /*
4103  - regcurly - a little FSA that accepts {\d+,?\d*}
4104  */
4105 STATIC I32
4106 S_regcurly(pTHX_ register char *s)
4107 {
4108     if (*s++ != '{')
4109         return FALSE;
4110     if (!isDIGIT(*s))
4111         return FALSE;
4112     while (isDIGIT(*s))
4113         s++;
4114     if (*s == ',')
4115         s++;
4116     while (isDIGIT(*s))
4117         s++;
4118     if (*s != '}')
4119         return FALSE;
4120     return TRUE;
4121 }
4122
4123
4124 STATIC regnode *
4125 S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
4126 {
4127 #ifdef DEBUGGING
4128     register U8 op = EXACT;     /* Arbitrary non-END op. */
4129     register regnode *next;
4130
4131     while (op != END && (!last || node < last)) {
4132         /* While that wasn't END last time... */
4133
4134         NODE_ALIGN(node);
4135         op = OP(node);
4136         if (op == CLOSE)
4137             l--;
4138         next = regnext(node);
4139         /* Where, what. */
4140         if (OP(node) == OPTIMIZED)
4141             goto after_print;
4142         regprop(sv, node);
4143         PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
4144                       (int)(2*l + 1), "", SvPVX(sv));
4145         if (next == NULL)               /* Next ptr. */
4146             PerlIO_printf(Perl_debug_log, "(0)");
4147         else
4148             PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start));
4149         (void)PerlIO_putc(Perl_debug_log, '\n');
4150       after_print:
4151         if (PL_regkind[(U8)op] == BRANCHJ) {
4152             register regnode *nnode = (OP(next) == LONGJMP
4153                                        ? regnext(next)
4154                                        : next);
4155             if (last && nnode > last)
4156                 nnode = last;
4157             node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
4158         }
4159         else if (PL_regkind[(U8)op] == BRANCH) {
4160             node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
4161         }
4162         else if ( op == CURLY) {   /* `next' might be very big: optimizer */
4163             node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
4164                              NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
4165         }
4166         else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) {
4167             node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
4168                              next, sv, l + 1);
4169         }
4170         else if ( op == PLUS || op == STAR) {
4171             node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
4172         }
4173         else if (op == ANYOF) {
4174             node = NEXTOPER(node);
4175             node += ANYOF_SKIP;
4176         }
4177         else if (PL_regkind[(U8)op] == EXACT) {
4178             /* Literal string, where present. */
4179             node += NODE_SZ_STR(node) - 1;
4180             node = NEXTOPER(node);
4181         }
4182         else {
4183             node = NEXTOPER(node);
4184             node += regarglen[(U8)op];
4185         }
4186         if (op == CURLYX || op == OPEN)
4187             l++;
4188         else if (op == WHILEM)
4189             l--;
4190     }
4191 #endif  /* DEBUGGING */
4192     return node;
4193 }
4194
4195 /*
4196  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
4197  */
4198 void
4199 Perl_regdump(pTHX_ regexp *r)
4200 {
4201 #ifdef DEBUGGING
4202     dTHR;
4203     SV *sv = sv_newmortal();
4204
4205     (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
4206
4207     /* Header fields of interest. */
4208     if (r->anchored_substr)
4209         PerlIO_printf(Perl_debug_log,
4210                       "anchored `%s%.*s%s'%s at %"IVdf" ",
4211                       PL_colors[0],
4212                       (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)),
4213                       SvPVX(r->anchored_substr),
4214                       PL_colors[1],
4215                       SvTAIL(r->anchored_substr) ? "$" : "",
4216                       (IV)r->anchored_offset);
4217     if (r->float_substr)
4218         PerlIO_printf(Perl_debug_log,
4219                       "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ",
4220                       PL_colors[0],
4221                       (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)),
4222                       SvPVX(r->float_substr),
4223                       PL_colors[1],
4224                       SvTAIL(r->float_substr) ? "$" : "",
4225                       (IV)r->float_min_offset, (UV)r->float_max_offset);
4226     if (r->check_substr)
4227         PerlIO_printf(Perl_debug_log,
4228                       r->check_substr == r->float_substr
4229                       ? "(checking floating" : "(checking anchored");
4230     if (r->reganch & ROPT_NOSCAN)
4231         PerlIO_printf(Perl_debug_log, " noscan");
4232     if (r->reganch & ROPT_CHECK_ALL)
4233         PerlIO_printf(Perl_debug_log, " isall");
4234     if (r->check_substr)
4235         PerlIO_printf(Perl_debug_log, ") ");
4236
4237     if (r->regstclass) {
4238         regprop(sv, r->regstclass);
4239         PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
4240     }
4241     if (r->reganch & ROPT_ANCH) {
4242         PerlIO_printf(Perl_debug_log, "anchored");
4243         if (r->reganch & ROPT_ANCH_BOL)
4244             PerlIO_printf(Perl_debug_log, "(BOL)");
4245         if (r->reganch & ROPT_ANCH_MBOL)
4246             PerlIO_printf(Perl_debug_log, "(MBOL)");
4247         if (r->reganch & ROPT_ANCH_SBOL)
4248             PerlIO_printf(Perl_debug_log, "(SBOL)");
4249         if (r->reganch & ROPT_ANCH_GPOS)
4250             PerlIO_printf(Perl_debug_log, "(GPOS)");
4251         PerlIO_putc(Perl_debug_log, ' ');
4252     }
4253     if (r->reganch & ROPT_GPOS_SEEN)
4254         PerlIO_printf(Perl_debug_log, "GPOS ");
4255     if (r->reganch & ROPT_SKIP)
4256         PerlIO_printf(Perl_debug_log, "plus ");
4257     if (r->reganch & ROPT_IMPLICIT)
4258         PerlIO_printf(Perl_debug_log, "implicit ");
4259     PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
4260     if (r->reganch & ROPT_EVAL_SEEN)
4261         PerlIO_printf(Perl_debug_log, "with eval ");
4262     PerlIO_printf(Perl_debug_log, "\n");
4263 #endif  /* DEBUGGING */
4264 }
4265
4266 STATIC void
4267 S_put_byte(pTHX_ SV *sv, int c)
4268 {
4269     if (c <= ' ' || c == 127 || c == 255)
4270         Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
4271     else if (c == '-' || c == ']' || c == '\\' || c == '^')
4272         Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
4273     else
4274         Perl_sv_catpvf(aTHX_ sv, "%c", c);
4275 }
4276
4277 /*
4278 - regprop - printable representation of opcode
4279 */
4280 void
4281 Perl_regprop(pTHX_ SV *sv, regnode *o)
4282 {
4283 #ifdef DEBUGGING
4284     dTHR;
4285     register int k;
4286
4287     sv_setpvn(sv, "", 0);
4288     if (OP(o) >= reg_num)               /* regnode.type is unsigned */
4289         /* It would be nice to FAIL() here, but this may be called from
4290            regexec.c, and it would be hard to supply pRExC_state. */
4291         Perl_croak(aTHX_ "Corrupted regexp opcode");
4292     sv_catpv(sv, (char*)reg_name[OP(o)]); /* Take off const! */
4293
4294     k = PL_regkind[(U8)OP(o)];
4295
4296     if (k == EXACT)
4297         Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", PL_colors[0],
4298                        STR_LEN(o), STRING(o), PL_colors[1]);
4299     else if (k == CURLY) {
4300         if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
4301             Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
4302         Perl_sv_catpvf(aTHX_ sv, " {%d,%d}", ARG1(o), ARG2(o));
4303     }
4304     else if (k == WHILEM && o->flags)                   /* Ordinal/of */
4305         Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4);
4306     else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP )
4307         Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o));    /* Parenth number */
4308     else if (k == LOGICAL)
4309         Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);     /* 2: embedded, otherwise 1 */
4310     else if (k == ANYOF) {
4311         int i, rangestart = -1;
4312         const char * const out[] = {    /* Should be syncronized with
4313                                            ANYOF_ #xdefines in regcomp.h */
4314             "\\w",
4315             "\\W",
4316             "\\s",
4317             "\\S",
4318             "\\d",
4319             "\\D",
4320             "[:alnum:]",
4321             "[:^alnum:]",
4322             "[:alpha:]",
4323             "[:^alpha:]",
4324             "[:ascii:]",
4325             "[:^ascii:]",
4326             "[:ctrl:]",
4327             "[:^ctrl:]",
4328             "[:graph:]",
4329             "[:^graph:]",
4330             "[:lower:]",
4331             "[:^lower:]",
4332             "[:print:]",
4333             "[:^print:]",
4334             "[:punct:]",
4335             "[:^punct:]",
4336             "[:upper:]",
4337             "[:^upper:]",
4338             "[:xdigit:]",
4339             "[:^xdigit:]",
4340             "[:space:]",
4341             "[:^space:]",
4342             "[:blank:]",
4343             "[:^blank:]"
4344         };
4345
4346         if (o->flags & ANYOF_LOCALE)
4347             sv_catpv(sv, "{loc}");
4348         if (o->flags & ANYOF_FOLD)
4349             sv_catpv(sv, "{i}");
4350         Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
4351         if (o->flags & ANYOF_INVERT)
4352             sv_catpv(sv, "^");
4353         for (i = 0; i <= 256; i++) {
4354             if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
4355                 if (rangestart == -1)
4356                     rangestart = i;
4357             } else if (rangestart != -1) {
4358                 if (i <= rangestart + 3)
4359                     for (; rangestart < i; rangestart++)
4360                         put_byte(sv, rangestart);
4361                 else {
4362                     put_byte(sv, rangestart);
4363                     sv_catpv(sv, "-");
4364                     put_byte(sv, i - 1);
4365                 }
4366                 rangestart = -1;
4367             }
4368         }
4369         if (o->flags & ANYOF_CLASS)
4370             for (i = 0; i < sizeof(out)/sizeof(char*); i++)
4371                 if (ANYOF_CLASS_TEST(o,i))
4372                     sv_catpv(sv, out[i]);
4373         Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
4374     }
4375     else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
4376         Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags);
4377 #endif  /* DEBUGGING */
4378 }
4379
4380 SV *
4381 Perl_re_intuit_string(pTHX_ regexp *prog)
4382 {                               /* Assume that RE_INTUIT is set */
4383     DEBUG_r(
4384         {   STRLEN n_a;
4385             char *s = SvPV(prog->check_substr,n_a);
4386
4387             if (!PL_colorset) reginitcolors();
4388             PerlIO_printf(Perl_debug_log,
4389                       "%sUsing REx substr:%s `%s%.60s%s%s'\n",
4390                       PL_colors[4],PL_colors[5],PL_colors[0],
4391                       s,
4392                       PL_colors[1],
4393                       (strlen(s) > 60 ? "..." : ""));
4394         } );
4395
4396     return prog->check_substr;
4397 }
4398
4399 void
4400 Perl_pregfree(pTHX_ struct regexp *r)
4401 {
4402     dTHR;
4403     DEBUG_r(if (!PL_colorset) reginitcolors());
4404
4405     if (!r || (--r->refcnt > 0))
4406         return;
4407     DEBUG_r(PerlIO_printf(Perl_debug_log,
4408                       "%sFreeing REx:%s `%s%.60s%s%s'\n",
4409                       PL_colors[4],PL_colors[5],PL_colors[0],
4410                       r->precomp,
4411                       PL_colors[1],
4412                       (strlen(r->precomp) > 60 ? "..." : "")));
4413
4414     if (r->precomp)
4415         Safefree(r->precomp);
4416     if (RX_MATCH_COPIED(r))
4417         Safefree(r->subbeg);
4418     if (r->substrs) {
4419         if (r->anchored_substr)
4420             SvREFCNT_dec(r->anchored_substr);
4421         if (r->float_substr)
4422             SvREFCNT_dec(r->float_substr);
4423         Safefree(r->substrs);
4424     }
4425     if (r->data) {
4426         int n = r->data->count;
4427         AV* new_comppad = NULL;
4428         AV* old_comppad;
4429         SV** old_curpad;
4430
4431         while (--n >= 0) {
4432             switch (r->data->what[n]) {
4433             case 's':
4434                 SvREFCNT_dec((SV*)r->data->data[n]);
4435                 break;
4436             case 'f':
4437                 Safefree(r->data->data[n]);
4438                 break;
4439             case 'p':
4440                 new_comppad = (AV*)r->data->data[n];
4441                 break;
4442             case 'o':
4443                 if (new_comppad == NULL)
4444                     Perl_croak(aTHX_ "panic: pregfree comppad");
4445                 old_comppad = PL_comppad;
4446                 old_curpad = PL_curpad;
4447                 /* Watch out for global destruction's random ordering. */
4448                 if (SvTYPE(new_comppad) == SVt_PVAV) {
4449                     PL_comppad = new_comppad;
4450                     PL_curpad = AvARRAY(new_comppad);
4451                 }
4452                 else
4453                     PL_curpad = NULL;
4454                 op_free((OP_4tree*)r->data->data[n]);
4455                 PL_comppad = old_comppad;
4456                 PL_curpad = old_curpad;
4457                 SvREFCNT_dec((SV*)new_comppad);
4458                 new_comppad = NULL;
4459                 break;
4460             case 'n':
4461                 break;
4462             default:
4463                 Perl_croak(aTHX_ "panic: regfree data code '%c'", r->data->what[n]);
4464             }
4465         }
4466         Safefree(r->data->what);
4467         Safefree(r->data);
4468     }
4469     Safefree(r->startp);
4470     Safefree(r->endp);
4471     Safefree(r);
4472 }
4473
4474 /*
4475  - regnext - dig the "next" pointer out of a node
4476  *
4477  * [Note, when REGALIGN is defined there are two places in regmatch()
4478  * that bypass this code for speed.]
4479  */
4480 regnode *
4481 Perl_regnext(pTHX_ register regnode *p)
4482 {
4483     dTHR;
4484     register I32 offset;
4485
4486     if (p == &PL_regdummy)
4487         return(NULL);
4488
4489     offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
4490     if (offset == 0)
4491         return(NULL);
4492
4493     return(p+offset);
4494 }
4495
4496 STATIC void
4497 S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
4498 {
4499     va_list args;
4500     STRLEN l1 = strlen(pat1);
4501     STRLEN l2 = strlen(pat2);
4502     char buf[512];
4503     SV *msv;
4504     char *message;
4505
4506     if (l1 > 510)
4507         l1 = 510;
4508     if (l1 + l2 > 510)
4509         l2 = 510 - l1;
4510     Copy(pat1, buf, l1 , char);
4511     Copy(pat2, buf + l1, l2 , char);
4512     buf[l1 + l2] = '\n';
4513     buf[l1 + l2 + 1] = '\0';
4514 #ifdef I_STDARG
4515     /* ANSI variant takes additional second argument */
4516     va_start(args, pat2);
4517 #else
4518     va_start(args);
4519 #endif
4520     msv = vmess(buf, &args);
4521     va_end(args);
4522     message = SvPV(msv,l1);
4523     if (l1 > 512)
4524         l1 = 512;
4525     Copy(message, buf, l1 , char);
4526     buf[l1] = '\0';                     /* Overwrite \n */
4527     Perl_croak(aTHX_ "%s", buf);
4528 }
4529
4530 /* XXX Here's a total kludge.  But we need to re-enter for swash routines. */
4531
4532 void
4533 Perl_save_re_context(pTHX)
4534 {
4535     dTHR;
4536
4537 #if 0
4538     SAVEPPTR(RExC_precomp);             /* uncompiled string. */
4539     SAVEI32(RExC_npar);         /* () count. */
4540     SAVEI32(RExC_size);         /* Code size. */
4541     SAVEI16(RExC_flags16);              /* are we folding, multilining? */
4542     SAVEVPTR(RExC_rx);          /* from regcomp.c */
4543     SAVEI32(RExC_seen);         /* from regcomp.c */
4544     SAVEI32(RExC_sawback);              /* Did we see \1, ...? */
4545     SAVEI32(RExC_naughty);              /* How bad is this pattern? */
4546     SAVEVPTR(RExC_emit);                /* Code-emit pointer; &regdummy = don't */
4547     SAVEPPTR(RExC_end);         /* End of input for compile */
4548     SAVEPPTR(RExC_parse);               /* Input-scan pointer. */
4549 #endif
4550
4551     SAVEI32(PL_reg_flags);              /* from regexec.c */
4552     SAVEPPTR(PL_bostr);
4553     SAVEPPTR(PL_reginput);              /* String-input pointer. */
4554     SAVEPPTR(PL_regbol);                /* Beginning of input, for ^ check. */
4555     SAVEPPTR(PL_regeol);                /* End of input, for $ check. */
4556     SAVEVPTR(PL_regstartp);             /* Pointer to startp array. */
4557     SAVEVPTR(PL_regendp);               /* Ditto for endp. */
4558     SAVEVPTR(PL_reglastparen);          /* Similarly for lastparen. */
4559     SAVEPPTR(PL_regtill);               /* How far we are required to go. */
4560     SAVEI8(PL_regprev);                 /* char before regbol, \n if none */
4561     SAVEVPTR(PL_reg_start_tmp);         /* from regexec.c */
4562     PL_reg_start_tmp = 0;
4563     SAVEFREEPV(PL_reg_start_tmp);
4564     SAVEI32(PL_reg_start_tmpl);         /* from regexec.c */
4565     PL_reg_start_tmpl = 0;
4566     SAVEVPTR(PL_regdata);
4567     SAVEI32(PL_reg_eval_set);           /* from regexec.c */
4568     SAVEI32(PL_regnarrate);             /* from regexec.c */
4569     SAVEVPTR(PL_regprogram);            /* from regexec.c */
4570     SAVEINT(PL_regindent);              /* from regexec.c */
4571     SAVEVPTR(PL_regcc);                 /* from regexec.c */
4572     SAVEVPTR(PL_curcop);
4573     SAVEVPTR(PL_reg_call_cc);           /* from regexec.c */
4574     SAVEVPTR(PL_reg_re);                /* from regexec.c */
4575     SAVEPPTR(PL_reg_ganch);             /* from regexec.c */
4576     SAVESPTR(PL_reg_sv);                /* from regexec.c */
4577     SAVEVPTR(PL_reg_magic);             /* from regexec.c */
4578     SAVEI32(PL_reg_oldpos);                     /* from regexec.c */
4579     SAVEVPTR(PL_reg_oldcurpm);          /* from regexec.c */
4580     SAVEVPTR(PL_reg_curpm);             /* from regexec.c */
4581 #ifdef DEBUGGING
4582     SAVEPPTR(PL_reg_starttry);          /* from regexec.c */
4583 #endif
4584 }
4585
4586 #ifdef PERL_OBJECT
4587 #include "XSUB.h"
4588 #undef this
4589 #define this pPerl
4590 #endif
4591
4592 static void
4593 clear_re(pTHXo_ void *r)
4594 {
4595     ReREFCNT_dec((regexp *)r);
4596 }
4597