src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.21 2003/06/02 18:13:54 greg Exp $";
#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  <string.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);
        return 0.0; /* pro forma return */
}


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");
        return NULL; /* pro forma return */
}


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