src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.48 2024/02/25 04:41: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 *), 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)        /* can't handle array allocations */
        return;

    for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
        while (ep->type == epar->type && ep->nkids > 0) {
            EPNODE      *ep1 = ep->v.kid;
            while (ep1->sibling != NULL)
                ep1 = ep1->sibling;
            ep1->sibling = ep->sibling;
            epar->nkids += ep->nkids - 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
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;
    double  den = evalue(ep1->sibling);

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

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.49
Committed:	Mon Feb 26 18:16:35 2024 UTC (2 months, 2 weeks ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.48:	+2 -10 lines
Log Message:	perf: Added shortcut to avoid extra call in eargument(), which was bottleneck
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.49	static const char RCSid[] = "$Id: calexpr.c,v 2.48 2024/02/25 04:41: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	greg	2.49	static double euminus(EPNODE ), enumber(EPNODE );
41	schorsch	2.24	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.48	if (epar->nkids < 0) /* can't handle array allocations */
222			return;
223
224	greg	2.44	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
225	greg	2.48	while (ep->type == epar->type && ep->nkids > 0) {
226	greg	2.44	EPNODE *ep1 = ep->v.kid;
227			while (ep1->sibling != NULL)
228			ep1 = ep1->sibling;
229			ep1->sibling = ep->sibling;
230	greg	2.48	epar->nkids += ep->nkids - 1;
231	greg	2.44	ep1 = ep->v.kid;
232			ep = ep1;
233			efree(ep1); /* not epfree()! */
234			}
235			}
236
237
238			void
239	greg	2.47	epoptimize( /* flatten operations, lists -> arrays */
240	greg	2.43	EPNODE *epar
241			)
242			{
243			EPNODE *ep;
244
245	greg	2.45	if ((epar->type == '+') \| (epar->type == '*'))
246	greg	2.47	epflatten(epar); /* flatten associative operations */
247	greg	2.44
248	greg	2.45	if (epar->nkids) /* do children if any */
249	greg	2.44	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
250			epoptimize(ep);
251
252			if (epar->nkids > 4) { /* make list into array if > 4 kids */
253	greg	2.43	int n = 1;
254			epar->v.kid = (EPNODE *)erealloc(epar->v.kid,
255			sizeof(EPNODE)*epar->nkids);
256			while (n < epar->nkids) {
257			ep = epar->v.kid[n-1].sibling;
258			epar->v.kid[n] = *ep;
259			efree(ep); /* not epfree()! */
260			epar->v.kid[n-1].sibling = epar->v.kid + n;
261			n++;
262			}
263	greg	2.44	epar->nkids = -n;
264	greg	2.43	}
265	greg	1.1	}
266
267			/* the following used to be a switch */
268			static double
269	schorsch	2.28	enumber(
270			EPNODE *ep
271			)
272	greg	1.1	{
273			return(ep->v.num);
274			}
275
276			static double
277	schorsch	2.28	euminus(
278			EPNODE *ep
279			)
280	greg	1.1	{
281	greg	2.37	EPNODE *ep1 = ep->v.kid;
282	greg	1.1
283			return(-evalue(ep1));
284			}
285
286			static double
287	schorsch	2.28	echannel(
288			EPNODE *ep
289			)
290	greg	1.1	{
291			return(chanvalue(ep->v.chan));
292			}
293
294			static double
295	schorsch	2.28	eadd(
296			EPNODE *ep
297			)
298	greg	1.1	{
299	greg	2.44	double sum = 0;
300	greg	2.37	EPNODE *ep1 = ep->v.kid;
301	greg	1.1
302	greg	2.44	do
303			sum += envalue(ep1);
304			while ((ep1 = ep1->sibling) != NULL);
305
306			return(sum);
307	greg	1.1	}
308
309			static double
310	schorsch	2.28	esubtr(
311			EPNODE *ep
312			)
313	greg	1.1	{
314	greg	2.37	EPNODE *ep1 = ep->v.kid;
315	greg	2.44	EPNODE *ep2 = ep1->sibling;
316	greg	1.1
317	greg	2.44	return(envalue(ep1) - envalue(ep2));
318	greg	1.1	}
319
320			static double
321	schorsch	2.28	emult(
322			EPNODE *ep
323			)
324	greg	1.1	{
325	greg	2.44	double prod = 1;
326	greg	2.37	EPNODE *ep1 = ep->v.kid;
327	greg	1.1
328	greg	2.44	do
329			prod *= envalue(ep1);
330			while ((ep1 = ep1->sibling) != NULL);
331
332			return(prod);
333	greg	1.1	}
334
335			static double
336	schorsch	2.28	edivi(
337			EPNODE *ep
338			)
339	greg	1.1	{
340	greg	2.37	EPNODE *ep1 = ep->v.kid;
341	greg	2.48	double den = evalue(ep1->sibling);
342	greg	1.1
343	greg	2.48	if (den == 0.0) {
344	greg	1.1	wputs("Division by zero\n");
345			errno = ERANGE;
346			return(0.0);
347			}
348	greg	2.48	return(envalue(ep1) / den);
349	greg	1.1	}
350
351			static double
352	schorsch	2.28	epow(
353			EPNODE *ep
354			)
355	greg	1.1	{
356	greg	2.37	EPNODE *ep1 = ep->v.kid;
357	greg	1.1	double d;
358	greg	2.6	int lasterrno;
359	greg	1.1
360			lasterrno = errno;
361			errno = 0;
362			d = pow(evalue(ep1), evalue(ep1->sibling));
363	greg	2.31	#ifdef isnan
364	greg	2.36	if (errno == 0) {
365	greg	2.31	if (isnan(d))
366			errno = EDOM;
367			else if (isinf(d))
368			errno = ERANGE;
369	greg	2.36	}
370	greg	1.1	#endif
371	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE)) {
372	greg	1.1	wputs("Illegal power\n");
373			return(0.0);
374			}
375			errno = lasterrno;
376			return(d);
377			}
378
379			static double
380	schorsch	2.28	ebotch(
381			EPNODE *ep
382			)
383	greg	1.1	{
384			eputs("Bad expression!\n");
385			quit(1);
386	schorsch	2.22	return 0.0; /* pro forma return */
387	greg	1.1	}
388
389
390			EPNODE *
391	schorsch	2.28	ekid( /* return pointer to a node's nth kid */
392	greg	2.37	EPNODE *ep,
393			int n
394	schorsch	2.28	)
395	greg	1.1	{
396	greg	2.43	if (ep->nkids < 0) { /* allocated array? */
397			if (n >= -ep->nkids)
398			return(NULL);
399			return(ep->v.kid + n);
400			}
401			ep = ep->v.kid; /* else get from list */
402			while (n-- > 0)
403			if ((ep = ep->sibling) == NULL)
404			break;
405	greg	1.1	return(ep);
406			}
407
408
409	greg	2.18	void
410	schorsch	2.28	initfile( /* prepare input file */
411			FILE *fp,
412			char *fn,
413			int ln
414			)
415	greg	1.1	{
416	greg	2.6	static char inpbuf[MAXLINE];
417	greg	1.1
418			infp = fp;
419			linbuf = inpbuf;
420	greg	1.6	infile = fn;
421			lineno = ln;
422	greg	1.1	linepos = 0;
423			inpbuf[0] = '\0';
424			scan();
425			}
426
427
428	greg	2.18	void
429	schorsch	2.28	initstr( /* prepare input string */
430			char *s,
431			char *fn,
432			int ln
433			)
434	greg	1.1	{
435			infp = NULL;
436	greg	1.6	infile = fn;
437			lineno = ln;
438	greg	1.1	linbuf = s;
439			linepos = 0;
440			scan();
441			}
442
443
444	greg	2.18	void
445	schorsch	2.28	getscanpos( /* return current scan position */
446			char **fnp,
447			int *lnp,
448			char **spp,
449			FILE **fpp
450			)
451	greg	1.13	{
452			if (fnp != NULL) *fnp = infile;
453			if (lnp != NULL) *lnp = lineno;
454			if (spp != NULL) *spp = linbuf+linepos;
455			if (fpp != NULL) *fpp = infp;
456			}
457
458
459	greg	1.12	int
460	schorsch	2.28	scan(void) /* scan next character, return literal next */
461	greg	1.1	{
462	greg	2.37	int lnext = 0;
463	greg	1.12
464	greg	1.1	do {
465			if (linbuf[linepos] == '\0')
466			if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
467			nextc = EOF;
468			else {
469			nextc = linbuf[0];
470	greg	1.6	lineno++;
471	greg	1.1	linepos = 1;
472			}
473			else
474			nextc = linbuf[linepos++];
475	greg	1.12	if (!lnext)
476			lnext = nextc;
477	greg	2.30	if (nextc == eofc) {
478			nextc = EOF;
479			break;
480			}
481	greg	1.1	if (nextc == '{') {
482			scan();
483			while (nextc != '}')
484			if (nextc == EOF)
485			syntax("'}' expected");
486			else
487			scan();
488			scan();
489			}
490			} while (isspace(nextc));
491	greg	1.12	return(lnext);
492	greg	1.1	}
493
494
495	greg	1.6	char *
496	schorsch	2.28	long2ascii( /* convert long to ascii */
497			long l
498			)
499	greg	1.6	{
500	greg	2.6	static char buf[16];
501	greg	2.37	char *cp;
502	greg	2.6	int neg = 0;
503	greg	1.6
504			if (l == 0)
505			return("0");
506			if (l < 0) {
507			l = -l;
508			neg++;
509			}
510			cp = buf + sizeof(buf);
511			*--cp = '\0';
512			while (l) {
513			*--cp = l % 10 + '0';
514			l /= 10;
515			}
516			if (neg)
517			*--cp = '-';
518			return(cp);
519			}
520
521
522	greg	2.18	void
523	schorsch	2.28	syntax( /* report syntax error and quit */
524			char *err
525			)
526	greg	1.1	{
527	greg	2.37	int i;
528	greg	1.1
529	greg	2.42	if ((infile != NULL) \| (lineno != 0)) {
530	greg	1.6	if (infile != NULL) eputs(infile);
531			if (lineno != 0) {
532			eputs(infile != NULL ? ", line " : "line ");
533	greg	2.9	eputs(long2ascii((long)lineno));
534	greg	1.6	}
535	greg	2.7	eputs(":\n");
536	greg	1.1	}
537	greg	1.7	eputs(linbuf);
538			if (linbuf[strlen(linbuf)-1] != '\n')
539			eputs("\n");
540			for (i = 0; i < linepos-1; i++)
541			eputs(linbuf[i] == '\t' ? "\t" : " ");
542			eputs("^ ");
543	greg	1.1	eputs(err);
544			eputs("\n");
545			quit(1);
546			}
547
548
549	greg	2.18	void
550	schorsch	2.28	addekid( /* add a child to ep */
551	greg	2.37	EPNODE *ep,
552	greg	2.43	EPNODE *ek
553	schorsch	2.28	)
554	greg	1.1	{
555	greg	2.47	if (ep->nkids < 0) {
556			eputs("Cannot add kid to EPNODE array\n");
557			quit(1);
558			}
559	greg	2.43	ep->nkids++;
560	greg	1.1	if (ep->v.kid == NULL)
561	greg	2.43	ep->v.kid = ek;
562	greg	1.1	else {
563			for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
564			;
565	greg	2.43	ep->sibling = ek;
566	greg	1.1	}
567	greg	2.44	ek->sibling = NULL; /* shouldn't be necessary */
568	greg	1.1	}
569
570
571			char *
572	schorsch	2.28	getname(void) /* scan an identifier */
573	greg	1.1	{
574	schorsch	2.23	static char str[RMAXWORD+1];
575	greg	2.37	int i, lnext;
576	greg	1.1
577	greg	1.12	lnext = nextc;
578	schorsch	2.23	for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
579	greg	1.12	str[i] = lnext;
580	greg	1.1	str[i] = '\0';
581	greg	1.15	while (isid(lnext)) /* skip rest of name */
582			lnext = scan();
583	greg	1.1
584			return(str);
585			}
586
587
588			int
589	schorsch	2.28	getinum(void) /* scan a positive integer */
590	greg	1.1	{
591	greg	2.37	int n, lnext;
592	greg	1.1
593			n = 0;
594	greg	1.12	lnext = nextc;
595			while (isdigit(lnext)) {
596			n = n * 10 + lnext - '0';
597			lnext = scan();
598	greg	1.1	}
599			return(n);
600			}
601
602
603			double
604	schorsch	2.28	getnum(void) /* scan a positive float */
605	greg	1.1	{
606	greg	2.37	int i, lnext;
607	schorsch	2.23	char str[RMAXWORD+1];
608	greg	1.1
609			i = 0;
610	greg	1.12	lnext = nextc;
611	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
612	greg	1.12	str[i++] = lnext;
613			lnext = scan();
614	greg	1.1	}
615	greg	2.42	if ((lnext == '.') & (i < RMAXWORD)) {
616	greg	2.6	str[i++] = lnext;
617			lnext = scan();
618	gwlarson	2.17	if (i == 1 && !isdigit(lnext))
619			syntax("badly formed number");
620	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
621	greg	1.12	str[i++] = lnext;
622			lnext = scan();
623	greg	1.1	}
624			}
625	schorsch	2.26	if ((lnext == 'e') \| (lnext == 'E') && i < RMAXWORD) {
626	greg	2.6	str[i++] = lnext;
627			lnext = scan();
628	schorsch	2.26	if ((lnext == '-') \| (lnext == '+') && i < RMAXWORD) {
629	greg	1.12	str[i++] = lnext;
630			lnext = scan();
631	greg	1.1	}
632	gwlarson	2.17	if (!isdigit(lnext))
633			syntax("missing exponent");
634	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
635	greg	1.12	str[i++] = lnext;
636			lnext = scan();
637	greg	1.1	}
638			}
639			str[i] = '\0';
640
641			return(atof(str));
642			}
643
644
645			EPNODE *
646	greg	2.34	getE1(void) /* E1 -> E1 ADDOP E2 */
647	greg	2.6	/* E2 */
648	greg	1.1	{
649	greg	2.37	EPNODE ep1, ep2;
650	greg	1.1
651			ep1 = getE2();
652	greg	2.42	while ((nextc == '+') \| (nextc == '-')) {
653	greg	1.1	ep2 = newnode();
654			ep2->type = nextc;
655			scan();
656			addekid(ep2, ep1);
657			addekid(ep2, getE2());
658	greg	2.18	if (esupport&E_RCONST &&
659	greg	2.42	(ep1->type == NUM) & (ep1->sibling->type == NUM))
660	greg	1.1	ep2 = rconst(ep2);
661			ep1 = ep2;
662			}
663			return(ep1);
664			}
665
666
667			EPNODE *
668	greg	2.34	getE2(void) /* E2 -> E2 MULOP E3 */
669	greg	2.6	/* E3 */
670	greg	1.1	{
671	greg	2.37	EPNODE ep1, ep2;
672	greg	1.1
673			ep1 = getE3();
674	greg	2.42	while ((nextc == '*') \| (nextc == '/')) {
675	greg	1.1	ep2 = newnode();
676			ep2->type = nextc;
677			scan();
678			addekid(ep2, ep1);
679			addekid(ep2, getE3());
680	greg	2.34	if (esupport&E_RCONST) {
681			EPNODE *ep3 = ep1->sibling;
682	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
683	greg	2.34	ep2 = rconst(ep2);
684	greg	2.35	} else if (ep3->type == NUM) {
685			if (ep2->type == '/') {
686			if (ep3->v.num == 0)
687			syntax("divide by zero constant");
688			ep2->type = ''; / for speed */
689			ep3->v.num = 1./ep3->v.num;
690			} else if (ep3->v.num == 0) {
691			ep1->sibling = NULL; /* (E2 * 0) */
692	greg	2.43	epfree(ep2,1);
693	greg	2.35	ep2 = ep3;
694			}
695	greg	2.34	} else if (ep1->type == NUM && ep1->v.num == 0) {
696	greg	2.43	epfree(ep3,1); /* (0 * E3) or (0 / E3) */
697	greg	2.34	ep1->sibling = NULL;
698	greg	2.41	efree(ep2);
699	greg	2.34	ep2 = ep1;
700			}
701			}
702	greg	1.1	ep1 = ep2;
703			}
704			return(ep1);
705			}
706
707
708			EPNODE *
709	greg	2.34	getE3(void) /* E3 -> E4 ^ E3 */
710	greg	2.6	/* E4 */
711	greg	1.1	{
712	greg	2.37	EPNODE ep1, ep2;
713	greg	1.1
714	greg	2.34	ep1 = getE4();
715			if (nextc != '^')
716			return(ep1);
717	greg	1.1	ep2 = newnode();
718			ep2->type = nextc;
719			scan();
720			addekid(ep2, ep1);
721	greg	1.8	addekid(ep2, getE3());
722	greg	2.34	if (esupport&E_RCONST) {
723			EPNODE *ep3 = ep1->sibling;
724	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
725	greg	2.34	ep2 = rconst(ep2);
726			} else if (ep1->type == NUM && ep1->v.num == 0) {
727	greg	2.43	epfree(ep3,1); /* (0 ^ E3) */
728	greg	2.34	ep1->sibling = NULL;
729	greg	2.41	efree(ep2);
730	greg	2.34	ep2 = ep1;
731	greg	2.42	} else if ((ep3->type == NUM && ep3->v.num == 0) \|
732	greg	2.34	(ep1->type == NUM && ep1->v.num == 1)) {
733	greg	2.43	epfree(ep2,1); /* (E4 ^ 0) or (1 ^ E3) */
734	greg	2.34	ep2 = newnode();
735			ep2->type = NUM;
736			ep2->v.num = 1;
737	greg	2.40	} else if (ep3->type == NUM && ep3->v.num == 1) {
738	greg	2.41	efree(ep3); /* (E4 ^ 1) */
739	greg	2.40	ep1->sibling = NULL;
740	greg	2.41	efree(ep2);
741	greg	2.40	ep2 = ep1;
742	greg	2.34	}
743			}
744	greg	1.8	return(ep2);
745	greg	1.1	}
746
747
748			EPNODE *
749	greg	2.34	getE4(void) /* E4 -> ADDOP E5 */
750	greg	2.6	/* E5 */
751	greg	1.1	{
752	greg	2.37	EPNODE ep1, ep2;
753	greg	1.1
754			if (nextc == '-') {
755			scan();
756	greg	1.3	ep2 = getE5();
757			if (ep2->type == NUM) {
758			ep2->v.num = -ep2->v.num;
759			return(ep2);
760			}
761	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
762	greg	2.33	ep1 = ep2->v.kid;
763	greg	2.41	efree(ep2);
764	greg	2.33	return(ep1);
765	greg	1.16	}
766	greg	1.1	ep1 = newnode();
767			ep1->type = UMINUS;
768	greg	1.3	addekid(ep1, ep2);
769	greg	1.1	return(ep1);
770			}
771			if (nextc == '+')
772			scan();
773			return(getE5());
774			}
775
776
777			EPNODE *
778	schorsch	2.28	getE5(void) /* E5 -> (E1) */
779	greg	2.6	/* VAR */
780			/* NUM */
781			/* $N */
782			/* FUNC(E1,..) */
783			/* ARG */
784	greg	1.1	{
785	schorsch	2.22	int i;
786			char *nam;
787	greg	2.37	EPNODE ep1, ep2;
788	greg	1.1
789	schorsch	2.22	if (nextc == '(') {
790			scan();
791			ep1 = getE1();
792			if (nextc != ')')
793			syntax("')' expected");
794			scan();
795			return(ep1);
796			}
797			if (esupport&E_INCHAN && nextc == '$') {
798			scan();
799			ep1 = newnode();
800			ep1->type = CHAN;
801			ep1->v.chan = getinum();
802			return(ep1);
803			}
804			if (esupport&(E_VARIABLE\|E_FUNCTION) &&
805	greg	2.42	(isalpha(nextc) \| (nextc == CNTXMARK))) {
806	schorsch	2.22	nam = getname();
807			ep1 = NULL;
808			if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
809			&& curfunc != NULL)
810			for (i = 1, ep2 = curfunc->v.kid->sibling;
811			ep2 != NULL; i++, ep2 = ep2->sibling)
812			if (!strcmp(ep2->v.name, nam)) {
813			ep1 = newnode();
814			ep1->type = ARG;
815			ep1->v.chan = i;
816			break;
817			}
818			if (ep1 == NULL) {
819			ep1 = newnode();
820			ep1->type = VAR;
821			ep1->v.ln = varinsert(nam);
822	greg	1.1	}
823	schorsch	2.22	if (esupport&E_FUNCTION && nextc == '(') {
824			ep2 = newnode();
825			ep2->type = FUNC;
826			addekid(ep2, ep1);
827			ep1 = ep2;
828			do {
829			scan();
830			addekid(ep1, getE1());
831			} while (nextc == ',');
832			if (nextc != ')')
833			syntax("')' expected");
834			scan();
835			} else if (!(esupport&E_VARIABLE))
836			syntax("'(' expected");
837			if (esupport&E_RCONST && isconstvar(ep1))
838			ep1 = rconst(ep1);
839			return(ep1);
840			}
841			if (isdecimal(nextc)) {
842			ep1 = newnode();
843			ep1->type = NUM;
844			ep1->v.num = getnum();
845			return(ep1);
846			}
847			syntax("unexpected character");
848			return NULL; /* pro forma return */
849	greg	1.1	}
850
851
852			EPNODE *
853	schorsch	2.28	rconst( /* reduce a constant expression */
854	greg	2.37	EPNODE *epar
855	schorsch	2.28	)
856	greg	1.1	{
857	greg	2.37	EPNODE *ep;
858	greg	1.1
859			ep = newnode();
860			ep->type = NUM;
861			errno = 0;
862			ep->v.num = evalue(epar);
863	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE))
864	greg	2.6	syntax("bad constant expression");
865	greg	2.43	epfree(epar,1);
866	greg	1.1
867			return(ep);
868	greg	1.9	}
869
870
871	greg	2.18	int
872	schorsch	2.28	isconstvar( /* is ep linked to a constant expression? */
873	greg	2.37	EPNODE *ep
874	schorsch	2.28	)
875	greg	1.9	{
876	greg	2.37	EPNODE *ep1;
877	greg	1.10
878	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
879	greg	1.11	if (!isconstfun(ep->v.kid))
880			return(0);
881	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
882	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
883	greg	1.9	return(0);
884			return(1);
885			}
886			if (ep->type != VAR)
887			return(0);
888			ep1 = ep->v.ln->def;
889			if (ep1 == NULL \|\| ep1->type != ':')
890			return(0);
891	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
892	greg	1.9	return(0);
893			return(1);
894	greg	1.1	}
895	greg	1.11
896
897	greg	2.18	int
898	schorsch	2.28	isconstfun( /* is ep linked to a constant function? */
899	greg	2.37	EPNODE *ep
900	schorsch	2.28	)
901	greg	1.11	{
902	greg	2.37	EPNODE *dp;
903			LIBR *lp;
904	greg	1.11
905			if (ep->type != VAR)
906			return(0);
907	schorsch	2.25	if ((dp = ep->v.ln->def) != NULL) {
908	greg	2.18	if (dp->v.kid->type == FUNC)
909			return(dp->type == ':');
910			else
911			return(0); /* don't identify masked library functions */
912	schorsch	2.25	}
913	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
914	greg	2.3	return(lp->atyp == ':');
915			return(0);
916	greg	1.11	}