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