src/common/calexpr.c

/* Copyright (c) 1986 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  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

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

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

extern double  atof(), pow();
extern char  *fgets(), *savestr();
extern char  *emalloc(), *ecalloc();
extern EPNODE  *curfunc;
extern double  efunc(), evariable();
static double  euminus(), echannel(), eargument(), enumber();
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();
extern int  errno;

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


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;
#endif
            
        case SYM:
            freestr(epar->v.name);
            break;

        case NUM:
        case CHAN:
        case ARG:
        case TICK:
            break;

        default:
            for (ep = epar->v.kid; ep != NULL; ep = 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();
}


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 *
ltoa(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(ltoa((long)lineno));
        }
        eputs(": syntax error:\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;
}


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

    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[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);
        }
        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;
    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)) {
        ep1 = newnode();
        ep1->type = VAR;
        ep1->v.ln = varinsert(getname());

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