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


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 *
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;
    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)) {
        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);
    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.14
Committed:	Thu Aug 8 13:40:09 1991 UTC (32 years, 8 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 1.13:	+10 -6 lines
Log Message:	added bug associated with context naming and function arguments
#	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.13	getscanpos(fnp, lnp, spp, fpp) /* return current scan position */
327			char **fnp;
328			int *lnp;
329			char **spp;
330			FILE **fpp;
331			{
332			if (fnp != NULL) *fnp = infile;
333			if (lnp != NULL) *lnp = lineno;
334			if (spp != NULL) *spp = linbuf+linepos;
335			if (fpp != NULL) *fpp = infp;
336			}
337
338
339	greg	1.12	int
340			scan() /* scan next character, return literal next */
341	greg	1.1	{
342	greg	1.12	register int lnext = 0;
343
344	greg	1.1	do {
345			if (linbuf[linepos] == '\0')
346			if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
347			nextc = EOF;
348			else {
349			nextc = linbuf[0];
350	greg	1.6	lineno++;
351	greg	1.1	linepos = 1;
352			}
353			else
354			nextc = linbuf[linepos++];
355	greg	1.12	if (!lnext)
356			lnext = nextc;
357	greg	1.1	if (nextc == '{') {
358			scan();
359			while (nextc != '}')
360			if (nextc == EOF)
361			syntax("'}' expected");
362			else
363			scan();
364			scan();
365			}
366			} while (isspace(nextc));
367	greg	1.12	return(lnext);
368	greg	1.1	}
369
370
371	greg	1.6	char *
372			ltoa(l) /* convert long to ascii */
373			long l;
374			{
375			static char buf[16];
376			register char *cp;
377			int neg = 0;
378
379			if (l == 0)
380			return("0");
381			if (l < 0) {
382			l = -l;
383			neg++;
384			}
385			cp = buf + sizeof(buf);
386			*--cp = '\0';
387			while (l) {
388			*--cp = l % 10 + '0';
389			l /= 10;
390			}
391			if (neg)
392			*--cp = '-';
393			return(cp);
394			}
395
396
397	greg	1.1	syntax(err) /* report syntax error and quit */
398			char *err;
399			{
400			register int i;
401
402	greg	1.6	if (infile != NULL \|\| lineno != 0) {
403			if (infile != NULL) eputs(infile);
404			if (lineno != 0) {
405			eputs(infile != NULL ? ", line " : "line ");
406			eputs(ltoa((long)lineno));
407			}
408	greg	1.7	eputs(": syntax error:\n");
409	greg	1.1	}
410	greg	1.7	eputs(linbuf);
411			if (linbuf[strlen(linbuf)-1] != '\n')
412			eputs("\n");
413			for (i = 0; i < linepos-1; i++)
414			eputs(linbuf[i] == '\t' ? "\t" : " ");
415			eputs("^ ");
416	greg	1.1	eputs(err);
417			eputs("\n");
418			quit(1);
419			}
420
421
422			addekid(ep, ekid) /* add a child to ep */
423			register EPNODE *ep;
424			EPNODE *ekid;
425			{
426			if (ep->v.kid == NULL)
427			ep->v.kid = ekid;
428			else {
429			for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
430			;
431			ep->sibling = ekid;
432			}
433			ekid->sibling = NULL;
434			}
435
436
437			char *
438			getname() /* scan an identifier */
439			{
440			static char str[MAXWORD+1];
441	greg	1.12	register int i, lnext;
442	greg	1.1
443	greg	1.12	lnext = nextc;
444			for (i = 0; i < MAXWORD && isid(lnext); i++, lnext = scan())
445			str[i] = lnext;
446	greg	1.1	str[i] = '\0';
447
448			return(str);
449			}
450
451
452			int
453			getinum() /* scan a positive integer */
454			{
455	greg	1.12	register int n, lnext;
456	greg	1.1
457			n = 0;
458	greg	1.12	lnext = nextc;
459			while (isdigit(lnext)) {
460			n = n * 10 + lnext - '0';
461			lnext = scan();
462	greg	1.1	}
463			return(n);
464			}
465
466
467			double
468			getnum() /* scan a positive float */
469			{
470	greg	1.12	register int i, lnext;
471	greg	1.1	char str[MAXWORD+1];
472
473			i = 0;
474	greg	1.12	lnext = nextc;
475			while (isdigit(lnext) && i < MAXWORD) {
476			str[i++] = lnext;
477			lnext = scan();
478	greg	1.1	}
479	greg	1.12	if (lnext == '.' && i < MAXWORD) {
480			str[i++] = lnext;
481			lnext = scan();
482			while (isdigit(lnext) && i < MAXWORD) {
483			str[i++] = lnext;
484			lnext = scan();
485	greg	1.1	}
486			}
487	greg	1.12	if ((lnext == 'e' \|\| lnext == 'E') && i < MAXWORD) {
488			str[i++] = lnext;
489			lnext = scan();
490			if ((lnext == '-' \|\| lnext == '+') && i < MAXWORD) {
491			str[i++] = lnext;
492			lnext = scan();
493	greg	1.1	}
494	greg	1.12	while (isdigit(lnext) && i < MAXWORD) {
495			str[i++] = lnext;
496			lnext = scan();
497	greg	1.1	}
498			}
499			str[i] = '\0';
500
501			return(atof(str));
502			}
503
504
505			EPNODE *
506			getE1() /* E1 -> E1 ADDOP E2 */
507			/* E2 */
508			{
509			register EPNODE ep1, ep2;
510
511			ep1 = getE2();
512			while (nextc == '+' \|\| nextc == '-') {
513			ep2 = newnode();
514			ep2->type = nextc;
515			scan();
516			addekid(ep2, ep1);
517			addekid(ep2, getE2());
518			#ifdef RCONST
519			if (ep1->type == NUM && ep1->sibling->type == NUM)
520			ep2 = rconst(ep2);
521			#endif
522			ep1 = ep2;
523			}
524			return(ep1);
525			}
526
527
528			EPNODE *
529			getE2() /* E2 -> E2 MULOP E3 */
530			/* E3 */
531			{
532			register EPNODE ep1, ep2;
533
534			ep1 = getE3();
535			while (nextc == '*' \|\| nextc == '/') {
536			ep2 = newnode();
537			ep2->type = nextc;
538			scan();
539			addekid(ep2, ep1);
540			addekid(ep2, getE3());
541			#ifdef RCONST
542			if (ep1->type == NUM && ep1->sibling->type == NUM)
543			ep2 = rconst(ep2);
544			#endif
545			ep1 = ep2;
546			}
547			return(ep1);
548			}
549
550
551			EPNODE *
552	greg	1.8	getE3() /* E3 -> E4 ^ E3 */
553	greg	1.1	/* E4 */
554			{
555			register EPNODE ep1, ep2;
556
557			ep1 = getE4();
558	greg	1.8	if (nextc == '^') {
559	greg	1.1	ep2 = newnode();
560			ep2->type = nextc;
561			scan();
562			addekid(ep2, ep1);
563	greg	1.8	addekid(ep2, getE3());
564	greg	1.1	#ifdef RCONST
565			if (ep1->type == NUM && ep1->sibling->type == NUM)
566			ep2 = rconst(ep2);
567			#endif
568	greg	1.8	return(ep2);
569	greg	1.1	}
570			return(ep1);
571			}
572
573
574			EPNODE *
575			getE4() /* E4 -> ADDOP E5 */
576			/* E5 */
577			{
578	greg	1.3	register EPNODE ep1, ep2;
579	greg	1.1
580			if (nextc == '-') {
581			scan();
582	greg	1.3	ep2 = getE5();
583			if (ep2->type == NUM) {
584			ep2->v.num = -ep2->v.num;
585			return(ep2);
586			}
587	greg	1.1	ep1 = newnode();
588			ep1->type = UMINUS;
589	greg	1.3	addekid(ep1, ep2);
590	greg	1.1	return(ep1);
591			}
592			if (nextc == '+')
593			scan();
594			return(getE5());
595			}
596
597
598			EPNODE *
599			getE5() /* E5 -> (E1) */
600			/* VAR */
601			/* NUM */
602			/* $N */
603			/* FUNC(E1,..) */
604			/* ARG */
605			{
606			int i;
607	greg	1.14	char *nam;
608	greg	1.1	register EPNODE ep1, ep2;
609
610			if (nextc == '(') {
611			scan();
612			ep1 = getE1();
613			if (nextc != ')')
614			syntax("')' expected");
615			scan();
616			return(ep1);
617			}
618
619			#ifdef INCHAN
620			if (nextc == '$') {
621			scan();
622			ep1 = newnode();
623			ep1->type = CHAN;
624			ep1->v.chan = getinum();
625			return(ep1);
626			}
627			#endif
628
629			#if defined(VARIABLE) \|\| defined(FUNCTION)
630			if (isalpha(nextc)) {
631	greg	1.14	nam = getname();
632	greg	1.1	#if defined(VARIABLE) && defined(FUNCTION)
633	greg	1.14	ep1 = NULL;
634	greg	1.1	if (curfunc != NULL)
635			for (i = 1, ep2 = curfunc->v.kid->sibling;
636			ep2 != NULL; i++, ep2 = ep2->sibling)
637	greg	1.14	if (!strcmp(ep2->v.name, nam)) {
638	greg	1.1	ep1 = newnode();
639			ep1->type = ARG;
640			ep1->v.chan = i;
641			break;
642			}
643	greg	1.14	if (ep1 == NULL)
644	greg	1.1	#endif
645	greg	1.14	{
646			ep1 = newnode();
647			ep1->type = VAR;
648			ep1->v.ln = varinsert(nam);
649			}
650	greg	1.1	#ifdef FUNCTION
651			if (nextc == '(') {
652			ep2 = newnode();
653			ep2->type = FUNC;
654			addekid(ep2, ep1);
655			ep1 = ep2;
656			do {
657			scan();
658			addekid(ep1, getE1());
659			} while (nextc == ',');
660			if (nextc != ')')
661			syntax("')' expected");
662			scan();
663			}
664			#ifndef VARIABLE
665			else
666			syntax("'(' expected");
667			#endif
668			#endif
669	greg	1.9	#ifdef RCONST
670			if (isconstvar(ep1))
671			ep1 = rconst(ep1);
672			#endif
673	greg	1.1	return(ep1);
674			}
675			#endif
676
677			if (isdecimal(nextc)) {
678			ep1 = newnode();
679			ep1->type = NUM;
680			ep1->v.num = getnum();
681			return(ep1);
682			}
683			syntax("unexpected character");
684			}
685
686
687			#ifdef RCONST
688			EPNODE *
689			rconst(epar) /* reduce a constant expression */
690			register EPNODE *epar;
691			{
692			register EPNODE *ep;
693
694			ep = newnode();
695			ep->type = NUM;
696			errno = 0;
697			ep->v.num = evalue(epar);
698			if (errno)
699			syntax("bad constant expression");
700			epfree(epar);
701
702			return(ep);
703	greg	1.9	}
704
705
706	greg	1.11	isconstvar(ep) /* is ep linked to a constant expression? */
707	greg	1.9	register EPNODE *ep;
708			{
709			#ifdef VARIABLE
710			register EPNODE *ep1;
711			#ifdef FUNCTION
712	greg	1.10
713	greg	1.9	if (ep->type == FUNC) {
714	greg	1.11	if (!isconstfun(ep->v.kid))
715			return(0);
716	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
717	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
718	greg	1.9	return(0);
719			return(1);
720			}
721			#endif
722			if (ep->type != VAR)
723			return(0);
724			ep1 = ep->v.ln->def;
725			if (ep1 == NULL \|\| ep1->type != ':')
726			return(0);
727			#ifdef FUNCTION
728			if (ep1->v.kid->type != SYM)
729			return(0);
730			#endif
731			return(1);
732			#else
733			return(ep->type == FUNC);
734			#endif
735	greg	1.1	}
736	greg	1.11
737
738			#if defined(FUNCTION) && defined(VARIABLE)
739			isconstfun(ep) /* is ep linked to a constant function? */
740			register EPNODE *ep;
741			{
742			register EPNODE *dp;
743			register LIBR *lp;
744
745			if (ep->type != VAR)
746			return(0);
747			dp = ep->v.ln->def;
748			if (dp != NULL && dp->type != ':')
749			return(0);
750			if ((dp == NULL \|\| dp->v.kid->type != FUNC)
751			&& ((lp = liblookup(ep->v.ln->name)) == NULL
752			\|\| lp->atyp != ':'))
753			return(0);
754			return(1);
755			}
756			#endif
757	greg	1.1	#endif