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

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