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  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))

#define  isdecimal(c)   (isdigit(c) || (c) == '.')

#ifndef atof
extern double  atof();
#endif
extern double  pow();
extern char  *fgets(), *savestr();
extern char  *emalloc(), *ecalloc();
extern EPNODE  *curfunc;
extern double  efunc(), evariable();
static double  euminus(), echannel(), eargument(), enumber();
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();

int  nextc;                             /* lookahead character */

double  (*eoper[])() = {                /* expression operations */
        ebotch,
#ifdef  VARIABLE
        evariable,
#else
        ebotch,
#endif
        enumber,
        euminus,
#ifdef  INCHAN
        echannel,
#else
        ebotch,
#endif
#ifdef  FUNCTION
        efunc,
        eargument,
#else
        ebotch,
        ebotch,
#endif
        ebotch,
        ebotch,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        emult,
        eadd,
        0,
        esubtr,
        0,
        edivi,
        0,0,0,0,0,0,0,0,0,0,
        ebotch,
        0,0,
        ebotch,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        epow,
};

static FILE  *infp;                     /* input file pointer */
static char  *linbuf;                   /* line buffer */
static char  *infile;                   /* input file name */
static int  lineno;                     /* input line number */
static int  linepos;                    /* position in buffer */


EPNODE *
eparse(expr)                    /* parse an expression string */
char  *expr;
{
    EPNODE  *ep;

    initstr(expr, NULL, 0);
#if  defined(VARIABLE) && defined(FUNCTION)
    curfunc = NULL;
#endif
    ep = getE1();
    if (nextc != EOF)
        syntax("unexpected character");
    return(ep);
}


double
eval(expr)                      /* evaluate an expression string */
char  *expr;
{
    register EPNODE  *ep;
    double  rval;

    ep = eparse(expr);
    rval = evalue(ep);
    epfree(ep);
    return(rval);
}


epfree(epar)                    /* free a parse tree */
register EPNODE  *epar;
{
    register EPNODE  *ep;

    switch (epar->type) {

#if  defined(VARIABLE) || defined(FUNCTION)
        case VAR:
            varfree(epar->v.ln);
            break;
            
        case SYM:
            freestr(epar->v.name);
            break;
#endif

        case NUM:
        case CHAN:
        case ARG:
        case TICK:
            break;

        default:
            for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
                epfree(ep);
            break;

    }

    efree((char *)epar);
}

                                /* the following used to be a switch */
#ifdef  FUNCTION
static double
eargument(ep)
EPNODE  *ep;
{
    return(argument(ep->v.chan));
}
#endif

static double
enumber(ep)
EPNODE  *ep;
{
    return(ep->v.num);
}

static double
euminus(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;

    return(-evalue(ep1));
}

#ifdef  INCHAN
static double
echannel(ep)
EPNODE  *ep;
{
    return(chanvalue(ep->v.chan));
}
#endif

static double
eadd(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;

    return(evalue(ep1) + evalue(ep1->sibling));
}

static double
esubtr(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;

    return(evalue(ep1) - evalue(ep1->sibling));
}

static double
emult(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;

    return(evalue(ep1) * evalue(ep1->sibling));
}

static double
edivi(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;
    double  d;

    d = evalue(ep1->sibling);
    if (d == 0.0) {
        wputs("Division by zero\n");
        errno = ERANGE;
        return(0.0);
    }
    return(evalue(ep1) / d);
}

static double
epow(ep)
EPNODE  *ep;
{
    register EPNODE  *ep1 = ep->v.kid;
    double  d;
    int  lasterrno;

    lasterrno = errno;
    errno = 0;
    d = pow(evalue(ep1), evalue(ep1->sibling));
#ifdef  IEEE
    if (!finite(d))
        errno = EDOM;
#endif
    if (errno) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

static double
ebotch(ep)
EPNODE  *ep;
{
    eputs("Bad expression!\n");
    quit(1);
}


EPNODE *
ekid(ep, n)                     /* return pointer to a node's nth kid */
register EPNODE  *ep;
register int  n;
{

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        if (--n < 0)
            break;

    return(ep);
}


int
nekids(ep)                      /* return # of kids for node ep */
register EPNODE  *ep;
{
    register int  n = 0;

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        n++;

    return(n);
}


initfile(fp, fn, ln)            /* prepare input file */
FILE  *fp;
char  *fn;
int  ln;
{
    static char  inpbuf[MAXLINE];

    infp = fp;
    linbuf = inpbuf;
    infile = fn;
    lineno = ln;
    linepos = 0;
    inpbuf[0] = '\0';
    scan();
}


initstr(s, fn, ln)              /* prepare input string */
char  *s;
char  *fn;
int  ln;
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


getscanpos(fnp, lnp, spp, fpp)  /* return current scan position */
char  **fnp;
int  *lnp;
char  **spp;
FILE  **fpp;
{
    if (fnp != NULL) *fnp = infile;
    if (lnp != NULL) *lnp = lineno;
    if (spp != NULL) *spp = linbuf+linepos;
    if (fpp != NULL) *fpp = infp;
}


int
scan()                          /* scan next character, return literal next */
{
    register int  lnext = 0;

    do {
        if (linbuf[linepos] == '\0')
            if (infp == NULL || fgets(linbuf, MAXLINE, infp) == NULL)
                nextc = EOF;
            else {
                nextc = linbuf[0];
                lineno++;
                linepos = 1;
            }
        else
            nextc = linbuf[linepos++];
        if (!lnext)
                lnext = nextc;
        if (nextc == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
    return(lnext);
}


char *
ltoa(l)                         /* convert long to ascii */
long  l;
{
    static char  buf[16];
    register char  *cp;
    int  neg = 0;

    if (l == 0)
        return("0");
    if (l < 0) {
        l = -l;
        neg++;
    }
    cp = buf + sizeof(buf);
    *--cp = '\0';
    while (l) {
        *--cp = l % 10 + '0';
        l /= 10;
    }
    if (neg)
        *--cp = '-';
    return(cp);
}


syntax(err)                     /* report syntax error and quit */
char  *err;
{
    register int  i;

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