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) == '.')

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