src/common/calexpr.c

/* Copyright (c) 1992 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  <math.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 char  *fgets(), *savestr();
extern char  *emalloc(), *ecalloc();
extern EPNODE  *curfunc;
extern double  efunc(), evariable();
static double  euminus(), eargument(), enumber();
#ifdef  INCHAN
static double  echannel();
#endif
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();

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