src/common/calexpr.c

/* Copyright (c) 1991 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) == '.')

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

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


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

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

    return(str);
}
#endif


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

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


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

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if (lnext == '.' && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        while (isdigit(lnext) && i < MAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    if ((lnext == 'e' || lnext == 'E') && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if ((lnext == '-' || lnext == '+') && i < MAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
        while (isdigit(lnext) && i < MAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    str[i] = '\0';

    return(atof(str));
}


EPNODE *
getE1()                         /* E1 -> E1 ADDOP E2 */
                                /*       E2 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE2();
    while (nextc == '+' || nextc == '-') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE2());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE2()                         /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE3();
    while (nextc == '*' || nextc == '/') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE3()                         /* E3 -> E4 ^ E3 */
                                /*       E4 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE4();
    if (nextc == '^') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        return(ep2);
    }
    return(ep1);
}


EPNODE *
getE4()                         /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    register EPNODE  *ep1, *ep2;

    if (nextc == '-') {
        scan();
        ep2 = getE5();
        if (ep2->type == NUM) {
                ep2->v.num = -ep2->v.num;
                return(ep2);
        }
        if (ep2->type == UMINUS) {      /* don't generate -(-E5) */
            efree((char *)ep2);
            return(ep2->v.kid);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


EPNODE *
getE5()                         /* E5 -> (E1) */
                                /*       VAR */
                                /*       NUM */
                                /*       $N */
                                /*       FUNC(E1,..) */
                                /*       ARG */
{
    int  i;
    char  *nam;
    register EPNODE  *ep1, *ep2;

    if (nextc == '(') {
        scan();
        ep1 = getE1();
        if (nextc != ')')
            syntax("')' expected");
        scan();
        return(ep1);
    }

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

#if  defined(VARIABLE) || defined(FUNCTION)
    if (isalpha(nextc) || nextc == CNTXMARK) {
        nam = getname();
#if  defined(VARIABLE) && defined(FUNCTION)
        ep1 = NULL;
        if (curfunc != NULL)
            for (i = 1, ep2 = curfunc->v.kid->sibling;
                                ep2 != NULL; i++, ep2 = ep2->sibling)
                if (!strcmp(ep2->v.name, nam)) {
                    ep1 = newnode();
                    ep1->type = ARG;
                    ep1->v.chan = i;
                    break;
                }
        if (ep1 == NULL)
#endif
        {
            ep1 = newnode();
            ep1->type = VAR;
            ep1->v.ln = varinsert(nam);
        }
#ifdef  FUNCTION
        if (nextc == '(') {
            ep2 = newnode();
            ep2->type = FUNC;
            addekid(ep2, ep1);
            ep1 = ep2;
            do {
                scan();
                addekid(ep1, getE1());
            } while (nextc == ',');
            if (nextc != ')')
                syntax("')' expected");
            scan();
        }
#ifndef  VARIABLE
        else
            syntax("'(' expected");
#endif
#endif
#ifdef  RCONST
        if (isconstvar(ep1))
            ep1 = rconst(ep1);
#endif
        return(ep1);
    }
#endif

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


#ifdef  RCONST
EPNODE *
rconst(epar)                    /* reduce a constant expression */
register EPNODE  *epar;
{
    register EPNODE  *ep;

    ep = newnode();
    ep->type = NUM;
    errno = 0;
    ep->v.num = evalue(epar);
    if (errno)
        syntax("bad constant expression");
    epfree(epar);
 
    return(ep);
}


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

    if (ep->type == FUNC) {
        if (!isconstfun(ep->v.kid))
                return(0);
        for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
            if (ep1->type != NUM && !isconstfun(ep1))
                return(0);
        return(1);
    }
#endif
    if (ep->type != VAR)
        return(0);
    ep1 = ep->v.ln->def;
    if (ep1 == NULL || ep1->type != ':')
        return(0);
#ifdef  FUNCTION
    if (ep1->v.kid->type != SYM)
        return(0);
#endif
    return(1);
#else
    return(ep->type == FUNC);
#endif
}


#if  defined(FUNCTION) && defined(VARIABLE)
isconstfun(ep)                  /* is ep linked to a constant function? */
register EPNODE  *ep;
{
    register EPNODE  *dp;
    register LIBR  *lp;

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