src/common/calexpr.c

/* Copyright (c) 1991 Regents of the University of California */

#ifndef lint
static char SCCSid[] = "$SunId$ LBL";
#endif

/*
 *  Compute data values using expression parser
 *
 *  7/1/85  Greg Ward
 *
 *  11/11/85  Made channel input conditional with (INCHAN) compiles.
 *
 *  4/2/86  Added conditional compiles for function definitions (FUNCTION).
 *
 *  1/29/87  Made variables conditional (VARIABLE)
 *
 *  5/19/88  Added constant subexpression elimination (RCONST)
 */

#include  <stdio.h>

#include  <ctype.h>

#include  <errno.h>

#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

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

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

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

int  nextc;                             /* lookahead character */

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

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


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

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


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

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


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

    switch (epar->type) {

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

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

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

    }

    efree((char *)epar);
}

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

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

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

    return(-evalue(ep1));
}

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

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

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

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

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

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

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

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

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

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

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

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


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

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

    return(ep);
}


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

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

    return(n);
}


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

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


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


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


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

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


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

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


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

    if (infile != NULL || lineno != 0) {
        if (infile != NULL) eputs(infile);
        if (lineno != 0) {
            eputs(infile != NULL ? ", line " : "line ");
            eputs(ltoa((long)lineno));
        }
        eputs(": syntax error:\n");
    }
    eputs(linbuf);
    if (linbuf[strlen(linbuf)-1] != '\n')
        eputs("\n");
    for (i = 0; i < linepos-1; i++)
        eputs(linbuf[i] == '\t' ? "\t" : " ");
    eputs("^ ");
    eputs(err);
    eputs("\n");
    quit(1);
}


addekid(ep, ekid)                       /* add a child to ep */
register EPNODE  *ep;
EPNODE  *ekid;
{
    if (ep->v.kid == NULL)
        ep->v.kid = ekid;
    else {
        for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
            ;
        ep->sibling = ekid;
    }
    ekid->sibling = NULL;
}


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


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