src/common/calexpr.c

/* Copyright (c) 1992 Regents of the University of California */

#ifndef lint
static char SCCSid[] = "$SunId$ LBL";
#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)
 */

#include  <stdio.h>

#include  <ctype.h>

#include  <errno.h>

#include  <math.h>

#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))

#define  isdecimal(c)   (isdigit(c) || (c) == '.')

extern char  *savestr();
extern char  *emalloc(), *ecalloc();
extern EPNODE  *curfunc;
extern double  efunc(), evariable();
static double  euminus(), eargument(), enumber();
#ifdef  INCHAN
static double  echannel();
#endif
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();

#ifdef  DCL_ATOF
extern double  atof();
#endif

int  nextc;                             /* lookahead character */

double  (*eoper[])() = {                /* expression operations */
        ebotch,
#ifdef  VARIABLE
        evariable,
#else
        ebotch,
#endif
        enumber,
        euminus,
#ifdef  INCHAN
        echannel,
#else
        ebotch,
#endif
#ifdef  FUNCTION
        efunc,
        eargument,
#else
        ebotch,
        ebotch,
#endif
        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);
#if  defined(VARIABLE) && defined(FUNCTION)
    curfunc = NULL;
#endif
    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);
}


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);
        }
}


epfree(epar)                    /* free a parse tree */
register EPNODE  *epar;
{
    register EPNODE  *ep;

    switch (epar->type) {

#if  defined(VARIABLE) || defined(FUNCTION)
        case VAR:
            varfree(epar->v.ln);
            break;
            
        case SYM:
            freestr(epar->v.name);
            break;
#endif

        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 */
#ifdef  FUNCTION
static double
eargument(ep)
EPNODE  *ep;
{
    return(argument(ep->v.chan));
}
#endif

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));
}

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

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) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

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


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);
}


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();
}


initstr(s, fn, ln)              /* prepare input string */
char  *s;
char  *fn;
int  ln;
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


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);
}


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);
}


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;
}


#if  defined(VARIABLE) || defined(FUNCTION)
char *
getname()                       /* scan an identifier */
{
    static char  str[MAXWORD+1];
    register int  i, lnext;

    lnext = nextc;
    for (i = 0; i < MAXWORD && isid(lnext); i++, lnext = scan())
        str[i] = lnext;
    str[i] = '\0';
    while (isid(lnext))         /* skip rest of name */
        lnext = scan();

    return(str);
}
#endif


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[MAXWORD+1];

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if (lnext == '.' && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        while (isdigit(lnext) && i < MAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    if ((lnext == 'e' || lnext == 'E') && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if ((lnext == '-' || lnext == '+') && i < MAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
        while (isdigit(lnext) && i < MAXWORD) {
            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());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        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());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        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());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        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);
    }

#ifdef  INCHAN
    if (nextc == '$') {
        scan();
        ep1 = newnode();
        ep1->type = CHAN;
        ep1->v.chan = getinum();
        return(ep1);
    }
#endif

#if  defined(VARIABLE) || defined(FUNCTION)
    if (isalpha(nextc) || nextc == CNTXMARK) {
        nam = getname();
#if  defined(VARIABLE) && defined(FUNCTION)
        ep1 = NULL;
        if (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)
#endif
        {
            ep1 = newnode();
            ep1->type = VAR;
            ep1->v.ln = varinsert(nam);
        }
#ifdef  FUNCTION
        if (nextc == '(') {
            ep2 = newnode();
            ep2->type = FUNC;
            addekid(ep2, ep1);
            ep1 = ep2;
            do {
                scan();
                addekid(ep1, getE1());
            } while (nextc == ',');
            if (nextc != ')')
                syntax("')' expected");
            scan();
        }
#ifndef  VARIABLE
        else
            syntax("'(' expected");
#endif
#endif
#ifdef  RCONST
        if (isconstvar(ep1))
            ep1 = rconst(ep1);
#endif
        return(ep1);
    }
#endif

    if (isdecimal(nextc)) {
        ep1 = newnode();
        ep1->type = NUM;
        ep1->v.num = getnum();
        return(ep1);
    }
    syntax("unexpected character");
}


#ifdef  RCONST
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)
        syntax("bad constant expression");
    epfree(epar);
 
    return(ep);
}


isconstvar(ep)                  /* is ep linked to a constant expression? */
register EPNODE  *ep;
{
#ifdef  VARIABLE
    register EPNODE  *ep1;
#ifdef  FUNCTION

    if (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);
    }
#endif
    if (ep->type != VAR)
        return(0);
    ep1 = ep->v.ln->def;
    if (ep1 == NULL || ep1->type != ':')
        return(0);
#ifdef  FUNCTION
    if (ep1->v.kid->type != SYM)
        return(0);
#endif
    return(1);
#else
    return(ep->type == FUNC);
#endif
}


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