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;
    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.13
Committed:	Thu Aug 8 12:11:19 1991 UTC (32 years, 8 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 1.12:	+13 -0 lines
Log Message:	added getscanpos() function
#	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			register EPNODE ep1, ep2;
608
609			if (nextc == '(') {
610			scan();
611			ep1 = getE1();
612			if (nextc != ')')
613			syntax("')' expected");
614			scan();
615			return(ep1);
616			}
617
618			#ifdef INCHAN
619			if (nextc == '$') {
620			scan();
621			ep1 = newnode();
622			ep1->type = CHAN;
623			ep1->v.chan = getinum();
624			return(ep1);
625			}
626			#endif
627
628			#if defined(VARIABLE) \|\| defined(FUNCTION)
629			if (isalpha(nextc)) {
630			ep1 = newnode();
631			ep1->type = VAR;
632			ep1->v.ln = varinsert(getname());
633
634			#if defined(VARIABLE) && defined(FUNCTION)
635			if (curfunc != NULL)
636			for (i = 1, ep2 = curfunc->v.kid->sibling;
637			ep2 != NULL; i++, ep2 = ep2->sibling)
638			if (!strcmp(ep2->v.name, ep1->v.ln->name)) {
639			epfree(ep1);
640			ep1 = newnode();
641			ep1->type = ARG;
642			ep1->v.chan = i;
643			break;
644			}
645			#endif
646			#ifdef FUNCTION
647			if (nextc == '(') {
648			ep2 = newnode();
649			ep2->type = FUNC;
650			addekid(ep2, ep1);
651			ep1 = ep2;
652			do {
653			scan();
654			addekid(ep1, getE1());
655			} while (nextc == ',');
656			if (nextc != ')')
657			syntax("')' expected");
658			scan();
659			}
660			#ifndef VARIABLE
661			else
662			syntax("'(' expected");
663			#endif
664			#endif
665	greg	1.9	#ifdef RCONST
666			if (isconstvar(ep1))
667			ep1 = rconst(ep1);
668			#endif
669	greg	1.1	return(ep1);
670			}
671			#endif
672
673			if (isdecimal(nextc)) {
674			ep1 = newnode();
675			ep1->type = NUM;
676			ep1->v.num = getnum();
677			return(ep1);
678			}
679			syntax("unexpected character");
680			}
681
682
683			#ifdef RCONST
684			EPNODE *
685			rconst(epar) /* reduce a constant expression */
686			register EPNODE *epar;
687			{
688			register EPNODE *ep;
689
690			ep = newnode();
691			ep->type = NUM;
692			errno = 0;
693			ep->v.num = evalue(epar);
694			if (errno)
695			syntax("bad constant expression");
696			epfree(epar);
697
698			return(ep);
699	greg	1.9	}
700
701
702	greg	1.11	isconstvar(ep) /* is ep linked to a constant expression? */
703	greg	1.9	register EPNODE *ep;
704			{
705			#ifdef VARIABLE
706			register EPNODE *ep1;
707			#ifdef FUNCTION
708	greg	1.10
709	greg	1.9	if (ep->type == FUNC) {
710	greg	1.11	if (!isconstfun(ep->v.kid))
711			return(0);
712	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
713	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
714	greg	1.9	return(0);
715			return(1);
716			}
717			#endif
718			if (ep->type != VAR)
719			return(0);
720			ep1 = ep->v.ln->def;
721			if (ep1 == NULL \|\| ep1->type != ':')
722			return(0);
723			#ifdef FUNCTION
724			if (ep1->v.kid->type != SYM)
725			return(0);
726			#endif
727			return(1);
728			#else
729			return(ep->type == FUNC);
730			#endif
731	greg	1.1	}
732	greg	1.11
733
734			#if defined(FUNCTION) && defined(VARIABLE)
735			isconstfun(ep) /* is ep linked to a constant function? */
736			register EPNODE *ep;
737			{
738			register EPNODE *dp;
739			register LIBR *lp;
740
741			if (ep->type != VAR)
742			return(0);
743			dp = ep->v.ln->def;
744			if (dp != NULL && dp->type != ':')
745			return(0);
746			if ((dp == NULL \|\| dp->v.kid->type != FUNC)
747			&& ((lp = liblookup(ep->v.ln->name)) == NULL
748			\|\| lp->atyp != ':'))
749			return(0);
750			return(1);
751			}
752			#endif
753	greg	1.1	#endif