src/common/calexpr.c

/* Copyright (c) 1998 Silicon Graphics, Inc. */

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

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

#include  <stdio.h>

#include  <ctype.h>

#include  <errno.h>

#include  <math.h>

#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

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

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

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

#ifdef  DCL_ATOF
extern double  atof();
#endif

int  nextc;                             /* lookahead character */

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

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


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

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


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

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


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


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

    switch (epar->type) {

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

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

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

    }

    efree((char *)epar);
}

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

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

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

    return(-evalue(ep1));
}

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

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

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

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

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

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

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

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

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

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

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

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


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

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

    return(ep);
}


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

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

    return(n);
}


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

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


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


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


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

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


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

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


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

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


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


#if  defined(VARIABLE) || defined(FUNCTION)
char *
getname()                       /* scan an identifier */
{
    static char  str[MAXWORD+1];
    register int  i, lnext;

    lnext = nextc;
    for (i = 0; i < MAXWORD && isid(lnext); i++, lnext = scan())
        str[i] = lnext;
    str[i] = '\0';
    while (isid(lnext))         /* skip rest of name */
        lnext = scan();

    return(str);
}
#endif


int
getinum()                       /* scan a positive integer */
{
    register int  n, lnext;

    n = 0;
    lnext = nextc;
    while (isdigit(lnext)) {
        n = n * 10 + lnext - '0';
        lnext = scan();
    }
    return(n);
}


double
getnum()                        /* scan a positive float */
{
    register int  i, lnext;
    char  str[MAXWORD+1];

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if (lnext == '.' && i < MAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        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());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE2()                         /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE3();
    while (nextc == '*' || nextc == '/') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE3()                         /* E3 -> E4 ^ E3 */
                                /*       E4 */
{
    register EPNODE  *ep1, *ep2;

    ep1 = getE4();
    if (nextc == '^') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
#ifdef  RCONST
        if (ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
#endif
        return(ep2);
    }
    return(ep1);
}


EPNODE *
getE4()                         /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    register EPNODE  *ep1, *ep2;

    if (nextc == '-') {
        scan();
        ep2 = getE5();
        if (ep2->type == NUM) {
                ep2->v.num = -ep2->v.num;
                return(ep2);
        }
        if (ep2->type == UMINUS) {      /* don't generate -(-E5) */
            efree((char *)ep2);
            return(ep2->v.kid);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


EPNODE *
getE5()                         /* E5 -> (E1) */
                                /*       VAR */
                                /*       NUM */
                                /*       $N */
                                /*       FUNC(E1,..) */
                                /*       ARG */
{
    int  i;
    char  *nam;
    register EPNODE  *ep1, *ep2;

    if (nextc == '(') {
        scan();
        ep1 = getE1();
        if (nextc != ')')
            syntax("')' expected");
        scan();
        return(ep1);
    }

#ifdef  INCHAN
    if (nextc == '$') {
        scan();
        ep1 = newnode();
        ep1->type = CHAN;
        ep1->v.chan = getinum();
        return(ep1);
    }
#endif

#if  defined(VARIABLE) || defined(FUNCTION)
    if (isalpha(nextc) || nextc == CNTXMARK) {
        nam = getname();
#if  defined(VARIABLE) && defined(FUNCTION)
        ep1 = NULL;
        if (curfunc != NULL)
            for (i = 1, ep2 = curfunc->v.kid->sibling;
                                ep2 != NULL; i++, ep2 = ep2->sibling)
                if (!strcmp(ep2->v.name, nam)) {
                    ep1 = newnode();
                    ep1->type = ARG;
                    ep1->v.chan = i;
                    break;
                }
        if (ep1 == NULL)
#endif
        {
            ep1 = newnode();
            ep1->type = VAR;
            ep1->v.ln = varinsert(nam);
        }
#ifdef  FUNCTION
        if (nextc == '(') {
            ep2 = newnode();
            ep2->type = FUNC;
            addekid(ep2, ep1);
            ep1 = ep2;
            do {
                scan();
                addekid(ep1, getE1());
            } while (nextc == ',');
            if (nextc != ')')
                syntax("')' expected");
            scan();
        }
#ifndef  VARIABLE
        else
            syntax("'(' expected");
#endif
#endif
#ifdef  RCONST
        if (isconstvar(ep1))
            ep1 = rconst(ep1);
#endif
        return(ep1);
    }
#endif

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


#ifdef  RCONST
EPNODE *
rconst(epar)                    /* reduce a constant expression */
register EPNODE  *epar;
{
    register EPNODE  *ep;

    ep = newnode();
    ep->type = NUM;
    errno = 0;
    ep->v.num = evalue(epar);
    if (errno)
        syntax("bad constant expression");
    epfree(epar);
 
    return(ep);
}


isconstvar(ep)                  /* is ep linked to a constant expression? */
register EPNODE  *ep;
{
#ifdef  VARIABLE
    register EPNODE  *ep1;
#ifdef  FUNCTION

    if (ep->type == FUNC) {
        if (!isconstfun(ep->v.kid))
                return(0);
        for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
            if (ep1->type != NUM && !isconstfun(ep1))
                return(0);
        return(1);
    }
#endif
    if (ep->type != VAR)
        return(0);
    ep1 = ep->v.ln->def;
    if (ep1 == NULL || ep1->type != ':')
        return(0);
#ifdef  FUNCTION
    if (ep1->v.kid->type != SYM)
        return(0);
#endif
    return(1);
#else
    return(ep->type == FUNC);
#endif
}


#if  defined(FUNCTION) && defined(VARIABLE)
isconstfun(ep)                  /* is ep linked to a constant function? */
register EPNODE  *ep;
{
    register EPNODE  *dp;
    register LIBR  *lp;

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