src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id$";
#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)
 *
 *  2/19/03     Eliminated conditional compiles in favor of esupport extern.
 */

#include "copyright.h"

#include  <stdio.h>

#include  <ctype.h>

#include  <errno.h>

#include  <math.h>

#include  <stdlib.h>

#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

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

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

static double  euminus(), eargument(), enumber();
static double  echannel();
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();

unsigned int  esupport =                /* what to support */
                E_VARIABLE | E_FUNCTION ;

int  nextc;                             /* lookahead character */

double  (*eoper[])() = {                /* expression operations */
        ebotch,
        evariable,
        enumber,
        euminus,
        echannel,
        efunc,
        eargument,
        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);
    curfunc = NULL;
    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);
}


int
epcmp(ep1, ep2)                 /* compare two expressions for equivalence */
register EPNODE  *ep1, *ep2;
{
        double  d;

        if (ep1->type != ep2->type)
                return(1);

        switch (ep1->type) {

        case VAR:
                return(ep1->v.ln != ep2->v.ln);

        case NUM:
                if (ep2->v.num == 0)
                        return(ep1->v.num != 0);
                d = ep1->v.num / ep2->v.num;
                return(d > 1.000000000001 | d < 0.999999999999);

        case CHAN:
        case ARG:
                return(ep1->v.chan != ep2->v.chan);

        case '=':
        case ':':
                return(epcmp(ep1->v.kid->sibling, ep2->v.kid->sibling));

        case TICK:
        case SYM:                       /* should never get this one */
                return(0);

        default:
                ep1 = ep1->v.kid;
                ep2 = ep2->v.kid;
                while (ep1 != NULL) {
                        if (ep2 == NULL)
                                return(1);
                        if (epcmp(ep1, ep2))
                                return(1);
                        ep1 = ep1->sibling;
                        ep2 = ep2->sibling;
                }
                return(ep2 != NULL);
        }
}


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

    switch (epar->type) {

        case VAR:
            varfree(epar->v.ln);
            break;
            
        case SYM:
            freestr(epar->v.name);
            break;

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

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

    }

    efree((char *)epar);
}

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

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

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

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 == EDOM || errno == ERANGE) {
        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);
}


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


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


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


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

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


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

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


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

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


void
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();
        if (i == 1 && !isdigit(lnext))
            syntax("badly formed number");
        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();
        }
        if (!isdigit(lnext))
            syntax("missing exponent");
        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());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        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());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        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());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        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);
    }

    if (esupport&E_INCHAN && nextc == '$') {
        scan();
        ep1 = newnode();
        ep1->type = CHAN;
        ep1->v.chan = getinum();
        return(ep1);
    }

  if (esupport&(E_VARIABLE|E_FUNCTION) &&
                (isalpha(nextc) || nextc == CNTXMARK)) {
      nam = getname();
      ep1 = NULL;
      if ((esupport&(E_VARIABLE|E_FUNCTION)) == (E_VARIABLE|E_FUNCTION)
                        && 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) {
            ep1 = newnode();
            ep1->type = VAR;
            ep1->v.ln = varinsert(nam);
        }
        if (esupport&E_FUNCTION && nextc == '(') {
            ep2 = newnode();
            ep2->type = FUNC;
            addekid(ep2, ep1);
            ep1 = ep2;
            do {
                scan();
                addekid(ep1, getE1());
            } while (nextc == ',');
            if (nextc != ')')
                syntax("')' expected");
            scan();
        } else if (!(esupport&E_VARIABLE))
            syntax("'(' expected");
        if (esupport&E_RCONST && isconstvar(ep1))
            ep1 = rconst(ep1);
        return(ep1);
    }

    if (isdecimal(nextc)) {
        ep1 = newnode();
        ep1->type = NUM;
        ep1->v.num = getnum();
        return(ep1);
    }
    syntax("unexpected character");
}


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 == EDOM || errno == ERANGE)
        syntax("bad constant expression");
    epfree(epar);
 
    return(ep);
}


int
isconstvar(ep)                  /* is ep linked to a constant expression? */
register EPNODE  *ep;
{
    register EPNODE  *ep1;

    if (esupport&E_FUNCTION && 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);
    }
    if (ep->type != VAR)
        return(0);
    ep1 = ep->v.ln->def;
    if (ep1 == NULL || ep1->type != ':')
        return(0);
    if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
        return(0);
    return(1);
}


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