src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.39 2019/12/28 18:05:13 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) == '.')

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);
    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
)
{
    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:
            while ((ep = epar->v.kid) != NULL) {
                epar->v.kid = ep->sibling;
                epfree(ep);
            }
            break;

    }

    efree((char *)epar);
}

                                /* 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
)
{
    EPNODE  *ep1 = ep->v.kid;

    return(evalue(ep1) + evalue(ep1->sibling));
}

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

    return(evalue(ep1) - evalue(ep1->sibling));
}

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

    return(evalue(ep1) * evalue(ep1->sibling));
}

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

    d = evalue(ep1->sibling);
    if (d == 0.0) {
        wputs("Division by zero\n");
        errno = ERANGE;
        return(0.0);
    }
    return(evalue(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
)
{

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        if (--n < 0)
            break;

    return(ep);
}


int
nekids(                 /* return # of kids for node ep */
    EPNODE       *ep
)
{
    int  n = 0;

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        n++;

    return(n);
}


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      *ekid
)
{
    if (ep->v.kid == NULL)
        ep->v.kid = ekid;
    else {
        for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
            ;
        ep->sibling = ekid;
    }
    ekid->sibling = NULL;
}


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