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

#ifdef  DCL_ATOF
extern double  atof();
#endif

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