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  MAXWORD        64              /* maximum word length */

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

#define  isid(c)        (isalnum(c) || (c) == '_' || (c) == '.')

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


scan()                          /* scan next character */
{
    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 (nextc == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
}


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;

    for (i = 0; i < MAXWORD && isid(nextc); i++, scan())
        str[i] = nextc;
    str[i] = '\0';

    return(str);
}


int
getinum()                       /* scan a positive integer */
{
    register int  n;

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


double
getnum()                        /* scan a positive float */
{
    register int  i;
    char  str[MAXWORD+1];

    i = 0;
    while (isdigit(nextc) && i < MAXWORD) {
        str[i++] = nextc;
        scan();
    }
    if (nextc == '.' && i < MAXWORD) {
        str[i++] = nextc;
        scan();
        while (isdigit(nextc) && i < MAXWORD) {
            str[i++] = nextc;
            scan();
        }
    }
    if ((nextc == 'e' || nextc == 'E') && i < MAXWORD) {
        str[i++] = nextc;
        scan();
        if ((nextc == '-' || nextc == '+') && i < MAXWORD) {
            str[i++] = nextc;
            scan();
        }
        while (isdigit(nextc) && i < MAXWORD) {
            str[i++] = nextc;
            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? */
register EPNODE  *ep;
{
#ifdef  VARIABLE
    register EPNODE  *ep1;
#ifdef  FUNCTION
    LIBR  *lp;

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