src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.46 2024/02/24 19:26:44 greg Exp $";
#endif
/*
 *  Compute data values using expression parser
 *
 *  7/1/85  Greg Ward
 *
 *  11/11/85  Made channel input conditional with (INCHAN) compiles.
 *
 *  4/2/86  Added conditional compiles for function definitions (FUNCTION).
 *
 *  1/29/87  Made variables conditional (VARIABLE)
 *
 *  5/19/88  Added constant subexpression elimination (RCONST)
 *
 *  2/19/03     Eliminated conditional compiles in favor of esupport extern.
 */

#include "copyright.h"

#include  <ctype.h>
#include  <errno.h>
#include  <math.h>
#include  <stdlib.h>

#include  "rtmisc.h"
#include  "rtio.h"
#include  "rterror.h"
#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))

#define  isdecimal(c)   (isdigit(c) | ((c) == '.'))

#define  envalue(ep)    ((ep)->type==NUM ? (ep)->v.num : evalue(ep))

static double  euminus(EPNODE *), eargument(EPNODE *), enumber(EPNODE *);
static double  echannel(EPNODE *);
static double  eadd(EPNODE *), esubtr(EPNODE *),
               emult(EPNODE *), edivi(EPNODE *),
               epow(EPNODE *);
static double  ebotch(EPNODE *);

unsigned int  esupport =                /* what to support */
                E_VARIABLE | E_FUNCTION ;

int  eofc = 0;                          /* optional end-of-file character */
int  nextc;                             /* lookahead character */

double  (*eoper[])(EPNODE *) = {        /* expression operations */
        ebotch,
        evariable,
        enumber,
        euminus,
        echannel,
        efunc,
        eargument,
        ebotch,
        ebotch,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        emult,
        eadd,
        0,
        esubtr,
        0,
        edivi,
        0,0,0,0,0,0,0,0,0,0,
        ebotch,
        0,0,
        ebotch,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        epow,
};

static FILE  *infp;                     /* input file pointer */
static char  *linbuf;                   /* line buffer */
static char  *infile;                   /* input file name */
static int  lineno;                     /* input line number */
static int  linepos;                    /* position in buffer */


EPNODE *
eparse(                 /* parse an expression string */
    char  *expr
)
{
    EPNODE  *ep;

    initstr(expr, NULL, 0);
    curfunc = NULL;
    ep = getE1();
    if (nextc != EOF)
        syntax("unexpected character");
    return(ep);
}


double
eval(                   /* evaluate an expression string */
    char  *expr
)
{
    int  prev_support = esupport;
    EPNODE  *ep;
    double  rval;

    esupport &= ~E_RCONST;      /* don't bother reducing constant expr */
    ep = eparse(expr);
    esupport = prev_support;    /* as you were */
    rval = evalue(ep);
    epfree(ep,1);
    return(rval);
}


int
epcmp(                  /* compare two expressions for equivalence */
    EPNODE  *ep1,
    EPNODE  *ep2
)
{
        double  d;

        if (ep1->type != ep2->type)
                return(1);

        switch (ep1->type) {

        case VAR:
                return(ep1->v.ln != ep2->v.ln);

        case NUM:
                if (ep2->v.num == 0)
                        return(ep1->v.num != 0);
                d = ep1->v.num / ep2->v.num;
                return((d > 1.000000000001) | (d < 0.999999999999));

        case CHAN:
        case ARG:
                return(ep1->v.chan != ep2->v.chan);

        case '=':
        case ':':
                return(epcmp(ep1->v.kid->sibling, ep2->v.kid->sibling));

        case CLKT:
        case SYM:                       /* should never get this one */
                return(0);

        default:
                ep1 = ep1->v.kid;
                ep2 = ep2->v.kid;
                while (ep1 != NULL) {
                        if (ep2 == NULL)
                                return(1);
                        if (epcmp(ep1, ep2))
                                return(1);
                        ep1 = ep1->sibling;
                        ep2 = ep2->sibling;
                }
                return(ep2 != NULL);
        }
}


void
epfree(                 /* free a parse tree */
    EPNODE       *epar,
    int         frep
)
{
    EPNODE      *ep;

    switch (epar->type) {

        case VAR:
            varfree(epar->v.ln);
            break;
            
        case SYM:
            freestr(epar->v.name);
            break;

        case NUM:
        case CHAN:
        case ARG:
        case CLKT:
            break;

        default:
            if (epar->nkids < 0) {
                ep = epar->v.kid - epar->nkids;
                while (ep > epar->v.kid)
                        epfree(--ep, 0);
                efree(ep);      /* free array space */
            } else
                while ((ep = epar->v.kid) != NULL) {
                    epar->v.kid = ep->sibling;
                    epfree(ep, 1);
                }
            break;

    }
    if (frep)
        efree(epar);
}


static void
epflatten(                      /* flatten hierarchies for '+', '*' */
        EPNODE *epar
)
{
    EPNODE      *ep;

    if (epar->nkids < 0) {
        eputs("Cannot flatten EPNODE array\n");
        quit(1);
    }
    for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
        while (ep->type == epar->type) {
            EPNODE      *ep1 = ep->v.kid;
            while (ep1->sibling != NULL)
                ep1 = ep1->sibling;
            ep1->sibling = ep->sibling;
            epar->nkids += nekids(ep) - 1;
            ep1 = ep->v.kid;
            *ep = *ep1;
            efree(ep1);         /* not epfree()! */
        }
}


void
epoptimize(                     /* flatten operations, lists -> arrays */
        EPNODE  *epar
)
{
    EPNODE      *ep;

    if ((epar->type == '+') | (epar->type == '*'))
        epflatten(epar);        /* flatten associative operations */

    if (epar->nkids)            /* do children if any */
        for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
            epoptimize(ep);

    if (epar->nkids > 4) {      /* make list into array if > 4 kids */
        int     n = 1;
        epar->v.kid = (EPNODE *)erealloc(epar->v.kid,
                                        sizeof(EPNODE)*epar->nkids);
        while (n < epar->nkids) {
            ep = epar->v.kid[n-1].sibling;
            epar->v.kid[n] = *ep;
            efree(ep);          /* not epfree()! */
            epar->v.kid[n-1].sibling = epar->v.kid + n;
            n++;
        }
        epar->nkids = -n;
    }
}

                                /* the following used to be a switch */
static double
eargument(
    EPNODE      *ep
)
{
    return(argument(ep->v.chan));
}

static double
enumber(
    EPNODE      *ep
)
{
    return(ep->v.num);
}

static double
euminus(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;

    return(-evalue(ep1));
}

static double
echannel(
    EPNODE      *ep
)
{
    return(chanvalue(ep->v.chan));
}

static double
eadd(
    EPNODE      *ep
)
{
    double  sum = 0;
    EPNODE  *ep1 = ep->v.kid;

    do
        sum += envalue(ep1);
    while ((ep1 = ep1->sibling) != NULL);

    return(sum);
}

static double
esubtr(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;
    EPNODE  *ep2 = ep1->sibling;

    return(envalue(ep1) - envalue(ep2));
}

static double
emult(
    EPNODE      *ep
)
{
    double  prod = 1;
    EPNODE  *ep1 = ep->v.kid;

    do
        prod *= envalue(ep1);
    while ((ep1 = ep1->sibling) != NULL);

    return(prod);
}

static double
edivi(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;
    EPNODE  *ep2 = ep1->sibling;
    double  d;

    d = evalue(ep2);
    if (d == 0.0) {
        wputs("Division by zero\n");
        errno = ERANGE;
        return(0.0);
    }
    return(envalue(ep1) / d);
}

static double
epow(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;
    double  d;
    int  lasterrno;

    lasterrno = errno;
    errno = 0;
    d = pow(evalue(ep1), evalue(ep1->sibling));
#ifdef  isnan
    if (errno == 0) {
        if (isnan(d))
            errno = EDOM;
        else if (isinf(d))
            errno = ERANGE;
    }
#endif
    if ((errno == EDOM) | (errno == ERANGE)) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

static double
ebotch(
    EPNODE      *ep
)
{
    eputs("Bad expression!\n");
    quit(1);
        return 0.0; /* pro forma return */
}


EPNODE *
ekid(                   /* return pointer to a node's nth kid */
    EPNODE       *ep,
    int  n
)
{
    if (ep->nkids < 0) {        /* allocated array? */
        if (n >= -ep->nkids)
            return(NULL);
        return(ep->v.kid + n);
    }
    ep = ep->v.kid;             /* else get from list */
    while (n-- > 0)
        if ((ep = ep->sibling) == NULL)
                break;
    return(ep);
}


void
initfile(               /* prepare input file */
    FILE  *fp,
    char  *fn,
    int  ln
)
{
    static char  inpbuf[MAXLINE];

    infp = fp;
    linbuf = inpbuf;
    infile = fn;
    lineno = ln;
    linepos = 0;
    inpbuf[0] = '\0';
    scan();
}


void
initstr(                /* prepare input string */
    char  *s,
    char  *fn,
    int  ln
)
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


void
getscanpos(     /* return current scan position */
    char  **fnp,
    int  *lnp,
    char  **spp,
    FILE  **fpp
)
{
    if (fnp != NULL) *fnp = infile;
    if (lnp != NULL) *lnp = lineno;
    if (spp != NULL) *spp = linbuf+linepos;
    if (fpp != NULL) *fpp = infp;
}


int
scan(void)              /* scan next character, return literal next */
{
    int  lnext = 0;

    do {
        if (linbuf[linepos] == '\0')
            if (infp == NULL || fgets(linbuf, MAXLINE, infp) == NULL)
                nextc = EOF;
            else {
                nextc = linbuf[0];
                lineno++;
                linepos = 1;
            }
        else
            nextc = linbuf[linepos++];
        if (!lnext)
                lnext = nextc;
        if (nextc == eofc) {
                nextc = EOF;
                break;
        }
        if (nextc == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
    return(lnext);
}


char *
long2ascii(                           /* convert long to ascii */
    long  l
)
{
    static char  buf[16];
    char  *cp;
    int  neg = 0;

    if (l == 0)
        return("0");
    if (l < 0) {
        l = -l;
        neg++;
    }
    cp = buf + sizeof(buf);
    *--cp = '\0';
    while (l) {
        *--cp = l % 10 + '0';
        l /= 10;
    }
    if (neg)
        *--cp = '-';
    return(cp);
}


void
syntax(                 /* report syntax error and quit */
    char  *err
)
{
    int  i;

    if ((infile != NULL) | (lineno != 0)) {
        if (infile != NULL) eputs(infile);
        if (lineno != 0) {
            eputs(infile != NULL ? ", line " : "line ");
            eputs(long2ascii((long)lineno));
        }
        eputs(":\n");
    }
    eputs(linbuf);
    if (linbuf[strlen(linbuf)-1] != '\n')
        eputs("\n");
    for (i = 0; i < linepos-1; i++)
        eputs(linbuf[i] == '\t' ? "\t" : " ");
    eputs("^ ");
    eputs(err);
    eputs("\n");
    quit(1);
}


void
addekid(                        /* add a child to ep */
    EPNODE       *ep,
    EPNODE      *ek
)
{
    if (ep->nkids < 0) {
        eputs("Cannot add kid to EPNODE array\n");
        quit(1);
    }
    ep->nkids++;
    if (ep->v.kid == NULL)
        ep->v.kid = ek;
    else {
        for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
            ;
        ep->sibling = ek;
    }
    ek->sibling = NULL;         /* shouldn't be necessary */
}


char *
getname(void)                   /* scan an identifier */
{
    static char  str[RMAXWORD+1];
    int  i, lnext;

    lnext = nextc;
    for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
        str[i] = lnext;
    str[i] = '\0';
    while (isid(lnext))         /* skip rest of name */
        lnext = scan();

    return(str);
}


int
getinum(void)                   /* scan a positive integer */
{
    int  n, lnext;

    n = 0;
    lnext = nextc;
    while (isdigit(lnext)) {
        n = n * 10 + lnext - '0';
        lnext = scan();
    }
    return(n);
}


double
getnum(void)                    /* scan a positive float */
{
    int  i, lnext;
    char  str[RMAXWORD+1];

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if ((lnext == '.') & (i < RMAXWORD)) {
        str[i++] = lnext;
        lnext = scan();
        if (i == 1 && !isdigit(lnext))
            syntax("badly formed number");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    if ((lnext == 'e') | (lnext == 'E') && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if ((lnext == '-') | (lnext == '+') && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
        if (!isdigit(lnext))
            syntax("missing exponent");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    str[i] = '\0';

    return(atof(str));
}


EPNODE *
getE1(void)                     /* E1 -> E1 ADDOP E2 */
                                /*       E2 */
{
    EPNODE  *ep1, *ep2;

    ep1 = getE2();
    while ((nextc == '+') | (nextc == '-')) {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE2());
        if (esupport&E_RCONST &&
                        (ep1->type == NUM) & (ep1->sibling->type == NUM))
                ep2 = rconst(ep2);
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE2(void)                     /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    EPNODE  *ep1, *ep2;

    ep1 = getE3();
    while ((nextc == '*') | (nextc == '/')) {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST) {
                EPNODE  *ep3 = ep1->sibling;
                if ((ep1->type == NUM) & (ep3->type == NUM)) {
                        ep2 = rconst(ep2);
                } else if (ep3->type == NUM) {
                        if (ep2->type == '/') {
                                if (ep3->v.num == 0)
                                        syntax("divide by zero constant");
                                ep2->type = '*';        /* for speed */
                                ep3->v.num = 1./ep3->v.num;
                        } else if (ep3->v.num == 0) {
                                ep1->sibling = NULL;    /* (E2 * 0) */
                                epfree(ep2,1);
                                ep2 = ep3;
                        }
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3,1);          /* (0 * E3) or (0 / E3) */
                        ep1->sibling = NULL;
                        efree(ep2);
                        ep2 = ep1;
                }
        }
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE3(void)                     /* E3 -> E4 ^ E3 */
                                /*       E4 */
{
        EPNODE  *ep1, *ep2;

        ep1 = getE4();
        if (nextc != '^')
                return(ep1);
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST) {
                EPNODE  *ep3 = ep1->sibling;
                if ((ep1->type == NUM) & (ep3->type == NUM)) {
                        ep2 = rconst(ep2);
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3,1);          /* (0 ^ E3) */
                        ep1->sibling = NULL;
                        efree(ep2);
                        ep2 = ep1;
                } else if ((ep3->type == NUM && ep3->v.num == 0) |
                                (ep1->type == NUM && ep1->v.num == 1)) {
                        epfree(ep2,1);          /* (E4 ^ 0) or (1 ^ E3) */
                        ep2 = newnode();
                        ep2->type = NUM;
                        ep2->v.num = 1;
                } else if (ep3->type == NUM && ep3->v.num == 1) {
                        efree(ep3);     /* (E4 ^ 1) */
                        ep1->sibling = NULL;
                        efree(ep2);
                        ep2 = ep1;
                }
        }
        return(ep2);
}


EPNODE *
getE4(void)                     /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    EPNODE  *ep1, *ep2;

    if (nextc == '-') {
        scan();
        ep2 = getE5();
        if (ep2->type == NUM) {
                ep2->v.num = -ep2->v.num;
                return(ep2);
        }
        if (ep2->type == UMINUS) {      /* don't generate -(-E5) */
            ep1 = ep2->v.kid;
            efree(ep2);
            return(ep1);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


EPNODE *
getE5(void)                     /* E5 -> (E1) */
                                /*       VAR */
                                /*       NUM */
                                /*       $N */
                                /*       FUNC(E1,..) */
                                /*       ARG */
{
        int      i;
        char  *nam;
        EPNODE  *ep1, *ep2;

        if (nextc == '(') {
                scan();
                ep1 = getE1();
                if (nextc != ')')
                        syntax("')' expected");
                scan();
                return(ep1);
        }
        if (esupport&E_INCHAN && nextc == '$') {
                scan();
                ep1 = newnode();
                ep1->type = CHAN;
                ep1->v.chan = getinum();
                return(ep1);
        }
        if (esupport&(E_VARIABLE|E_FUNCTION) &&
                        (isalpha(nextc) | (nextc == CNTXMARK))) {
                nam = getname();
                ep1 = NULL;
                if ((esupport&(E_VARIABLE|E_FUNCTION)) == (E_VARIABLE|E_FUNCTION)
                                && curfunc != NULL)
                        for (i = 1, ep2 = curfunc->v.kid->sibling;
                                        ep2 != NULL; i++, ep2 = ep2->sibling)
                                if (!strcmp(ep2->v.name, nam)) {
                                        ep1 = newnode();
                                        ep1->type = ARG;
                                        ep1->v.chan = i;
                                        break;
                                }
                if (ep1 == NULL) {
                        ep1 = newnode();
                        ep1->type = VAR;
                        ep1->v.ln = varinsert(nam);
                }
                if (esupport&E_FUNCTION && nextc == '(') {
                        ep2 = newnode();
                        ep2->type = FUNC;
                        addekid(ep2, ep1);
                        ep1 = ep2;
                        do {
                                scan();
                                addekid(ep1, getE1());
                        } while (nextc == ',');
                        if (nextc != ')')
                                syntax("')' expected");
                        scan();
                } else if (!(esupport&E_VARIABLE))
                        syntax("'(' expected");
                if (esupport&E_RCONST && isconstvar(ep1))
                        ep1 = rconst(ep1);
                return(ep1);
        }
        if (isdecimal(nextc)) {
                ep1 = newnode();
                ep1->type = NUM;
                ep1->v.num = getnum();
                return(ep1);
        }
        syntax("unexpected character");
        return NULL; /* pro forma return */
}


EPNODE *
rconst(                 /* reduce a constant expression */
    EPNODE       *epar
)
{
    EPNODE  *ep;

    ep = newnode();
    ep->type = NUM;
    errno = 0;
    ep->v.num = evalue(epar);
    if ((errno == EDOM) | (errno == ERANGE))
        syntax("bad constant expression");
    epfree(epar,1);
 
    return(ep);
}


int
isconstvar(                     /* is ep linked to a constant expression? */
    EPNODE       *ep
)
{
    EPNODE  *ep1;

    if (esupport&E_FUNCTION && ep->type == FUNC) {
        if (!isconstfun(ep->v.kid))
                return(0);
        for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
            if (ep1->type != NUM && !isconstfun(ep1))
                return(0);
        return(1);
    }
    if (ep->type != VAR)
        return(0);
    ep1 = ep->v.ln->def;
    if (ep1 == NULL || ep1->type != ':')
        return(0);
    if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
        return(0);
    return(1);
}


int
isconstfun(                     /* is ep linked to a constant function? */
    EPNODE       *ep
)
{
    EPNODE  *dp;
    LIBR  *lp;

    if (ep->type != VAR)
        return(0);
    if ((dp = ep->v.ln->def) != NULL) {
        if (dp->v.kid->type == FUNC)
            return(dp->type == ':');
        else
            return(0);          /* don't identify masked library functions */
    }
    if ((lp = ep->v.ln->lib) != NULL)
        return(lp->atyp == ':');
    return(0);
}
Revision:	2.47
Committed:	Sun Feb 25 04:11:10 2024 UTC (3 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.46:	+11 -8 lines
Log Message:	fix: Potential bug in free allocated EPNODE arrays
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.47	static const char RCSid[] = "$Id: calexpr.c,v 2.46 2024/02/24 19:26:44 greg Exp $";
3	greg	1.1	#endif
4			/*
5			* Compute data values using expression parser
6			*
7			* 7/1/85 Greg Ward
8			*
9			* 11/11/85 Made channel input conditional with (INCHAN) compiles.
10			*
11			* 4/2/86 Added conditional compiles for function definitions (FUNCTION).
12			*
13			* 1/29/87 Made variables conditional (VARIABLE)
14			*
15			* 5/19/88 Added constant subexpression elimination (RCONST)
16	greg	2.18	*
17			* 2/19/03 Eliminated conditional compiles in favor of esupport extern.
18			*/
19
20	greg	2.19	#include "copyright.h"
21	greg	1.1
22			#include <ctype.h>
23			#include <errno.h>
24	greg	2.8	#include <math.h>
25	greg	2.18	#include <stdlib.h>
26
27	schorsch	2.29	#include "rtmisc.h"
28			#include "rtio.h"
29	schorsch	2.24	#include "rterror.h"
30	greg	1.1	#include "calcomp.h"
31
32	greg	2.6	#define MAXLINE 256 /* maximum line length */
33	greg	1.1
34	greg	2.6	#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE))
35	greg	1.1
36	greg	2.42	#define isdecimal(c) (isdigit(c) \| ((c) == '.'))
37	greg	1.1
38	greg	2.44	#define envalue(ep) ((ep)->type==NUM ? (ep)->v.num : evalue(ep))
39
40	schorsch	2.24	static double euminus(EPNODE ), eargument(EPNODE ), enumber(EPNODE *);
41			static double echannel(EPNODE *);
42			static double eadd(EPNODE ), esubtr(EPNODE ),
43			emult(EPNODE ), edivi(EPNODE ),
44			epow(EPNODE *);
45			static double ebotch(EPNODE *);
46	greg	1.1
47	greg	2.18	unsigned int esupport = /* what to support */
48	greg	2.21	E_VARIABLE \| E_FUNCTION ;
49	greg	2.15
50	greg	2.30	int eofc = 0; /* optional end-of-file character */
51	greg	1.1	int nextc; /* lookahead character */
52
53	greg	2.27	double (eoper[])(EPNODE ) = { /* expression operations */
54	greg	1.1	ebotch,
55			evariable,
56			enumber,
57			euminus,
58			echannel,
59			efunc,
60			eargument,
61			ebotch,
62			ebotch,
63			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
64			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
65			emult,
66			eadd,
67			0,
68			esubtr,
69			0,
70			edivi,
71	greg	1.9	0,0,0,0,0,0,0,0,0,0,
72	greg	1.1	ebotch,
73	greg	1.9	0,0,
74			ebotch,
75	greg	1.1	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
76			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
77			epow,
78			};
79
80			static FILE infp; / input file pointer */
81			static char linbuf; / line buffer */
82	greg	1.6	static char infile; / input file name */
83			static int lineno; /* input line number */
84	greg	1.1	static int linepos; /* position in buffer */
85
86
87			EPNODE *
88	schorsch	2.28	eparse( /* parse an expression string */
89			char *expr
90			)
91	greg	1.1	{
92			EPNODE *ep;
93
94	greg	1.6	initstr(expr, NULL, 0);
95	greg	1.1	curfunc = NULL;
96			ep = getE1();
97			if (nextc != EOF)
98			syntax("unexpected character");
99			return(ep);
100			}
101
102
103			double
104	schorsch	2.28	eval( /* evaluate an expression string */
105			char *expr
106			)
107	greg	1.1	{
108	greg	2.38	int prev_support = esupport;
109	greg	2.37	EPNODE *ep;
110	greg	1.1	double rval;
111
112	greg	2.38	esupport &= ~E_RCONST; /* don't bother reducing constant expr */
113	greg	1.1	ep = eparse(expr);
114	greg	2.38	esupport = prev_support; /* as you were */
115	greg	1.1	rval = evalue(ep);
116	greg	2.43	epfree(ep,1);
117	greg	1.1	return(rval);
118			}
119
120
121	greg	2.18	int
122	schorsch	2.28	epcmp( /* compare two expressions for equivalence */
123	greg	2.37	EPNODE *ep1,
124			EPNODE *ep2
125	schorsch	2.28	)
126	greg	2.16	{
127			double d;
128
129			if (ep1->type != ep2->type)
130			return(1);
131
132			switch (ep1->type) {
133
134			case VAR:
135			return(ep1->v.ln != ep2->v.ln);
136
137			case NUM:
138			if (ep2->v.num == 0)
139			return(ep1->v.num != 0);
140			d = ep1->v.num / ep2->v.num;
141	schorsch	2.26	return((d > 1.000000000001) \| (d < 0.999999999999));
142	greg	2.16
143			case CHAN:
144			case ARG:
145			return(ep1->v.chan != ep2->v.chan);
146
147			case '=':
148			case ':':
149			return(epcmp(ep1->v.kid->sibling, ep2->v.kid->sibling));
150
151	greg	2.32	case CLKT:
152	greg	2.16	case SYM: /* should never get this one */
153			return(0);
154
155			default:
156			ep1 = ep1->v.kid;
157			ep2 = ep2->v.kid;
158			while (ep1 != NULL) {
159			if (ep2 == NULL)
160			return(1);
161			if (epcmp(ep1, ep2))
162			return(1);
163			ep1 = ep1->sibling;
164			ep2 = ep2->sibling;
165			}
166			return(ep2 != NULL);
167			}
168			}
169
170
171	greg	2.18	void
172	schorsch	2.28	epfree( /* free a parse tree */
173	greg	2.43	EPNODE *epar,
174			int frep
175	schorsch	2.28	)
176	greg	1.1	{
177	greg	2.43	EPNODE *ep;
178	greg	1.1
179			switch (epar->type) {
180
181			case VAR:
182			varfree(epar->v.ln);
183			break;
184
185			case SYM:
186			freestr(epar->v.name);
187			break;
188
189			case NUM:
190			case CHAN:
191			case ARG:
192	greg	2.32	case CLKT:
193	greg	1.1	break;
194
195			default:
196	greg	2.43	if (epar->nkids < 0) {
197			ep = epar->v.kid - epar->nkids;
198			while (ep > epar->v.kid)
199			epfree(--ep, 0);
200			efree(ep); /* free array space */
201			} else
202			while ((ep = epar->v.kid) != NULL) {
203			epar->v.kid = ep->sibling;
204			epfree(ep, 1);
205			}
206	greg	1.1	break;
207
208			}
209	greg	2.43	if (frep)
210			efree(epar);
211			}
212
213	greg	1.1
214	greg	2.45	static void
215	greg	2.44	epflatten( /* flatten hierarchies for '+', '' /
216			EPNODE *epar
217			)
218			{
219			EPNODE *ep;
220
221	greg	2.47	if (epar->nkids < 0) {
222			eputs("Cannot flatten EPNODE array\n");
223			quit(1);
224			}
225	greg	2.44	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
226			while (ep->type == epar->type) {
227			EPNODE *ep1 = ep->v.kid;
228			while (ep1->sibling != NULL)
229			ep1 = ep1->sibling;
230			ep1->sibling = ep->sibling;
231			epar->nkids += nekids(ep) - 1;
232			ep1 = ep->v.kid;
233			ep = ep1;
234			efree(ep1); /* not epfree()! */
235			}
236			}
237
238
239			void
240	greg	2.47	epoptimize( /* flatten operations, lists -> arrays */
241	greg	2.43	EPNODE *epar
242			)
243			{
244			EPNODE *ep;
245
246	greg	2.45	if ((epar->type == '+') \| (epar->type == '*'))
247	greg	2.47	epflatten(epar); /* flatten associative operations */
248	greg	2.44
249	greg	2.45	if (epar->nkids) /* do children if any */
250	greg	2.44	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
251			epoptimize(ep);
252
253			if (epar->nkids > 4) { /* make list into array if > 4 kids */
254	greg	2.43	int n = 1;
255			epar->v.kid = (EPNODE *)erealloc(epar->v.kid,
256			sizeof(EPNODE)*epar->nkids);
257			while (n < epar->nkids) {
258			ep = epar->v.kid[n-1].sibling;
259			epar->v.kid[n] = *ep;
260			efree(ep); /* not epfree()! */
261			epar->v.kid[n-1].sibling = epar->v.kid + n;
262			n++;
263			}
264	greg	2.44	epar->nkids = -n;
265	greg	2.43	}
266	greg	1.1	}
267
268			/* the following used to be a switch */
269			static double
270	schorsch	2.28	eargument(
271			EPNODE *ep
272			)
273	greg	1.1	{
274			return(argument(ep->v.chan));
275			}
276
277			static double
278	schorsch	2.28	enumber(
279			EPNODE *ep
280			)
281	greg	1.1	{
282			return(ep->v.num);
283			}
284
285			static double
286	schorsch	2.28	euminus(
287			EPNODE *ep
288			)
289	greg	1.1	{
290	greg	2.37	EPNODE *ep1 = ep->v.kid;
291	greg	1.1
292			return(-evalue(ep1));
293			}
294
295			static double
296	schorsch	2.28	echannel(
297			EPNODE *ep
298			)
299	greg	1.1	{
300			return(chanvalue(ep->v.chan));
301			}
302
303			static double
304	schorsch	2.28	eadd(
305			EPNODE *ep
306			)
307	greg	1.1	{
308	greg	2.44	double sum = 0;
309	greg	2.37	EPNODE *ep1 = ep->v.kid;
310	greg	1.1
311	greg	2.44	do
312			sum += envalue(ep1);
313			while ((ep1 = ep1->sibling) != NULL);
314
315			return(sum);
316	greg	1.1	}
317
318			static double
319	schorsch	2.28	esubtr(
320			EPNODE *ep
321			)
322	greg	1.1	{
323	greg	2.37	EPNODE *ep1 = ep->v.kid;
324	greg	2.44	EPNODE *ep2 = ep1->sibling;
325	greg	1.1
326	greg	2.44	return(envalue(ep1) - envalue(ep2));
327	greg	1.1	}
328
329			static double
330	schorsch	2.28	emult(
331			EPNODE *ep
332			)
333	greg	1.1	{
334	greg	2.44	double prod = 1;
335	greg	2.37	EPNODE *ep1 = ep->v.kid;
336	greg	1.1
337	greg	2.44	do
338			prod *= envalue(ep1);
339			while ((ep1 = ep1->sibling) != NULL);
340
341			return(prod);
342	greg	1.1	}
343
344			static double
345	schorsch	2.28	edivi(
346			EPNODE *ep
347			)
348	greg	1.1	{
349	greg	2.37	EPNODE *ep1 = ep->v.kid;
350	greg	2.44	EPNODE *ep2 = ep1->sibling;
351	greg	1.1	double d;
352
353	greg	2.46	d = evalue(ep2);
354	greg	1.1	if (d == 0.0) {
355			wputs("Division by zero\n");
356			errno = ERANGE;
357			return(0.0);
358			}
359	greg	2.44	return(envalue(ep1) / d);
360	greg	1.1	}
361
362			static double
363	schorsch	2.28	epow(
364			EPNODE *ep
365			)
366	greg	1.1	{
367	greg	2.37	EPNODE *ep1 = ep->v.kid;
368	greg	1.1	double d;
369	greg	2.6	int lasterrno;
370	greg	1.1
371			lasterrno = errno;
372			errno = 0;
373			d = pow(evalue(ep1), evalue(ep1->sibling));
374	greg	2.31	#ifdef isnan
375	greg	2.36	if (errno == 0) {
376	greg	2.31	if (isnan(d))
377			errno = EDOM;
378			else if (isinf(d))
379			errno = ERANGE;
380	greg	2.36	}
381	greg	1.1	#endif
382	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE)) {
383	greg	1.1	wputs("Illegal power\n");
384			return(0.0);
385			}
386			errno = lasterrno;
387			return(d);
388			}
389
390			static double
391	schorsch	2.28	ebotch(
392			EPNODE *ep
393			)
394	greg	1.1	{
395			eputs("Bad expression!\n");
396			quit(1);
397	schorsch	2.22	return 0.0; /* pro forma return */
398	greg	1.1	}
399
400
401			EPNODE *
402	schorsch	2.28	ekid( /* return pointer to a node's nth kid */
403	greg	2.37	EPNODE *ep,
404			int n
405	schorsch	2.28	)
406	greg	1.1	{
407	greg	2.43	if (ep->nkids < 0) { /* allocated array? */
408			if (n >= -ep->nkids)
409			return(NULL);
410			return(ep->v.kid + n);
411			}
412			ep = ep->v.kid; /* else get from list */
413			while (n-- > 0)
414			if ((ep = ep->sibling) == NULL)
415			break;
416	greg	1.1	return(ep);
417			}
418
419
420	greg	2.18	void
421	schorsch	2.28	initfile( /* prepare input file */
422			FILE *fp,
423			char *fn,
424			int ln
425			)
426	greg	1.1	{
427	greg	2.6	static char inpbuf[MAXLINE];
428	greg	1.1
429			infp = fp;
430			linbuf = inpbuf;
431	greg	1.6	infile = fn;
432			lineno = ln;
433	greg	1.1	linepos = 0;
434			inpbuf[0] = '\0';
435			scan();
436			}
437
438
439	greg	2.18	void
440	schorsch	2.28	initstr( /* prepare input string */
441			char *s,
442			char *fn,
443			int ln
444			)
445	greg	1.1	{
446			infp = NULL;
447	greg	1.6	infile = fn;
448			lineno = ln;
449	greg	1.1	linbuf = s;
450			linepos = 0;
451			scan();
452			}
453
454
455	greg	2.18	void
456	schorsch	2.28	getscanpos( /* return current scan position */
457			char **fnp,
458			int *lnp,
459			char **spp,
460			FILE **fpp
461			)
462	greg	1.13	{
463			if (fnp != NULL) *fnp = infile;
464			if (lnp != NULL) *lnp = lineno;
465			if (spp != NULL) *spp = linbuf+linepos;
466			if (fpp != NULL) *fpp = infp;
467			}
468
469
470	greg	1.12	int
471	schorsch	2.28	scan(void) /* scan next character, return literal next */
472	greg	1.1	{
473	greg	2.37	int lnext = 0;
474	greg	1.12
475	greg	1.1	do {
476			if (linbuf[linepos] == '\0')
477			if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
478			nextc = EOF;
479			else {
480			nextc = linbuf[0];
481	greg	1.6	lineno++;
482	greg	1.1	linepos = 1;
483			}
484			else
485			nextc = linbuf[linepos++];
486	greg	1.12	if (!lnext)
487			lnext = nextc;
488	greg	2.30	if (nextc == eofc) {
489			nextc = EOF;
490			break;
491			}
492	greg	1.1	if (nextc == '{') {
493			scan();
494			while (nextc != '}')
495			if (nextc == EOF)
496			syntax("'}' expected");
497			else
498			scan();
499			scan();
500			}
501			} while (isspace(nextc));
502	greg	1.12	return(lnext);
503	greg	1.1	}
504
505
506	greg	1.6	char *
507	schorsch	2.28	long2ascii( /* convert long to ascii */
508			long l
509			)
510	greg	1.6	{
511	greg	2.6	static char buf[16];
512	greg	2.37	char *cp;
513	greg	2.6	int neg = 0;
514	greg	1.6
515			if (l == 0)
516			return("0");
517			if (l < 0) {
518			l = -l;
519			neg++;
520			}
521			cp = buf + sizeof(buf);
522			*--cp = '\0';
523			while (l) {
524			*--cp = l % 10 + '0';
525			l /= 10;
526			}
527			if (neg)
528			*--cp = '-';
529			return(cp);
530			}
531
532
533	greg	2.18	void
534	schorsch	2.28	syntax( /* report syntax error and quit */
535			char *err
536			)
537	greg	1.1	{
538	greg	2.37	int i;
539	greg	1.1
540	greg	2.42	if ((infile != NULL) \| (lineno != 0)) {
541	greg	1.6	if (infile != NULL) eputs(infile);
542			if (lineno != 0) {
543			eputs(infile != NULL ? ", line " : "line ");
544	greg	2.9	eputs(long2ascii((long)lineno));
545	greg	1.6	}
546	greg	2.7	eputs(":\n");
547	greg	1.1	}
548	greg	1.7	eputs(linbuf);
549			if (linbuf[strlen(linbuf)-1] != '\n')
550			eputs("\n");
551			for (i = 0; i < linepos-1; i++)
552			eputs(linbuf[i] == '\t' ? "\t" : " ");
553			eputs("^ ");
554	greg	1.1	eputs(err);
555			eputs("\n");
556			quit(1);
557			}
558
559
560	greg	2.18	void
561	schorsch	2.28	addekid( /* add a child to ep */
562	greg	2.37	EPNODE *ep,
563	greg	2.43	EPNODE *ek
564	schorsch	2.28	)
565	greg	1.1	{
566	greg	2.47	if (ep->nkids < 0) {
567			eputs("Cannot add kid to EPNODE array\n");
568			quit(1);
569			}
570	greg	2.43	ep->nkids++;
571	greg	1.1	if (ep->v.kid == NULL)
572	greg	2.43	ep->v.kid = ek;
573	greg	1.1	else {
574			for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
575			;
576	greg	2.43	ep->sibling = ek;
577	greg	1.1	}
578	greg	2.44	ek->sibling = NULL; /* shouldn't be necessary */
579	greg	1.1	}
580
581
582			char *
583	schorsch	2.28	getname(void) /* scan an identifier */
584	greg	1.1	{
585	schorsch	2.23	static char str[RMAXWORD+1];
586	greg	2.37	int i, lnext;
587	greg	1.1
588	greg	1.12	lnext = nextc;
589	schorsch	2.23	for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
590	greg	1.12	str[i] = lnext;
591	greg	1.1	str[i] = '\0';
592	greg	1.15	while (isid(lnext)) /* skip rest of name */
593			lnext = scan();
594	greg	1.1
595			return(str);
596			}
597
598
599			int
600	schorsch	2.28	getinum(void) /* scan a positive integer */
601	greg	1.1	{
602	greg	2.37	int n, lnext;
603	greg	1.1
604			n = 0;
605	greg	1.12	lnext = nextc;
606			while (isdigit(lnext)) {
607			n = n * 10 + lnext - '0';
608			lnext = scan();
609	greg	1.1	}
610			return(n);
611			}
612
613
614			double
615	schorsch	2.28	getnum(void) /* scan a positive float */
616	greg	1.1	{
617	greg	2.37	int i, lnext;
618	schorsch	2.23	char str[RMAXWORD+1];
619	greg	1.1
620			i = 0;
621	greg	1.12	lnext = nextc;
622	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
623	greg	1.12	str[i++] = lnext;
624			lnext = scan();
625	greg	1.1	}
626	greg	2.42	if ((lnext == '.') & (i < RMAXWORD)) {
627	greg	2.6	str[i++] = lnext;
628			lnext = scan();
629	gwlarson	2.17	if (i == 1 && !isdigit(lnext))
630			syntax("badly formed number");
631	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
632	greg	1.12	str[i++] = lnext;
633			lnext = scan();
634	greg	1.1	}
635			}
636	schorsch	2.26	if ((lnext == 'e') \| (lnext == 'E') && i < RMAXWORD) {
637	greg	2.6	str[i++] = lnext;
638			lnext = scan();
639	schorsch	2.26	if ((lnext == '-') \| (lnext == '+') && i < RMAXWORD) {
640	greg	1.12	str[i++] = lnext;
641			lnext = scan();
642	greg	1.1	}
643	gwlarson	2.17	if (!isdigit(lnext))
644			syntax("missing exponent");
645	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
646	greg	1.12	str[i++] = lnext;
647			lnext = scan();
648	greg	1.1	}
649			}
650			str[i] = '\0';
651
652			return(atof(str));
653			}
654
655
656			EPNODE *
657	greg	2.34	getE1(void) /* E1 -> E1 ADDOP E2 */
658	greg	2.6	/* E2 */
659	greg	1.1	{
660	greg	2.37	EPNODE ep1, ep2;
661	greg	1.1
662			ep1 = getE2();
663	greg	2.42	while ((nextc == '+') \| (nextc == '-')) {
664	greg	1.1	ep2 = newnode();
665			ep2->type = nextc;
666			scan();
667			addekid(ep2, ep1);
668			addekid(ep2, getE2());
669	greg	2.18	if (esupport&E_RCONST &&
670	greg	2.42	(ep1->type == NUM) & (ep1->sibling->type == NUM))
671	greg	1.1	ep2 = rconst(ep2);
672			ep1 = ep2;
673			}
674			return(ep1);
675			}
676
677
678			EPNODE *
679	greg	2.34	getE2(void) /* E2 -> E2 MULOP E3 */
680	greg	2.6	/* E3 */
681	greg	1.1	{
682	greg	2.37	EPNODE ep1, ep2;
683	greg	1.1
684			ep1 = getE3();
685	greg	2.42	while ((nextc == '*') \| (nextc == '/')) {
686	greg	1.1	ep2 = newnode();
687			ep2->type = nextc;
688			scan();
689			addekid(ep2, ep1);
690			addekid(ep2, getE3());
691	greg	2.34	if (esupport&E_RCONST) {
692			EPNODE *ep3 = ep1->sibling;
693	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
694	greg	2.34	ep2 = rconst(ep2);
695	greg	2.35	} else if (ep3->type == NUM) {
696			if (ep2->type == '/') {
697			if (ep3->v.num == 0)
698			syntax("divide by zero constant");
699			ep2->type = ''; / for speed */
700			ep3->v.num = 1./ep3->v.num;
701			} else if (ep3->v.num == 0) {
702			ep1->sibling = NULL; /* (E2 * 0) */
703	greg	2.43	epfree(ep2,1);
704	greg	2.35	ep2 = ep3;
705			}
706	greg	2.34	} else if (ep1->type == NUM && ep1->v.num == 0) {
707	greg	2.43	epfree(ep3,1); /* (0 * E3) or (0 / E3) */
708	greg	2.34	ep1->sibling = NULL;
709	greg	2.41	efree(ep2);
710	greg	2.34	ep2 = ep1;
711			}
712			}
713	greg	1.1	ep1 = ep2;
714			}
715			return(ep1);
716			}
717
718
719			EPNODE *
720	greg	2.34	getE3(void) /* E3 -> E4 ^ E3 */
721	greg	2.6	/* E4 */
722	greg	1.1	{
723	greg	2.37	EPNODE ep1, ep2;
724	greg	1.1
725	greg	2.34	ep1 = getE4();
726			if (nextc != '^')
727			return(ep1);
728	greg	1.1	ep2 = newnode();
729			ep2->type = nextc;
730			scan();
731			addekid(ep2, ep1);
732	greg	1.8	addekid(ep2, getE3());
733	greg	2.34	if (esupport&E_RCONST) {
734			EPNODE *ep3 = ep1->sibling;
735	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
736	greg	2.34	ep2 = rconst(ep2);
737			} else if (ep1->type == NUM && ep1->v.num == 0) {
738	greg	2.43	epfree(ep3,1); /* (0 ^ E3) */
739	greg	2.34	ep1->sibling = NULL;
740	greg	2.41	efree(ep2);
741	greg	2.34	ep2 = ep1;
742	greg	2.42	} else if ((ep3->type == NUM && ep3->v.num == 0) \|
743	greg	2.34	(ep1->type == NUM && ep1->v.num == 1)) {
744	greg	2.43	epfree(ep2,1); /* (E4 ^ 0) or (1 ^ E3) */
745	greg	2.34	ep2 = newnode();
746			ep2->type = NUM;
747			ep2->v.num = 1;
748	greg	2.40	} else if (ep3->type == NUM && ep3->v.num == 1) {
749	greg	2.41	efree(ep3); /* (E4 ^ 1) */
750	greg	2.40	ep1->sibling = NULL;
751	greg	2.41	efree(ep2);
752	greg	2.40	ep2 = ep1;
753	greg	2.34	}
754			}
755	greg	1.8	return(ep2);
756	greg	1.1	}
757
758
759			EPNODE *
760	greg	2.34	getE4(void) /* E4 -> ADDOP E5 */
761	greg	2.6	/* E5 */
762	greg	1.1	{
763	greg	2.37	EPNODE ep1, ep2;
764	greg	1.1
765			if (nextc == '-') {
766			scan();
767	greg	1.3	ep2 = getE5();
768			if (ep2->type == NUM) {
769			ep2->v.num = -ep2->v.num;
770			return(ep2);
771			}
772	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
773	greg	2.33	ep1 = ep2->v.kid;
774	greg	2.41	efree(ep2);
775	greg	2.33	return(ep1);
776	greg	1.16	}
777	greg	1.1	ep1 = newnode();
778			ep1->type = UMINUS;
779	greg	1.3	addekid(ep1, ep2);
780	greg	1.1	return(ep1);
781			}
782			if (nextc == '+')
783			scan();
784			return(getE5());
785			}
786
787
788			EPNODE *
789	schorsch	2.28	getE5(void) /* E5 -> (E1) */
790	greg	2.6	/* VAR */
791			/* NUM */
792			/* $N */
793			/* FUNC(E1,..) */
794			/* ARG */
795	greg	1.1	{
796	schorsch	2.22	int i;
797			char *nam;
798	greg	2.37	EPNODE ep1, ep2;
799	greg	1.1
800	schorsch	2.22	if (nextc == '(') {
801			scan();
802			ep1 = getE1();
803			if (nextc != ')')
804			syntax("')' expected");
805			scan();
806			return(ep1);
807			}
808			if (esupport&E_INCHAN && nextc == '$') {
809			scan();
810			ep1 = newnode();
811			ep1->type = CHAN;
812			ep1->v.chan = getinum();
813			return(ep1);
814			}
815			if (esupport&(E_VARIABLE\|E_FUNCTION) &&
816	greg	2.42	(isalpha(nextc) \| (nextc == CNTXMARK))) {
817	schorsch	2.22	nam = getname();
818			ep1 = NULL;
819			if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
820			&& curfunc != NULL)
821			for (i = 1, ep2 = curfunc->v.kid->sibling;
822			ep2 != NULL; i++, ep2 = ep2->sibling)
823			if (!strcmp(ep2->v.name, nam)) {
824			ep1 = newnode();
825			ep1->type = ARG;
826			ep1->v.chan = i;
827			break;
828			}
829			if (ep1 == NULL) {
830			ep1 = newnode();
831			ep1->type = VAR;
832			ep1->v.ln = varinsert(nam);
833	greg	1.1	}
834	schorsch	2.22	if (esupport&E_FUNCTION && nextc == '(') {
835			ep2 = newnode();
836			ep2->type = FUNC;
837			addekid(ep2, ep1);
838			ep1 = ep2;
839			do {
840			scan();
841			addekid(ep1, getE1());
842			} while (nextc == ',');
843			if (nextc != ')')
844			syntax("')' expected");
845			scan();
846			} else if (!(esupport&E_VARIABLE))
847			syntax("'(' expected");
848			if (esupport&E_RCONST && isconstvar(ep1))
849			ep1 = rconst(ep1);
850			return(ep1);
851			}
852			if (isdecimal(nextc)) {
853			ep1 = newnode();
854			ep1->type = NUM;
855			ep1->v.num = getnum();
856			return(ep1);
857			}
858			syntax("unexpected character");
859			return NULL; /* pro forma return */
860	greg	1.1	}
861
862
863			EPNODE *
864	schorsch	2.28	rconst( /* reduce a constant expression */
865	greg	2.37	EPNODE *epar
866	schorsch	2.28	)
867	greg	1.1	{
868	greg	2.37	EPNODE *ep;
869	greg	1.1
870			ep = newnode();
871			ep->type = NUM;
872			errno = 0;
873			ep->v.num = evalue(epar);
874	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE))
875	greg	2.6	syntax("bad constant expression");
876	greg	2.43	epfree(epar,1);
877	greg	1.1
878			return(ep);
879	greg	1.9	}
880
881
882	greg	2.18	int
883	schorsch	2.28	isconstvar( /* is ep linked to a constant expression? */
884	greg	2.37	EPNODE *ep
885	schorsch	2.28	)
886	greg	1.9	{
887	greg	2.37	EPNODE *ep1;
888	greg	1.10
889	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
890	greg	1.11	if (!isconstfun(ep->v.kid))
891			return(0);
892	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
893	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
894	greg	1.9	return(0);
895			return(1);
896			}
897			if (ep->type != VAR)
898			return(0);
899			ep1 = ep->v.ln->def;
900			if (ep1 == NULL \|\| ep1->type != ':')
901			return(0);
902	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
903	greg	1.9	return(0);
904			return(1);
905	greg	1.1	}
906	greg	1.11
907
908	greg	2.18	int
909	schorsch	2.28	isconstfun( /* is ep linked to a constant function? */
910	greg	2.37	EPNODE *ep
911	schorsch	2.28	)
912	greg	1.11	{
913	greg	2.37	EPNODE *dp;
914			LIBR *lp;
915	greg	1.11
916			if (ep->type != VAR)
917			return(0);
918	schorsch	2.25	if ((dp = ep->v.ln->def) != NULL) {
919	greg	2.18	if (dp->v.kid->type == FUNC)
920			return(dp->type == ':');
921			else
922			return(0); /* don't identify masked library functions */
923	schorsch	2.25	}
924	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
925	greg	2.3	return(lp->atyp == ':');
926			return(0);
927	greg	1.11	}