src/common/calexpr.c

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