src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.27 2003/08/04 19:20:26 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  "rterror.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(EPNODE *), eargument(EPNODE *), enumber(EPNODE *);
static double  echannel(EPNODE *);
static double  eadd(EPNODE *), esubtr(EPNODE *),
               emult(EPNODE *), edivi(EPNODE *),
               epow(EPNODE *);
static double  ebotch(EPNODE *);

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

int  nextc;                             /* lookahead character */

double  (*eoper[])(EPNODE *) = {        /* 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(                 /* 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(                   /* evaluate an expression string */
    char  *expr
)
{
    register EPNODE  *ep;
    double  rval;

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


int
epcmp(                  /* compare two expressions for equivalence */
    register EPNODE  *ep1,
    register EPNODE  *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(                 /* 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(
    EPNODE      *ep
)
{
    return(argument(ep->v.chan));
}

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

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

    return(-evalue(ep1));
}

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

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

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

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

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

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

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

static double
edivi(
    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(
    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(
    EPNODE      *ep
)
{
    eputs("Bad expression!\n");
    quit(1);
        return 0.0; /* pro forma return */
}


EPNODE *
ekid(                   /* 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(                 /* 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(               /* 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(                /* prepare input string */
    char  *s,
    char  *fn,
    int  ln
)
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


void
getscanpos(     /* 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(void)              /* 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(                           /* 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(                 /* 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(                        /* 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(void)                   /* scan an identifier */
{
    static char  str[RMAXWORD+1];
    register int  i, lnext;

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

    return(str);
}


int
getinum(void)                   /* 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(void)                    /* scan a positive float */
{
    register int  i, lnext;
    char  str[RMAXWORD+1];

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if (lnext == '.' && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if (i == 1 && !isdigit(lnext))
            syntax("badly formed number");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    if ((lnext == 'e') | (lnext == 'E') && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if ((lnext == '-') | (lnext == '+') && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
        if (!isdigit(lnext))
            syntax("missing exponent");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    str[i] = '\0';

    return(atof(str));
}


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