src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.33 2009/06/14 18:21:58 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  "rtmisc.h"
#include  "rtio.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  eofc = 0;                          /* optional end-of-file character */
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 CLKT:
        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 CLKT:
            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  isnan
    if (errno == 0)
        if (isnan(d))
            errno = EDOM;
        else if (isinf(d))
            errno = ERANGE;
#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 == eofc) {
                nextc = EOF;
                break;
        }
        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) {
                EPNODE  *ep3 = ep1->sibling;
                if (ep1->type == NUM && ep3->type == NUM) {
                        ep2 = rconst(ep2);
                } else if (ep3->type == NUM && ep3->v.num == 0) {
                        if (ep2->type == '/')
                                syntax("divide by zero constant");
                        ep1->sibling = NULL;    /* (E2 * 0) */
                        epfree(ep2);
                        ep2 = ep3;
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3);            /* (0 * E3) or (0 / E3) */
                        ep1->sibling = NULL;
                        efree((char *)ep2);
                        ep2 = ep1;
                }
        }
        ep1 = ep2;
    }
    return(ep1);
}


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

        ep1 = getE4();
        if (nextc != '^')
                return(ep1);
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST) {
                EPNODE  *ep3 = ep1->sibling;
                if (ep1->type == NUM && ep3->type == NUM) {
                        ep2 = rconst(ep2);
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3);            /* (0 ^ E3) */
                        ep1->sibling = NULL;
                        efree((char *)ep2);
                        ep2 = ep1;
                } else if ((ep3->type == NUM && ep3->v.num == 0) ||
                                (ep1->type == NUM && ep1->v.num == 1)) {
                        epfree(ep2);            /* (E4 ^ 0) or (1 ^ E3) */
                        ep2 = newnode();
                        ep2->type = NUM;
                        ep2->v.num = 1;
                }
        }
        return(ep2);
}


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