src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.36 2015/08/01 23:27:04 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
)
{
    EPNODE  *ep;
    double  rval;

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