home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / regcomp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-01-15  |  33.5 KB  |  1,626 lines  |  [TEXT/MPS ]
  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. /*SUPPRESS 112*/
  18. /*
  19.  * regcomp and regexec -- regsub and regerror are not used in perl
  20.  *
  21.  *    Copyright (c) 1986 by University of Toronto.
  22.  *    Written by Henry Spencer.  Not derived from licensed software.
  23.  *
  24.  *    Permission is granted to anyone to use this software for any
  25.  *    purpose on any computer system, and to redistribute it freely,
  26.  *    subject to the following restrictions:
  27.  *
  28.  *    1. The author is not responsible for the consequences of use of
  29.  *        this software, no matter how awful, even if they arise
  30.  *        from defects in it.
  31.  *
  32.  *    2. The origin of this software must not be misrepresented, either
  33.  *        by explicit claim or by omission.
  34.  *
  35.  *    3. Altered versions must be plainly marked as such, and must not
  36.  *        be misrepresented as being the original software.
  37.  *
  38.  *
  39.  ****    Alterations to Henry's code are...
  40.  ****
  41.  ****    Copyright (c) 1991-1994, Larry Wall
  42.  ****
  43.  ****    You may distribute under the terms of either the GNU General Public
  44.  ****    License or the Artistic License, as specified in the README file.
  45.  
  46.  *
  47.  * Beware that some of this code is subtly aware of the way operator
  48.  * precedence is structured in regular expressions.  Serious changes in
  49.  * regular-expression syntax might require a total rethink.
  50.  */
  51. #include "EXTERN.h"
  52. #include "perl.h"
  53. #include "INTERN.h"
  54. #include "regcomp.h"
  55.  
  56. #ifdef MSDOS
  57. # if defined(BUGGY_MSC6)
  58.  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
  59.  # pragma optimize("a",off)
  60.  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
  61.  # pragma optimize("w",on )
  62. # endif /* BUGGY_MSC6 */
  63. #endif /* MSDOS */
  64.  
  65. #ifndef STATIC
  66. #define    STATIC    static
  67. #endif
  68.  
  69. #define    ISMULT1(c)    ((c) == '*' || (c) == '+' || (c) == '?')
  70. #define    ISMULT2(s)    ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
  71.     ((*s) == '{' && regcurly(s)))
  72. #ifdef atarist
  73. #define    PERL_META    "^$.[()|?+*\\"
  74. #else
  75. #define    META    "^$.[()|?+*\\"
  76. #endif
  77.  
  78. #ifdef SPSTART
  79. #undef SPSTART        /* dratted cpp namespace... */
  80. #endif
  81. /*
  82.  * Flags to be passed up and down.
  83.  */
  84. #define    WORST        0    /* Worst case. */
  85. #define    HASWIDTH    0x1    /* Known never to match null string. */
  86. #define    SIMPLE        0x2    /* Simple enough to be STAR/PLUS operand. */
  87. #define    SPSTART        0x4    /* Starts with * or +. */
  88. #define TRYAGAIN    0x8    /* Weeded out a declaration. */
  89.  
  90. /*
  91.  * Forward declarations for regcomp()'s friends.
  92.  */
  93.  
  94. static char *reg _((I32, I32 *));
  95. static char *reganode _((char, unsigned short));
  96. static char *regatom _((I32 *));
  97. static char *regbranch _((I32 *));
  98. static void regc _((char));
  99. static char *regclass _((void));
  100. STATIC I32 regcurly _((char *));
  101. static char *regnode _((char));
  102. static char *regpiece _((I32 *));
  103. static void reginsert _((char, char *));
  104. static void regoptail _((char *, char *));
  105. static void regset _((char *, I32, I32));
  106. static void regtail _((char *, char *));
  107. static char* nextchar _((void));
  108.  
  109. /*
  110.  - regcomp - compile a regular expression into internal code
  111.  *
  112.  * We can't allocate space until we know how big the compiled form will be,
  113.  * but we can't compile it (and thus know how big it is) until we've got a
  114.  * place to put the code.  So we cheat:  we compile it twice, once with code
  115.  * generation turned off and size counting turned on, and once "for real".
  116.  * This also means that we don't allocate space until we are sure that the
  117.  * thing really will compile successfully, and we never have to move the
  118.  * code and thus invalidate pointers into it.  (Note that it has to be in
  119.  * one piece because free() must be able to free it all.) [NB: not true in perl]
  120.  *
  121.  * Beware that the optimization-preparation code in here knows about some
  122.  * of the structure of the compiled regexp.  [I'll say.]
  123.  */
  124. regexp *
  125. regcomp(exp,xend,pm)
  126. char* exp;
  127. char* xend;
  128. PMOP* pm;
  129. {
  130.     I32 fold = pm->op_pmflags & PMf_FOLD;
  131.     register regexp *r;
  132.     register char *scan;
  133.     register SV *longish;
  134.     SV *longest;
  135.     register I32 len;
  136.     register char *first;
  137.     I32 flags;
  138.     I32 backish;
  139.     I32 backest;
  140.     I32 curback;
  141.     I32 minlen = 0;
  142.     I32 sawplus = 0;
  143.     I32 sawopen = 0;
  144.  
  145.     if (exp == NULL)
  146.     croak("NULL regexp argument");
  147.  
  148.     /* First pass: determine size, legality. */
  149.     regflags = pm->op_pmflags;
  150.     regparse = exp;
  151.     regxend = xend;
  152.     regprecomp = savepvn(exp,xend-exp);
  153.     regnaughty = 0;
  154.     regsawback = 0;
  155.     regnpar = 1;
  156.     regsize = 0L;
  157.     regcode = ®dummy;
  158.     regc((char)MAGIC);
  159.     if (reg(0, &flags) == NULL) {
  160.     Safefree(regprecomp);
  161.     regprecomp = Nullch;
  162.     return(NULL);
  163.     }
  164.  
  165.     /* Small enough for pointer-storage convention? */
  166.     if (regsize >= 32767L)        /* Probably could be 65535L. */
  167.     FAIL("regexp too big");
  168.  
  169.     /* Allocate space. */
  170.     Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
  171.     if (r == NULL)
  172.     FAIL("regexp out of space");
  173.  
  174.     /* Second pass: emit code. */
  175.     r->prelen = xend-exp;
  176.     r->precomp = regprecomp;
  177.     r->subbeg = r->subbase = NULL;
  178.     regnaughty = 0;
  179.     regparse = exp;
  180.     regnpar = 1;
  181.     regcode = r->program;
  182.     regc((char)MAGIC);
  183.     if (reg(0, &flags) == NULL)
  184.     return(NULL);
  185.  
  186.     /* Dig out information for optimizations. */
  187.     pm->op_pmflags = regflags;
  188.     fold = pm->op_pmflags & PMf_FOLD;
  189.     r->regstart = Nullsv;    /* Worst-case defaults. */
  190.     r->reganch = 0;
  191.     r->regmust = Nullsv;
  192.     r->regback = -1;
  193.     r->regstclass = Nullch;
  194.     r->naughty = regnaughty >= 10;    /* Probably an expensive pattern. */
  195.     scan = r->program+1;            /* First BRANCH. */
  196.     if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
  197.     scan = NEXTOPER(scan);
  198.  
  199.     first = scan;
  200.     while ((OP(first) == OPEN && (sawopen = 1)) ||
  201.         (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  202.         (OP(first) == PLUS) ||
  203.         (OP(first) == MINMOD) ||
  204.         (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
  205.         if (OP(first) == PLUS)
  206.             sawplus = 1;
  207.         else
  208.             first += regarglen[(U8)OP(first)];
  209.         first = NEXTOPER(first);
  210.     }
  211.  
  212.     /* Starting-point info. */
  213.       again:
  214.     if (OP(first) == EXACTLY) {
  215.         r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
  216.         if (SvCUR(r->regstart) > !(sawstudy|fold))
  217.         fbm_compile(r->regstart,fold);
  218.         else
  219.         sv_upgrade(r->regstart, SVt_PVBM);
  220.     }
  221.     else if (strchr(simple+2,OP(first)))
  222.         r->regstclass = first;
  223.     else if (OP(first) == BOUND || OP(first) == NBOUND)
  224.         r->regstclass = first;
  225.     else if (regkind[(U8)OP(first)] == BOL) {
  226.         r->reganch = ROPT_ANCH;
  227.         first = NEXTOPER(first);
  228.           goto again;
  229.     }
  230.     else if ((OP(first) == STAR &&
  231.         regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
  232.         !(r->reganch & ROPT_ANCH) )
  233.     {
  234.         /* turn .* into ^.* with an implied $*=1 */
  235.         r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
  236.         first = NEXTOPER(first);
  237.           goto again;
  238.     }
  239.     if (sawplus && (!sawopen || !regsawback))
  240.         r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
  241.  
  242. #ifdef macintosh
  243.     DEBUG_r(fprintf(gPerlDbg,"first %d next %d offset %d\n",
  244.        OP(first), OP(NEXTOPER(first)), first - scan));
  245. #else
  246.     DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
  247.        OP(first), OP(NEXTOPER(first)), first - scan));
  248. #endif
  249.     /*
  250.     * If there's something expensive in the r.e., find the
  251.     * longest literal string that must appear and make it the
  252.     * regmust.  Resolve ties in favor of later strings, since
  253.     * the regstart check works with the beginning of the r.e.
  254.     * and avoiding duplication strengthens checking.  Not a
  255.     * strong reason, but sufficient in the absence of others.
  256.     * [Now we resolve ties in favor of the earlier string if
  257.     * it happens that curback has been invalidated, since the
  258.     * earlier string may buy us something the later one won't.]
  259.     */
  260.     longish = newSVpv("",0);
  261.     longest = newSVpv("",0);
  262.     len = 0;
  263.     minlen = 0;
  264.     curback = 0;
  265.     backish = 0;
  266.     backest = 0;
  267.     while (OP(scan) != END) {
  268.         if (OP(scan) == BRANCH) {
  269.         if (OP(regnext(scan)) == BRANCH) {
  270.             curback = -30000;
  271.             while (OP(scan) == BRANCH)
  272.             scan = regnext(scan);
  273.         }
  274.         else    /* single branch is ok */
  275.             scan = NEXTOPER(scan);
  276.         }
  277.         if (OP(scan) == UNLESSM) {
  278.         curback = -30000;
  279.         scan = regnext(scan);
  280.         }
  281.         if (OP(scan) == EXACTLY) {
  282.         char *t;
  283.  
  284.         first = scan;
  285.         while (OP(t = regnext(scan)) == CLOSE)
  286.             scan = t;
  287.         minlen += *OPERAND(first);
  288.         if (curback - backish == len) {
  289.             sv_catpvn(longish, OPERAND(first)+1,
  290.             *OPERAND(first));
  291.             len += *OPERAND(first);
  292.             curback += *OPERAND(first);
  293.             first = regnext(scan);
  294.         }
  295.         else if (*OPERAND(first) >= len + (curback >= 0)) {
  296.             len = *OPERAND(first);
  297.             sv_setpvn(longish, OPERAND(first)+1,len);
  298.             backish = curback;
  299.             curback += len;
  300.             first = regnext(scan);
  301.         }
  302.         else
  303.             curback += *OPERAND(first);
  304.         }
  305.         else if (strchr(varies,OP(scan))) {
  306.         curback = -30000;
  307.         len = 0;
  308.         if (SvCUR(longish) > SvCUR(longest)) {
  309.             sv_setsv(longest,longish);
  310.             backest = backish;
  311.         }
  312.         sv_setpvn(longish,"",0);
  313.         if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
  314.             minlen++;
  315.         else if (regkind[(U8)OP(scan)] == CURLY &&
  316.           strchr(simple,OP(NEXTOPER(scan)+4)))
  317.             minlen += ARG1(scan);
  318.         }
  319.         else if (strchr(simple,OP(scan))) {
  320.         curback++;
  321.         minlen++;
  322.         len = 0;
  323.         if (SvCUR(longish) > SvCUR(longest)) {
  324.             sv_setsv(longest,longish);
  325.             backest = backish;
  326.         }
  327.         sv_setpvn(longish,"",0);
  328.         }
  329.         scan = regnext(scan);
  330.     }
  331.  
  332.     /* Prefer earlier on tie, unless we can tail match latter */
  333.  
  334.     if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL) >
  335.         SvCUR(longest))
  336.     {
  337.         sv_setsv(longest,longish);
  338.         backest = backish;
  339.     }
  340.     else
  341.         sv_setpvn(longish,"",0);
  342.     if (SvCUR(longest)
  343.         &&
  344.         (!r->regstart
  345.          ||
  346.          !fbm_instr((unsigned char*) SvPVX(r->regstart),
  347.           (unsigned char *) SvPVX(r->regstart)
  348.             + SvCUR(r->regstart),
  349.           longest)
  350.         )
  351.        )
  352.     {
  353.         r->regmust = longest;
  354.         if (backest < 0)
  355.         backest = -1;
  356.         r->regback = backest;
  357.         if (SvCUR(longest) > !(sawstudy || fold ||
  358.             regkind[(U8)OP(first)]==EOL))
  359.         fbm_compile(r->regmust,fold);
  360.         (void)SvUPGRADE(r->regmust, SVt_PVBM);
  361.         BmUSEFUL(r->regmust) = 100;
  362.         if (regkind[(U8)OP(first)] == EOL && SvCUR(longish))
  363.         SvTAIL_on(r->regmust);
  364.     }
  365.     else {
  366.         SvREFCNT_dec(longest);
  367.         longest = Nullsv;
  368.     }
  369.     SvREFCNT_dec(longish);
  370.     }
  371.  
  372.     r->do_folding = fold;
  373.     r->nparens = regnpar - 1;
  374.     r->minlen = minlen;
  375.     Newz(1002, r->startp, regnpar, char*);
  376.     Newz(1002, r->endp, regnpar, char*);
  377.     DEBUG_r(regdump(r));
  378.     return(r);
  379. }
  380.  
  381. /*
  382.  - reg - regular expression, i.e. main body or parenthesized thing
  383.  *
  384.  * Caller must absorb opening parenthesis.
  385.  *
  386.  * Combining parenthesis handling with the base level of regular expression
  387.  * is a trifle forced, but the need to tie the tails of the branches to what
  388.  * follows makes it hard to avoid.
  389.  */
  390. static char *
  391. reg(paren, flagp)
  392. I32 paren;            /* Parenthesized? */
  393. I32 *flagp;
  394. {
  395.     register char *ret;
  396.     register char *br;
  397.     register char *ender = 0;
  398.     register I32 parno = 0;
  399.     I32 flags;
  400.  
  401.     *flagp = HASWIDTH;    /* Tentatively. */
  402.  
  403.     /* Make an OPEN node, if parenthesized. */
  404.     if (paren) {
  405.     if (*regparse == '?') {
  406.         regparse++;
  407.         paren = *nextchar();
  408.         ret = NULL;
  409.         switch (paren) {
  410.         case ':':
  411.         case '=':
  412.         case '!':
  413.         break;
  414.         case '$':
  415.         case '@':
  416.         croak("Sequence (?%c...) not implemented", paren);
  417.         break;
  418.         case '#':
  419.         while (*regparse && *regparse != ')')
  420.             regparse++;
  421.         if (*regparse != ')')
  422.             croak("Sequence (?#... not terminated", *regparse);
  423.         nextchar();
  424.         *flagp = TRYAGAIN;
  425.         return NULL;
  426.         default:
  427.         --regparse;
  428.         while (*regparse && strchr("iogmsx", *regparse))
  429.             pmflag(®flags, *regparse++);
  430.         if (*regparse != ')')
  431.             croak("Sequence (?%c...) not recognized", *regparse);
  432.         nextchar();
  433.         *flagp = TRYAGAIN;
  434.         return NULL;
  435.         }
  436.     }
  437.     else {
  438.         parno = regnpar;
  439.         regnpar++;
  440.         ret = reganode(OPEN, parno);
  441.     }
  442.     } else
  443.     ret = NULL;
  444.  
  445.     /* Pick up the branches, linking them together. */
  446.     br = regbranch(&flags);
  447.     if (br == NULL)
  448.     return(NULL);
  449.     if (ret != NULL)
  450.     regtail(ret, br);    /* OPEN -> first. */
  451.     else
  452.     ret = br;
  453.     if (!(flags&HASWIDTH))
  454.     *flagp &= ~HASWIDTH;
  455.     *flagp |= flags&SPSTART;
  456.     while (*regparse == '|') {
  457.     nextchar();
  458.     br = regbranch(&flags);
  459.     if (br == NULL)
  460.         return(NULL);
  461.     regtail(ret, br);    /* BRANCH -> BRANCH. */
  462.     if (!(flags&HASWIDTH))
  463.         *flagp &= ~HASWIDTH;
  464.     *flagp |= flags&SPSTART;
  465.     }
  466.  
  467.     /* Make a closing node, and hook it on the end. */
  468.     switch (paren) {
  469.     case ':':
  470.     ender = regnode(NOTHING);
  471.     break;
  472.     case 1:
  473.     ender = reganode(CLOSE, parno);
  474.     break;
  475.     case '=':
  476.     case '!':
  477.     ender = regnode(SUCCEED);
  478.     *flagp &= ~HASWIDTH;
  479.     break;
  480.     case 0:
  481.     ender = regnode(END);
  482.     break;
  483.     }
  484.     regtail(ret, ender);
  485.  
  486.     /* Hook the tails of the branches to the closing node. */
  487.     for (br = ret; br != NULL; br = regnext(br))
  488.     regoptail(br, ender);
  489.  
  490.     if (paren == '=') {
  491.     reginsert(IFMATCH,ret);
  492.     regtail(ret, regnode(NOTHING));
  493.     }
  494.     else if (paren == '!') {
  495.     reginsert(UNLESSM,ret);
  496.     regtail(ret, regnode(NOTHING));
  497.     }
  498.  
  499.     /* Check for proper termination. */
  500.     if (paren && *nextchar() != ')') {
  501.     FAIL("unmatched () in regexp");
  502.     } else if (!paren && regparse < regxend) {
  503.     if (*regparse == ')') {
  504.         FAIL("unmatched () in regexp");
  505.     } else
  506.         FAIL("junk on end of regexp");    /* "Can't happen". */
  507.     /* NOTREACHED */
  508.     }
  509.  
  510.     return(ret);
  511. }
  512.  
  513. /*
  514.  - regbranch - one alternative of an | operator
  515.  *
  516.  * Implements the concatenation operator.
  517.  */
  518. static char *
  519. regbranch(flagp)
  520. I32 *flagp;
  521. {
  522.     register char *ret;
  523.     register char *chain;
  524.     register char *latest;
  525.     I32 flags = 0;
  526.  
  527.     *flagp = WORST;        /* Tentatively. */
  528.  
  529.     ret = regnode(BRANCH);
  530.     chain = NULL;
  531.     regparse--;
  532.     nextchar();
  533.     while (regparse < regxend && *regparse != '|' && *regparse != ')') {
  534.     flags &= ~TRYAGAIN;
  535.     latest = regpiece(&flags);
  536.     if (latest == NULL) {
  537.         if (flags & TRYAGAIN)
  538.         continue;
  539.         return(NULL);
  540.     }
  541.     *flagp |= flags&HASWIDTH;
  542.     if (chain == NULL)    /* First piece. */
  543.         *flagp |= flags&SPSTART;
  544.     else {
  545.         regnaughty++;
  546.         regtail(chain, latest);
  547.     }
  548.     chain = latest;
  549.     }
  550.     if (chain == NULL)    /* Loop ran zero times. */
  551.     (void) regnode(NOTHING);
  552.  
  553.     return(ret);
  554. }
  555.  
  556. /*
  557.  - regpiece - something followed by possible [*+?]
  558.  *
  559.  * Note that the branching code sequences used for ? and the general cases
  560.  * of * and + are somewhat optimized:  they use the same NOTHING node as
  561.  * both the endmarker for their branch list and the body of the last branch.
  562.  * It might seem that this node could be dispensed with entirely, but the
  563.  * endmarker role is not redundant.
  564.  */
  565. static char *
  566. regpiece(flagp)
  567. I32 *flagp;
  568. {
  569.     register char *ret;
  570.     register char op;
  571.     register char *next;
  572.     I32 flags;
  573.     char *origparse = regparse;
  574.     char *maxpos;
  575.     I32 min;
  576.     I32 max = 32767;
  577.  
  578.     ret = regatom(&flags);
  579.     if (ret == NULL) {
  580.     if (flags & TRYAGAIN)
  581.         *flagp |= TRYAGAIN;
  582.     return(NULL);
  583.     }
  584.  
  585.     op = *regparse;
  586.     if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
  587.     while (op && op != ')')
  588.         op = *++regparse;
  589.     if (op) {
  590.         nextchar();
  591.         op = *regparse;
  592.     }
  593.     }
  594.  
  595.     if (op == '{' && regcurly(regparse)) {
  596.     next = regparse + 1;
  597.     maxpos = Nullch;
  598.     while (isDIGIT(*next) || *next == ',') {
  599.         if (*next == ',') {
  600.         if (maxpos)
  601.             break;
  602.         else
  603.             maxpos = next;
  604.         }
  605.         next++;
  606.     }
  607.     if (*next == '}') {        /* got one */
  608.         if (!maxpos)
  609.         maxpos = next;
  610.         regparse++;
  611.         min = atoi(regparse);
  612.         if (*maxpos == ',')
  613.         maxpos++;
  614.         else
  615.         maxpos = regparse;
  616.         max = atoi(maxpos);
  617.         if (!max && *maxpos != '0')
  618.         max = 32767;        /* meaning "infinity" */
  619.         regparse = next;
  620.         nextchar();
  621.  
  622.     do_curly:
  623.         if ((flags&SIMPLE)) {
  624.         regnaughty += 2 + regnaughty / 2;
  625.         reginsert(CURLY, ret);
  626.         }
  627.         else {
  628.         regnaughty += 4 + regnaughty;    /* compound interest */
  629.         regtail(ret, regnode(WHILEM));
  630.         reginsert(CURLYX,ret);
  631.         regtail(ret, regnode(NOTHING));
  632.         }
  633.  
  634.         if (min > 0)
  635.         *flagp = (WORST|HASWIDTH);
  636.         if (max && max < min)
  637.         croak("Can't do {n,m} with n > m");
  638.         if (regcode != ®dummy) {
  639. #ifdef REGALIGN
  640.         *(unsigned short *)(ret+3) = min;
  641.         *(unsigned short *)(ret+5) = max;
  642. #else
  643.         ret[3] = min >> 8; ret[4] = min & 0377;
  644.         ret[5] = max  >> 8; ret[6] = max  & 0377;
  645. #endif
  646.         }
  647.  
  648.         goto nest_check;
  649.     }
  650.     }
  651.  
  652.     if (!ISMULT1(op)) {
  653.     *flagp = flags;
  654.     return(ret);
  655.     }
  656.     nextchar();
  657.  
  658.     *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
  659.  
  660.     if (op == '*' && (flags&SIMPLE)) {
  661.     reginsert(STAR, ret);
  662.     regnaughty += 4;
  663.     }
  664.     else if (op == '*') {
  665.     min = 0;
  666.     goto do_curly;
  667.     } else if (op == '+' && (flags&SIMPLE)) {
  668.     reginsert(PLUS, ret);
  669.     regnaughty += 3;
  670.     }
  671.     else if (op == '+') {
  672.     min = 1;
  673.     goto do_curly;
  674.     } else if (op == '?') {
  675.     min = 0; max = 1;
  676.     goto do_curly;
  677.     }
  678.   nest_check:
  679.     if (dowarn && regcode != ®dummy && !(flags&HASWIDTH) && max > 10000) {
  680.     warn("%.*s matches null string many times",
  681.         regparse - origparse, origparse);
  682.     }
  683.  
  684.     if (*regparse == '?') {
  685.     nextchar();
  686.     reginsert(MINMOD, ret);
  687. #ifdef REGALIGN
  688.     regtail(ret, ret + 4);
  689. #else
  690.     regtail(ret, ret + 3);
  691. #endif
  692.     }
  693.     if (ISMULT2(regparse))
  694.     FAIL("nested *?+ in regexp");
  695.  
  696.     return(ret);
  697. }
  698.  
  699. /*
  700.  - regatom - the lowest level
  701.  *
  702.  * Optimization:  gobbles an entire sequence of ordinary characters so that
  703.  * it can turn them into a single node, which is smaller to store and
  704.  * faster to run.  Backslashed characters are exceptions, each becoming a
  705.  * separate node; the code is simpler that way and it's not worth fixing.
  706.  *
  707.  * [Yes, it is worth fixing, some scripts can run twice the speed.]
  708.  */
  709. static char *
  710. regatom(flagp)
  711. I32 *flagp;
  712. {
  713.     register char *ret = 0;
  714.     I32 flags;
  715.  
  716.     *flagp = WORST;        /* Tentatively. */
  717.  
  718. tryagain:
  719.     switch (*regparse) {
  720.     case '^':
  721.     nextchar();
  722.     if (regflags & PMf_MULTILINE)
  723.         ret = regnode(MBOL);
  724.     else if (regflags & PMf_SINGLELINE)
  725.         ret = regnode(SBOL);
  726.     else
  727.         ret = regnode(BOL);
  728.     break;
  729.     case '$':
  730.     nextchar();
  731.     if (regflags & PMf_MULTILINE)
  732.         ret = regnode(MEOL);
  733.     else if (regflags & PMf_SINGLELINE)
  734.         ret = regnode(SEOL);
  735.     else
  736.         ret = regnode(EOL);
  737.     break;
  738.     case '.':
  739.     nextchar();
  740.     if (regflags & PMf_SINGLELINE)
  741.         ret = regnode(SANY);
  742.     else
  743.         ret = regnode(ANY);
  744.     regnaughty++;
  745.     *flagp |= HASWIDTH|SIMPLE;
  746.     break;
  747.     case '[':
  748.     regparse++;
  749.     ret = regclass();
  750.     *flagp |= HASWIDTH|SIMPLE;
  751.     break;
  752.     case '(':
  753.     nextchar();
  754.     ret = reg(1, &flags);
  755.     if (ret == NULL) {
  756.         if (flags & TRYAGAIN)
  757.             goto tryagain;
  758.         return(NULL);
  759.     }
  760.     *flagp |= flags&(HASWIDTH|SPSTART);
  761.     break;
  762.     case '|':
  763.     case ')':
  764.     if (flags & TRYAGAIN) {
  765.         *flagp |= TRYAGAIN;
  766.         return NULL;
  767.     }
  768.     croak("internal urp in regexp at /%s/", regparse);
  769.                 /* Supposed to be caught earlier. */
  770.     break;
  771.     case '?':
  772.     case '+':
  773.     case '*':
  774.     FAIL("?+* follows nothing in regexp");
  775.     break;
  776.     case '\\':
  777.     switch (*++regparse) {
  778.     case 'A':
  779.         ret = regnode(SBOL);
  780.         *flagp |= SIMPLE;
  781.         nextchar();
  782.         break;
  783.     case 'G':
  784.         ret = regnode(GBOL);
  785.         *flagp |= SIMPLE;
  786.         nextchar();
  787.         break;
  788.     case 'Z':
  789.         ret = regnode(SEOL);
  790.         *flagp |= SIMPLE;
  791.         nextchar();
  792.         break;
  793.     case 'w':
  794.         ret = regnode(ALNUM);
  795.         *flagp |= HASWIDTH|SIMPLE;
  796.         nextchar();
  797.         break;
  798.     case 'W':
  799.         ret = regnode(NALNUM);
  800.         *flagp |= HASWIDTH|SIMPLE;
  801.         nextchar();
  802.         break;
  803.     case 'b':
  804.         ret = regnode(BOUND);
  805.         *flagp |= SIMPLE;
  806.         nextchar();
  807.         break;
  808.     case 'B':
  809.         ret = regnode(NBOUND);
  810.         *flagp |= SIMPLE;
  811.         nextchar();
  812.         break;
  813.     case 's':
  814.         ret = regnode(SPACE);
  815.         *flagp |= HASWIDTH|SIMPLE;
  816.         nextchar();
  817.         break;
  818.     case 'S':
  819.         ret = regnode(NSPACE);
  820.         *flagp |= HASWIDTH|SIMPLE;
  821.         nextchar();
  822.         break;
  823.     case 'd':
  824.         ret = regnode(DIGIT);
  825.         *flagp |= HASWIDTH|SIMPLE;
  826.         nextchar();
  827.         break;
  828.     case 'D':
  829.         ret = regnode(NDIGIT);
  830.         *flagp |= HASWIDTH|SIMPLE;
  831.         nextchar();
  832.         break;
  833.     case 'n':
  834.     case 'r':
  835.     case 't':
  836.     case 'f':
  837.     case 'e':
  838.     case 'a':
  839.     case 'x':
  840.     case 'c':
  841.     case '0':
  842.         goto defchar;
  843.     case '1': case '2': case '3': case '4':
  844.     case '5': case '6': case '7': case '8': case '9':
  845.         {
  846.         I32 num = atoi(regparse);
  847.  
  848.         if (num > 9 && num >= regnpar)
  849.             goto defchar;
  850.         else {
  851.             regsawback = 1;
  852.             ret = reganode(REF, num);
  853.             *flagp |= HASWIDTH;
  854.             while (isDIGIT(*regparse))
  855.             regparse++;
  856.             regparse--;
  857.             nextchar();
  858.         }
  859.         }
  860.         break;
  861.     case '\0':
  862.         if (regparse >= regxend)
  863.         FAIL("trailing \\ in regexp");
  864.         /* FALL THROUGH */
  865.     default:
  866.         goto defchar;
  867.     }
  868.     break;
  869.     default: {
  870.         register I32 len;
  871.         register char ender;
  872.         register char *p;
  873.         char *oldp;
  874.         I32 numlen;
  875.  
  876.         regparse++;
  877.  
  878.     defchar:
  879.         ret = regnode(EXACTLY);
  880.         regc(0);        /* save spot for len */
  881.         for (len = 0, p = regparse - 1;
  882.           len < 127 && p < regxend;
  883.           len++)
  884.         {
  885.         oldp = p;
  886.         switch (*p) {
  887.         case '^':
  888.         case '$':
  889.         case '.':
  890.         case '[':
  891.         case '(':
  892.         case ')':
  893.         case '|':
  894.             goto loopdone;
  895.         case '\\':
  896.             switch (*++p) {
  897.             case 'A':
  898.             case 'G':
  899.             case 'Z':
  900.             case 'w':
  901.             case 'W':
  902.             case 'b':
  903.             case 'B':
  904.             case 's':
  905.             case 'S':
  906.             case 'd':
  907.             case 'D':
  908.             --p;
  909.             goto loopdone;
  910.             case 'n':
  911.             ender = '\n';
  912.             p++;
  913.             break;
  914.             case 'r':
  915.             ender = '\r';
  916.             p++;
  917.             break;
  918.             case 't':
  919.             ender = '\t';
  920.             p++;
  921.             break;
  922.             case 'f':
  923.             ender = '\f';
  924.             p++;
  925.             break;
  926.             case 'e':
  927.             ender = '\033';
  928.             p++;
  929.             break;
  930.             case 'a':
  931.             ender = '\007';
  932.             p++;
  933.             break;
  934.             case 'x':
  935.             ender = scan_hex(++p, 2, &numlen);
  936.             p += numlen;
  937.             break;
  938.             case 'c':
  939.             p++;
  940.             ender = *p++;
  941.             if (isLOWER(ender))
  942.                 ender = toUPPER(ender);
  943.             ender ^= 64;
  944.             break;
  945.             case '0': case '1': case '2': case '3':case '4':
  946.             case '5': case '6': case '7': case '8':case '9':
  947.             if (*p == '0' ||
  948.               (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
  949.                 ender = scan_oct(p, 3, &numlen);
  950.                 p += numlen;
  951.             }
  952.             else {
  953.                 --p;
  954.                 goto loopdone;
  955.             }
  956.             break;
  957.             case '\0':
  958.             if (p >= regxend)
  959.                 FAIL("trailing \\ in regexp");
  960.             /* FALL THROUGH */
  961.             default:
  962.             ender = *p++;
  963.             break;
  964.             }
  965.             break;
  966.         case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
  967.             if (regflags & PMf_EXTENDED) {
  968.             p++;
  969.             len--;
  970.             continue;
  971.             }
  972.             /* FALL THROUGH */
  973.         default:
  974.             ender = *p++;
  975.             break;
  976.         }
  977.         if (regflags & PMf_FOLD && isUPPER(ender))
  978.             ender = toLOWER(ender);
  979.         if (ISMULT2(p)) { /* Back off on ?+*. */
  980.             if (len)
  981.             p = oldp;
  982.             else {
  983.             len++;
  984.             regc(ender);
  985.             }
  986.             break;
  987.         }
  988.         regc(ender);
  989.         }
  990.     loopdone:
  991.         regparse = p - 1;
  992.         nextchar();
  993.         if (len < 0)
  994.         FAIL("internal disaster in regexp");
  995.         if (len > 0)
  996.         *flagp |= HASWIDTH;
  997.         if (len == 1)
  998.         *flagp |= SIMPLE;
  999.         if (regcode != ®dummy)
  1000.         *OPERAND(ret) = len;
  1001.         regc('\0');
  1002.     }
  1003.     break;
  1004.     }
  1005.  
  1006.     return(ret);
  1007. }
  1008.  
  1009. static void
  1010. regset(bits,def,c)
  1011. char *bits;
  1012. I32 def;
  1013. register I32 c;
  1014. {
  1015.     if (regcode == ®dummy)
  1016.       return;
  1017.     c &= 255;
  1018.     if (def)
  1019.     bits[c >> 3] &= ~(1 << (c & 7));
  1020.     else
  1021.     bits[c >> 3] |=  (1 << (c & 7));
  1022. }
  1023.  
  1024. static char *
  1025. regclass()
  1026. {
  1027.     register char *bits;
  1028.     register I32 class;
  1029.     register I32 lastclass = 1234;
  1030.     register I32 range = 0;
  1031.     register char *ret;
  1032.     register I32 def;
  1033.     I32 numlen;
  1034.  
  1035.     ret = regnode(ANYOF);
  1036.     if (*regparse == '^') {    /* Complement of range. */
  1037.     regnaughty++;
  1038.     regparse++;
  1039.     def = 0;
  1040.     } else {
  1041.     def = 255;
  1042.     }
  1043.     bits = regcode;
  1044.     for (class = 0; class < 32; class++)
  1045.       regc(def);
  1046.     if (*regparse == ']' || *regparse == '-')
  1047.     goto skipcond;        /* allow 1st char to be ] or - */
  1048.     while (regparse < regxend && *regparse != ']') {
  1049.        skipcond:
  1050.     class = UCHARAT(regparse++);
  1051.     if (class == '\\') {
  1052.         class = UCHARAT(regparse++);
  1053.         switch (class) {
  1054.         case 'w':
  1055.         for (class = 0; class < 256; class++)
  1056.           if (isALNUM(class))
  1057.             regset(bits,def,class);
  1058.         lastclass = 1234;
  1059.         continue;
  1060.         case 'W':
  1061.         for (class = 0; class < 256; class++)
  1062.           if (!isALNUM(class))
  1063.             regset(bits,def,class);
  1064.         lastclass = 1234;
  1065.         continue;
  1066.         case 's':
  1067.         for (class = 0; class < 256; class++)
  1068.           if (isSPACE(class))
  1069.             regset(bits,def,class);
  1070.         lastclass = 1234;
  1071.         continue;
  1072.         case 'S':
  1073.         for (class = 0; class < 256; class++)
  1074.           if (!isSPACE(class))
  1075.             regset(bits,def,class);
  1076.         lastclass = 1234;
  1077.         continue;
  1078.         case 'd':
  1079.         for (class = '0'; class <= '9'; class++)
  1080.             regset(bits,def,class);
  1081.         lastclass = 1234;
  1082.         continue;
  1083.         case 'D':
  1084.         for (class = 0; class < '0'; class++)
  1085.             regset(bits,def,class);
  1086.         for (class = '9' + 1; class < 256; class++)
  1087.             regset(bits,def,class);
  1088.         lastclass = 1234;
  1089.         continue;
  1090.         case 'n':
  1091.         class = '\n';
  1092.         break;
  1093.         case 'r':
  1094.         class = '\r';
  1095.         break;
  1096.         case 't':
  1097.         class = '\t';
  1098.         break;
  1099.         case 'f':
  1100.         class = '\f';
  1101.         break;
  1102.         case 'b':
  1103.         class = '\b';
  1104.         break;
  1105.         case 'e':
  1106.         class = '\033';
  1107.         break;
  1108.         case 'a':
  1109.         class = '\007';
  1110.         break;
  1111.         case 'x':
  1112.         class = scan_hex(regparse, 2, &numlen);
  1113.         regparse += numlen;
  1114.         break;
  1115.         case 'c':
  1116.         class = *regparse++;
  1117.         if (isLOWER(class))
  1118.           class = toUPPER(class);
  1119.         class ^= 64;
  1120.         break;
  1121.         case '0': case '1': case '2': case '3': case '4':
  1122.         case '5': case '6': case '7': case '8': case '9':
  1123.         class = scan_oct(--regparse, 3, &numlen);
  1124.         regparse += numlen;
  1125.         break;
  1126.         }
  1127.     }
  1128.     if (range) {
  1129.         if (lastclass > class)
  1130.         FAIL("invalid [] range in regexp");
  1131.         range = 0;
  1132.     }
  1133.     else {
  1134.         lastclass = class;
  1135.         if (*regparse == '-' && regparse+1 < regxend &&
  1136.           regparse[1] != ']') {
  1137.         regparse++;
  1138.         range = 1;
  1139.         continue;    /* do it next time */
  1140.         }
  1141.     }
  1142.     for ( ; lastclass <= class; lastclass++) {
  1143.         regset(bits,def,lastclass);
  1144.         if (regflags & PMf_FOLD && isUPPER(lastclass))
  1145.         regset(bits,def,toLOWER(lastclass));
  1146.     }
  1147.     lastclass = class;
  1148.     }
  1149.     if (*regparse != ']')
  1150.     FAIL("unmatched [] in regexp");
  1151.     nextchar();
  1152.     return ret;
  1153. }
  1154.  
  1155. static char*
  1156. nextchar()
  1157. {
  1158.     char* retval = regparse++;
  1159.  
  1160.     if (regflags & PMf_EXTENDED) {
  1161.     while (isSPACE(*regparse))
  1162.         regparse++;
  1163.     }
  1164.     return retval;
  1165. }
  1166.  
  1167. /*
  1168. - regnode - emit a node
  1169. */
  1170. #ifdef CAN_PROTOTYPE
  1171. static char *            /* Location. */
  1172. regnode(char op)
  1173. #else
  1174. static char *            /* Location. */
  1175. regnode(op)
  1176. char op;
  1177. #endif
  1178. {
  1179.     register char *ret;
  1180.     register char *ptr;
  1181.  
  1182.     ret = regcode;
  1183.     if (ret == ®dummy) {
  1184. #ifdef REGALIGN
  1185.     if (!(regsize & 1))
  1186.         regsize++;
  1187. #endif
  1188.     regsize += 3;
  1189.     return(ret);
  1190.     }
  1191.  
  1192. #ifdef REGALIGN
  1193. #ifndef lint
  1194.     if (!((long)ret & 1))
  1195.       *ret++ = 127;
  1196. #endif
  1197. #endif
  1198.     ptr = ret;
  1199.     *ptr++ = op;
  1200.     *ptr++ = '\0';        /* Null "next" pointer. */
  1201.     *ptr++ = '\0';
  1202.     regcode = ptr;
  1203.  
  1204.     return(ret);
  1205. }
  1206.  
  1207. /*
  1208. - reganode - emit a node with an argument
  1209. */
  1210. #ifdef CAN_PROTOTYPE
  1211. static char *            /* Location. */
  1212. reganode(char op, unsigned short arg)
  1213. #else
  1214. static char *            /* Location. */
  1215. reganode(op, arg)
  1216. char op;
  1217. unsigned short arg;
  1218. #endif
  1219. {
  1220.     register char *ret;
  1221.     register char *ptr;
  1222.  
  1223.     ret = regcode;
  1224.     if (ret == ®dummy) {
  1225. #ifdef REGALIGN
  1226.     if (!(regsize & 1))
  1227.         regsize++;
  1228. #endif
  1229.     regsize += 5;
  1230.     return(ret);
  1231.     }
  1232.  
  1233. #ifdef REGALIGN
  1234. #ifndef lint
  1235.     if (!((long)ret & 1))
  1236.       *ret++ = 127;
  1237. #endif
  1238. #endif
  1239.     ptr = ret;
  1240.     *ptr++ = op;
  1241.     *ptr++ = '\0';        /* Null "next" pointer. */
  1242.     *ptr++ = '\0';
  1243. #ifdef REGALIGN
  1244.     *(unsigned short *)(ret+3) = arg;
  1245. #else
  1246.     ret[3] = arg >> 8; ret[4] = arg & 0377;
  1247. #endif
  1248.     ptr += 2;
  1249.     regcode = ptr;
  1250.  
  1251.     return(ret);
  1252. }
  1253.  
  1254. /*
  1255. - regc - emit (if appropriate) a byte of code
  1256. */
  1257. #ifdef CAN_PROTOTYPE
  1258. static void
  1259. regc(char b)
  1260. #else
  1261. static void
  1262. regc(b)
  1263. char b;
  1264. #endif
  1265. {
  1266.     if (regcode != ®dummy)
  1267.     *regcode++ = b;
  1268.     else
  1269.     regsize++;
  1270. }
  1271.  
  1272. /*
  1273. - reginsert - insert an operator in front of already-emitted operand
  1274. *
  1275. * Means relocating the operand.
  1276. */
  1277. #ifdef CAN_PROTOTYPE
  1278. static void
  1279. reginsert(char op, char *opnd)
  1280. #else
  1281. static void
  1282. reginsert(op, opnd)
  1283. char op;
  1284. char *opnd;
  1285. #endif
  1286. {
  1287.     register char *src;
  1288.     register char *dst;
  1289.     register char *place;
  1290.     register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
  1291.  
  1292.     if (regcode == ®dummy) {
  1293. #ifdef REGALIGN
  1294.     regsize += 4 + offset;
  1295. #else
  1296.     regsize += 3 + offset;
  1297. #endif
  1298.     return;
  1299.     }
  1300.  
  1301.     src = regcode;
  1302. #ifdef REGALIGN
  1303.     regcode += 4 + offset;
  1304. #else
  1305.     regcode += 3 + offset;
  1306. #endif
  1307.     dst = regcode;
  1308.     while (src > opnd)
  1309.     *--dst = *--src;
  1310.  
  1311.     place = opnd;        /* Op node, where operand used to be. */
  1312.     *place++ = op;
  1313.     *place++ = '\0';
  1314.     *place++ = '\0';
  1315.     while (offset-- > 0)
  1316.     *place++ = '\0';
  1317. #ifdef REGALIGN
  1318.     *place++ = '\177';
  1319. #endif
  1320. }
  1321.  
  1322. /*
  1323. - regtail - set the next-pointer at the end of a node chain
  1324. */
  1325. static void
  1326. regtail(p, val)
  1327. char *p;
  1328. char *val;
  1329. {
  1330.     register char *scan;
  1331.     register char *temp;
  1332.     register I32 offset;
  1333.  
  1334.     if (p == ®dummy)
  1335.     return;
  1336.  
  1337.     /* Find last node. */
  1338.     scan = p;
  1339.     for (;;) {
  1340.     temp = regnext(scan);
  1341.     if (temp == NULL)
  1342.         break;
  1343.     scan = temp;
  1344.     }
  1345.  
  1346. #ifdef REGALIGN
  1347.     offset = val - scan;
  1348. #ifndef lint
  1349.     *(short*)(scan+1) = offset;
  1350. #else
  1351.     offset = offset;
  1352. #endif
  1353. #else
  1354.     if (OP(scan) == BACK)
  1355.     offset = scan - val;
  1356.     else
  1357.     offset = val - scan;
  1358.     *(scan+1) = (offset>>8)&0377;
  1359.     *(scan+2) = offset&0377;
  1360. #endif
  1361. }
  1362.  
  1363. /*
  1364. - regoptail - regtail on operand of first argument; nop if operandless
  1365. */
  1366. static void
  1367. regoptail(p, val)
  1368. char *p;
  1369. char *val;
  1370. {
  1371.     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
  1372.     if (p == NULL || p == ®dummy || regkind[(U8)OP(p)] != BRANCH)
  1373.     return;
  1374.     regtail(NEXTOPER(p), val);
  1375. }
  1376.  
  1377. /*
  1378.  - regcurly - a little FSA that accepts {\d+,?\d*}
  1379.  */
  1380. STATIC I32
  1381. regcurly(s)
  1382. register char *s;
  1383. {
  1384.     if (*s++ != '{')
  1385.     return FALSE;
  1386.     if (!isDIGIT(*s))
  1387.     return FALSE;
  1388.     while (isDIGIT(*s))
  1389.     s++;
  1390.     if (*s == ',')
  1391.     s++;
  1392.     while (isDIGIT(*s))
  1393.     s++;
  1394.     if (*s != '}')
  1395.     return FALSE;
  1396.     return TRUE;
  1397. }
  1398.  
  1399. #ifdef DEBUGGING
  1400.  
  1401. #ifdef macintosh
  1402. #undef stderr
  1403. #define stderr gPerlDbg
  1404. #endif
  1405.  
  1406. /*
  1407.  - regdump - dump a regexp onto stderr in vaguely comprehensible form
  1408.  */
  1409. void
  1410. regdump(r)
  1411. regexp *r;
  1412. {
  1413.     register char *s;
  1414.     register char op = EXACTLY;    /* Arbitrary non-END op. */
  1415.     register char *next;
  1416.  
  1417.  
  1418.     s = r->program + 1;
  1419.     while (op != END) {    /* While that wasn't END last time... */
  1420. #ifdef REGALIGN
  1421.     if (!((long)s & 1))
  1422.         s++;
  1423. #endif
  1424.     op = OP(s);
  1425.     fprintf(stderr,"%2d%s", s-r->program, regprop(s));    /* Where, what. */
  1426.     next = regnext(s);
  1427.     s += regarglen[(U8)op];
  1428.     if (next == NULL)        /* Next ptr. */
  1429.         fprintf(stderr,"(0)");
  1430.     else 
  1431.         fprintf(stderr,"(%d)", (s-r->program)+(next-s));
  1432.     s += 3;
  1433.     if (op == ANYOF) {
  1434.         s += 32;
  1435.     }
  1436.     if (op == EXACTLY) {
  1437.         /* Literal string, where present. */
  1438.         s++;
  1439.         (void)putc(' ', stderr);
  1440.         (void)putc('<', stderr);
  1441.         while (*s != '\0') {
  1442.         (void)putc(*s, stderr);
  1443.         s++;
  1444.         }
  1445.         (void)putc('>', stderr);
  1446.         s++;
  1447.     }
  1448.     (void)putc('\n', stderr);
  1449.     }
  1450.  
  1451.     /* Header fields of interest. */
  1452.     if (r->regstart)
  1453.     fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
  1454.     if (r->regstclass)
  1455.     fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
  1456.     if (r->reganch & ROPT_ANCH)
  1457.     fprintf(stderr,"anchored ");
  1458.     if (r->reganch & ROPT_SKIP)
  1459.     fprintf(stderr,"plus ");
  1460.     if (r->reganch & ROPT_IMPLICIT)
  1461.     fprintf(stderr,"implicit ");
  1462.     if (r->regmust != NULL)
  1463.     fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
  1464.      (long) r->regback);
  1465.     fprintf(stderr, "minlen %ld ", (long) r->minlen);
  1466.     fprintf(stderr,"\n");
  1467. }
  1468.  
  1469. /*
  1470. - regprop - printable representation of opcode
  1471. */
  1472. char *
  1473. regprop(op)
  1474. char *op;
  1475. {
  1476.     register char *p = 0;
  1477.  
  1478.     (void) strcpy(buf, ":");
  1479.  
  1480.     switch (OP(op)) {
  1481.     case BOL:
  1482.     p = "BOL";
  1483.     break;
  1484.     case MBOL:
  1485.     p = "MBOL";
  1486.     break;
  1487.     case SBOL:
  1488.     p = "SBOL";
  1489.     break;
  1490.     case EOL:
  1491.     p = "EOL";
  1492.     break;
  1493.     case MEOL:
  1494.     p = "MEOL";
  1495.     break;
  1496.     case SEOL:
  1497.     p = "SEOL";
  1498.     break;
  1499.     case ANY:
  1500.     p = "ANY";
  1501.     break;
  1502.     case SANY:
  1503.     p = "SANY";
  1504.     break;
  1505.     case ANYOF:
  1506.     p = "ANYOF";
  1507.     break;
  1508.     case BRANCH:
  1509.     p = "BRANCH";
  1510.     break;
  1511.     case EXACTLY:
  1512.     p = "EXACTLY";
  1513.     break;
  1514.     case NOTHING:
  1515.     p = "NOTHING";
  1516.     break;
  1517.     case BACK:
  1518.     p = "BACK";
  1519.     break;
  1520.     case END:
  1521.     p = "END";
  1522.     break;
  1523.     case ALNUM:
  1524.     p = "ALNUM";
  1525.     break;
  1526.     case NALNUM:
  1527.     p = "NALNUM";
  1528.     break;
  1529.     case BOUND:
  1530.     p = "BOUND";
  1531.     break;
  1532.     case NBOUND:
  1533.     p = "NBOUND";
  1534.     break;
  1535.     case SPACE:
  1536.     p = "SPACE";
  1537.     break;
  1538.     case NSPACE:
  1539.     p = "NSPACE";
  1540.     break;
  1541.     case DIGIT:
  1542.     p = "DIGIT";
  1543.     break;
  1544.     case NDIGIT:
  1545.     p = "NDIGIT";
  1546.     break;
  1547.     case CURLY:
  1548.     (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
  1549.     p = NULL;
  1550.     break;
  1551.     case CURLYX:
  1552.     (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
  1553.     p = NULL;
  1554.     break;
  1555.     case REF:
  1556.     (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
  1557.     p = NULL;
  1558.     break;
  1559.     case OPEN:
  1560.     (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
  1561.     p = NULL;
  1562.     break;
  1563.     case CLOSE:
  1564.     (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
  1565.     p = NULL;
  1566.     break;
  1567.     case STAR:
  1568.     p = "STAR";
  1569.     break;
  1570.     case PLUS:
  1571.     p = "PLUS";
  1572.     break;
  1573.     case MINMOD:
  1574.     p = "MINMOD";
  1575.     break;
  1576.     case GBOL:
  1577.     p = "GBOL";
  1578.     break;
  1579.     case UNLESSM:
  1580.     p = "UNLESSM";
  1581.     break;
  1582.     case IFMATCH:
  1583.     p = "IFMATCH";
  1584.     break;
  1585.     case SUCCEED:
  1586.     p = "SUCCEED";
  1587.     break;
  1588.     case WHILEM:
  1589.     p = "WHILEM";
  1590.     break;
  1591.     default:
  1592.     FAIL("corrupted regexp opcode");
  1593.     }
  1594.     if (p != NULL)
  1595.     (void) strcat(buf, p);
  1596.     return(buf);
  1597. }
  1598. #endif /* DEBUGGING */
  1599.  
  1600. void
  1601. regfree(r)
  1602. struct regexp *r;
  1603. {
  1604.     if (!r)
  1605.     return;
  1606.     if (r->precomp) {
  1607.     Safefree(r->precomp);
  1608.     r->precomp = Nullch;
  1609.     }
  1610.     if (r->subbase) {
  1611.     Safefree(r->subbase);
  1612.     r->subbase = Nullch;
  1613.     }
  1614.     if (r->regmust) {
  1615.     SvREFCNT_dec(r->regmust);
  1616.     r->regmust = Nullsv;
  1617.     }
  1618.     if (r->regstart) {
  1619.     SvREFCNT_dec(r->regstart);
  1620.     r->regstart = Nullsv;
  1621.     }
  1622.     Safefree(r->startp);
  1623.     Safefree(r->endp);
  1624.     Safefree(r);
  1625. }
  1626.