src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.23 2003/07/03 22:41:44 schorsch 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  "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  nextc;                             /* lookahead character */

double  (*eoper[])() = {                /* 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(expr)                    /* 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(expr)                      /* evaluate an expression string */
char  *expr;
{
    register EPNODE  *ep;
    double  rval;

    ep = eparse(expr);
    rval = evalue(ep);
    epfree(ep);
    return(rval);
}


int
epcmp(ep1, ep2)                 /* compare two expressions for equivalence */
register EPNODE  *ep1, *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 TICK:
        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(epar)                    /* free a parse tree */
register EPNODE  *epar;
{
    register 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 TICK:
            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(ep)
EPNODE  *ep;
{
    return(argument(ep->v.chan));
}

static double
enumber(ep)
EPNODE  *ep;
{
    return(ep->v.num);
}

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

    return(-evalue(ep1));
}

static double
echannel(ep)
EPNODE  *ep;
{
    return(chanvalue(ep->v.chan));
}

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

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

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

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

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

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

static double
edivi(ep)
EPNODE  *ep;
{
    register 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(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;
    double  d;
    int  lasterrno;

    lasterrno = errno;
    errno = 0;
    d = pow(evalue(ep1), evalue(ep1->sibling));
#ifdef  IEEE
    if (!finite(d))
        errno = EDOM;
#endif
    if (errno == EDOM || errno == ERANGE) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

static double
ebotch(ep)
EPNODE  *ep;
{
    eputs("Bad expression!\n");
    quit(1);
        return 0.0; /* pro forma return */
}


EPNODE *
ekid(ep, n)                     /* return pointer to a node's nth kid */
register EPNODE  *ep;
register int  n;
{

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

    return(ep);
}


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

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

    return(n);
}


void
initfile(fp, fn, ln)            /* 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(s, fn, ln)              /* prepare input string */
char  *s;
char  *fn;
int  ln;
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


void
getscanpos(fnp, lnp, spp, fpp)  /* 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()                          /* scan next character, return literal next */
{
    register 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 == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
    return(lnext);
}


char *
long2ascii(l)                         /* convert long to ascii */
long  l;
{
    static char  buf[16];
    register 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(err)                     /* report syntax error and quit */
char  *err;
{
    register 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(ep, ekid)                       /* add a child to ep */
register 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()                       /* scan an identifier */
{
    static char  str[RMAXWORD+1];
    register 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()                       /* scan a positive integer */
{
    register int  n, lnext;

    n = 0;
    lnext = nextc;
    while (isdigit(lnext)) {
        n = n * 10 + lnext - '0';
        lnext = scan();
    }
    return(n);
}


double
getnum()                        /* scan a positive float */
{
    register 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()                         /* E1 -> E1 ADDOP E2 */
                                /*       E2 */
{
    register 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()                         /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE3();
    while (nextc == '*' || nextc == '/') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE3()                         /* E3 -> E4 ^ E3 */
                                /*       E4 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE4();
    if (nextc == '^') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        return(ep2);
    }
    return(ep1);
}


EPNODE *
getE4()                         /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    register 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) */
            efree((char *)ep2);
            return(ep2->v.kid);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


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