src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.49 2024/02/26 18:16:35 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);
    else
        memset(epar, 0, sizeof(EPNODE));
}


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