src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.29 2004/03/28 20:33:12 schorsch 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 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 == 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 &&
                        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.30
Committed:	Tue May 17 17:51:51 2005 UTC (18 years, 11 months ago) by greg
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rad3R7P2, rad3R7P1
Changes since 2.29:	+6 -1 lines
Log Message:	Added "eofc" global for specifying an optional EOF character, such as '}'
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.30	static const char RCSid[] = "$Id: calexpr.c,v 2.29 2004/03/28 20:33:12 schorsch 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			case TICK:
149			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			case TICK:
189			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.6	#ifdef IEEE
298	greg	1.1	if (!finite(d))
299			errno = EDOM;
300			#endif
301	greg	2.20	if (errno == EDOM \|\| errno == ERANGE) {
302	greg	1.1	wputs("Illegal power\n");
303			return(0.0);
304			}
305			errno = lasterrno;
306			return(d);
307			}
308
309			static double
310	schorsch	2.28	ebotch(
311			EPNODE *ep
312			)
313	greg	1.1	{
314			eputs("Bad expression!\n");
315			quit(1);
316	schorsch	2.22	return 0.0; /* pro forma return */
317	greg	1.1	}
318
319
320			EPNODE *
321	schorsch	2.28	ekid( /* return pointer to a node's nth kid */
322			register EPNODE *ep,
323			register int n
324			)
325	greg	1.1	{
326
327			for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
328			if (--n < 0)
329			break;
330
331			return(ep);
332			}
333
334
335			int
336	schorsch	2.28	nekids( /* return # of kids for node ep */
337			register EPNODE *ep
338			)
339	greg	1.1	{
340			register int n = 0;
341
342			for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
343			n++;
344
345			return(n);
346			}
347
348
349	greg	2.18	void
350	schorsch	2.28	initfile( /* prepare input file */
351			FILE *fp,
352			char *fn,
353			int ln
354			)
355	greg	1.1	{
356	greg	2.6	static char inpbuf[MAXLINE];
357	greg	1.1
358			infp = fp;
359			linbuf = inpbuf;
360	greg	1.6	infile = fn;
361			lineno = ln;
362	greg	1.1	linepos = 0;
363			inpbuf[0] = '\0';
364			scan();
365			}
366
367
368	greg	2.18	void
369	schorsch	2.28	initstr( /* prepare input string */
370			char *s,
371			char *fn,
372			int ln
373			)
374	greg	1.1	{
375			infp = NULL;
376	greg	1.6	infile = fn;
377			lineno = ln;
378	greg	1.1	linbuf = s;
379			linepos = 0;
380			scan();
381			}
382
383
384	greg	2.18	void
385	schorsch	2.28	getscanpos( /* return current scan position */
386			char **fnp,
387			int *lnp,
388			char **spp,
389			FILE **fpp
390			)
391	greg	1.13	{
392			if (fnp != NULL) *fnp = infile;
393			if (lnp != NULL) *lnp = lineno;
394			if (spp != NULL) *spp = linbuf+linepos;
395			if (fpp != NULL) *fpp = infp;
396			}
397
398
399	greg	1.12	int
400	schorsch	2.28	scan(void) /* scan next character, return literal next */
401	greg	1.1	{
402	greg	1.12	register int lnext = 0;
403
404	greg	1.1	do {
405			if (linbuf[linepos] == '\0')
406			if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
407			nextc = EOF;
408			else {
409			nextc = linbuf[0];
410	greg	1.6	lineno++;
411	greg	1.1	linepos = 1;
412			}
413			else
414			nextc = linbuf[linepos++];
415	greg	1.12	if (!lnext)
416			lnext = nextc;
417	greg	2.30	if (nextc == eofc) {
418			nextc = EOF;
419			break;
420			}
421	greg	1.1	if (nextc == '{') {
422			scan();
423			while (nextc != '}')
424			if (nextc == EOF)
425			syntax("'}' expected");
426			else
427			scan();
428			scan();
429			}
430			} while (isspace(nextc));
431	greg	1.12	return(lnext);
432	greg	1.1	}
433
434
435	greg	1.6	char *
436	schorsch	2.28	long2ascii( /* convert long to ascii */
437			long l
438			)
439	greg	1.6	{
440	greg	2.6	static char buf[16];
441	greg	1.6	register char *cp;
442	greg	2.6	int neg = 0;
443	greg	1.6
444			if (l == 0)
445			return("0");
446			if (l < 0) {
447			l = -l;
448			neg++;
449			}
450			cp = buf + sizeof(buf);
451			*--cp = '\0';
452			while (l) {
453			*--cp = l % 10 + '0';
454			l /= 10;
455			}
456			if (neg)
457			*--cp = '-';
458			return(cp);
459			}
460
461
462	greg	2.18	void
463	schorsch	2.28	syntax( /* report syntax error and quit */
464			char *err
465			)
466	greg	1.1	{
467			register int i;
468
469	greg	1.6	if (infile != NULL \|\| lineno != 0) {
470			if (infile != NULL) eputs(infile);
471			if (lineno != 0) {
472			eputs(infile != NULL ? ", line " : "line ");
473	greg	2.9	eputs(long2ascii((long)lineno));
474	greg	1.6	}
475	greg	2.7	eputs(":\n");
476	greg	1.1	}
477	greg	1.7	eputs(linbuf);
478			if (linbuf[strlen(linbuf)-1] != '\n')
479			eputs("\n");
480			for (i = 0; i < linepos-1; i++)
481			eputs(linbuf[i] == '\t' ? "\t" : " ");
482			eputs("^ ");
483	greg	1.1	eputs(err);
484			eputs("\n");
485			quit(1);
486			}
487
488
489	greg	2.18	void
490	schorsch	2.28	addekid( /* add a child to ep */
491			register EPNODE *ep,
492			EPNODE *ekid
493			)
494	greg	1.1	{
495			if (ep->v.kid == NULL)
496			ep->v.kid = ekid;
497			else {
498			for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
499			;
500			ep->sibling = ekid;
501			}
502			ekid->sibling = NULL;
503			}
504
505
506			char *
507	schorsch	2.28	getname(void) /* scan an identifier */
508	greg	1.1	{
509	schorsch	2.23	static char str[RMAXWORD+1];
510	greg	1.12	register int i, lnext;
511	greg	1.1
512	greg	1.12	lnext = nextc;
513	schorsch	2.23	for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
514	greg	1.12	str[i] = lnext;
515	greg	1.1	str[i] = '\0';
516	greg	1.15	while (isid(lnext)) /* skip rest of name */
517			lnext = scan();
518	greg	1.1
519			return(str);
520			}
521
522
523			int
524	schorsch	2.28	getinum(void) /* scan a positive integer */
525	greg	1.1	{
526	greg	1.12	register int n, lnext;
527	greg	1.1
528			n = 0;
529	greg	1.12	lnext = nextc;
530			while (isdigit(lnext)) {
531			n = n * 10 + lnext - '0';
532			lnext = scan();
533	greg	1.1	}
534			return(n);
535			}
536
537
538			double
539	schorsch	2.28	getnum(void) /* scan a positive float */
540	greg	1.1	{
541	greg	1.12	register int i, lnext;
542	schorsch	2.23	char str[RMAXWORD+1];
543	greg	1.1
544			i = 0;
545	greg	1.12	lnext = nextc;
546	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
547	greg	1.12	str[i++] = lnext;
548			lnext = scan();
549	greg	1.1	}
550	schorsch	2.23	if (lnext == '.' && i < RMAXWORD) {
551	greg	2.6	str[i++] = lnext;
552			lnext = scan();
553	gwlarson	2.17	if (i == 1 && !isdigit(lnext))
554			syntax("badly formed number");
555	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
556	greg	1.12	str[i++] = lnext;
557			lnext = scan();
558	greg	1.1	}
559			}
560	schorsch	2.26	if ((lnext == 'e') \| (lnext == 'E') && i < RMAXWORD) {
561	greg	2.6	str[i++] = lnext;
562			lnext = scan();
563	schorsch	2.26	if ((lnext == '-') \| (lnext == '+') && i < RMAXWORD) {
564	greg	1.12	str[i++] = lnext;
565			lnext = scan();
566	greg	1.1	}
567	gwlarson	2.17	if (!isdigit(lnext))
568			syntax("missing exponent");
569	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
570	greg	1.12	str[i++] = lnext;
571			lnext = scan();
572	greg	1.1	}
573			}
574			str[i] = '\0';
575
576			return(atof(str));
577			}
578
579
580			EPNODE *
581	schorsch	2.28	getE1(void) /* E1 -> E1 ADDOP E2 */
582	greg	2.6	/* E2 */
583	greg	1.1	{
584			register EPNODE ep1, ep2;
585
586			ep1 = getE2();
587			while (nextc == '+' \|\| nextc == '-') {
588			ep2 = newnode();
589			ep2->type = nextc;
590			scan();
591			addekid(ep2, ep1);
592			addekid(ep2, getE2());
593	greg	2.18	if (esupport&E_RCONST &&
594			ep1->type == NUM && ep1->sibling->type == NUM)
595	greg	1.1	ep2 = rconst(ep2);
596			ep1 = ep2;
597			}
598			return(ep1);
599			}
600
601
602			EPNODE *
603	schorsch	2.28	getE2(void) /* E2 -> E2 MULOP E3 */
604	greg	2.6	/* E3 */
605	greg	1.1	{
606			register EPNODE ep1, ep2;
607
608			ep1 = getE3();
609			while (nextc == '*' \|\| nextc == '/') {
610			ep2 = newnode();
611			ep2->type = nextc;
612			scan();
613			addekid(ep2, ep1);
614			addekid(ep2, getE3());
615	greg	2.18	if (esupport&E_RCONST &&
616			ep1->type == NUM && ep1->sibling->type == NUM)
617	greg	1.1	ep2 = rconst(ep2);
618			ep1 = ep2;
619			}
620			return(ep1);
621			}
622
623
624			EPNODE *
625	schorsch	2.28	getE3(void) /* E3 -> E4 ^ E3 */
626	greg	2.6	/* E4 */
627	greg	1.1	{
628			register EPNODE ep1, ep2;
629
630			ep1 = getE4();
631	greg	1.8	if (nextc == '^') {
632	greg	1.1	ep2 = newnode();
633			ep2->type = nextc;
634			scan();
635			addekid(ep2, ep1);
636	greg	1.8	addekid(ep2, getE3());
637	greg	2.18	if (esupport&E_RCONST &&
638			ep1->type == NUM && ep1->sibling->type == NUM)
639	greg	1.1	ep2 = rconst(ep2);
640	greg	1.8	return(ep2);
641	greg	1.1	}
642			return(ep1);
643			}
644
645
646			EPNODE *
647	schorsch	2.28	getE4(void) /* E4 -> ADDOP E5 */
648	greg	2.6	/* E5 */
649	greg	1.1	{
650	greg	1.3	register EPNODE ep1, ep2;
651	greg	1.1
652			if (nextc == '-') {
653			scan();
654	greg	1.3	ep2 = getE5();
655			if (ep2->type == NUM) {
656			ep2->v.num = -ep2->v.num;
657			return(ep2);
658			}
659	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
660			efree((char *)ep2);
661			return(ep2->v.kid);
662			}
663	greg	1.1	ep1 = newnode();
664			ep1->type = UMINUS;
665	greg	1.3	addekid(ep1, ep2);
666	greg	1.1	return(ep1);
667			}
668			if (nextc == '+')
669			scan();
670			return(getE5());
671			}
672
673
674			EPNODE *
675	schorsch	2.28	getE5(void) /* E5 -> (E1) */
676	greg	2.6	/* VAR */
677			/* NUM */
678			/* $N */
679			/* FUNC(E1,..) */
680			/* ARG */
681	greg	1.1	{
682	schorsch	2.22	int i;
683			char *nam;
684			register EPNODE ep1, ep2;
685	greg	1.1
686	schorsch	2.22	if (nextc == '(') {
687			scan();
688			ep1 = getE1();
689			if (nextc != ')')
690			syntax("')' expected");
691			scan();
692			return(ep1);
693			}
694	greg	1.1
695	schorsch	2.22	if (esupport&E_INCHAN && nextc == '$') {
696			scan();
697			ep1 = newnode();
698			ep1->type = CHAN;
699			ep1->v.chan = getinum();
700			return(ep1);
701			}
702	greg	1.1
703	schorsch	2.22	if (esupport&(E_VARIABLE\|E_FUNCTION) &&
704			(isalpha(nextc) \|\| nextc == CNTXMARK)) {
705			nam = getname();
706			ep1 = NULL;
707			if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
708			&& curfunc != NULL)
709			for (i = 1, ep2 = curfunc->v.kid->sibling;
710			ep2 != NULL; i++, ep2 = ep2->sibling)
711			if (!strcmp(ep2->v.name, nam)) {
712			ep1 = newnode();
713			ep1->type = ARG;
714			ep1->v.chan = i;
715			break;
716			}
717			if (ep1 == NULL) {
718			ep1 = newnode();
719			ep1->type = VAR;
720			ep1->v.ln = varinsert(nam);
721	greg	1.1	}
722	schorsch	2.22	if (esupport&E_FUNCTION && nextc == '(') {
723			ep2 = newnode();
724			ep2->type = FUNC;
725			addekid(ep2, ep1);
726			ep1 = ep2;
727			do {
728			scan();
729			addekid(ep1, getE1());
730			} while (nextc == ',');
731			if (nextc != ')')
732			syntax("')' expected");
733			scan();
734			} else if (!(esupport&E_VARIABLE))
735			syntax("'(' expected");
736			if (esupport&E_RCONST && isconstvar(ep1))
737			ep1 = rconst(ep1);
738			return(ep1);
739			}
740	greg	1.1
741	schorsch	2.22	if (isdecimal(nextc)) {
742			ep1 = newnode();
743			ep1->type = NUM;
744			ep1->v.num = getnum();
745			return(ep1);
746			}
747			syntax("unexpected character");
748			return NULL; /* pro forma return */
749	greg	1.1	}
750
751
752			EPNODE *
753	schorsch	2.28	rconst( /* reduce a constant expression */
754			register EPNODE *epar
755			)
756	greg	1.1	{
757			register EPNODE *ep;
758
759			ep = newnode();
760			ep->type = NUM;
761			errno = 0;
762			ep->v.num = evalue(epar);
763	greg	2.20	if (errno == EDOM \|\| errno == ERANGE)
764	greg	2.6	syntax("bad constant expression");
765	greg	1.1	epfree(epar);
766
767			return(ep);
768	greg	1.9	}
769
770
771	greg	2.18	int
772	schorsch	2.28	isconstvar( /* is ep linked to a constant expression? */
773			register EPNODE *ep
774			)
775	greg	1.9	{
776			register EPNODE *ep1;
777	greg	1.10
778	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
779	greg	1.11	if (!isconstfun(ep->v.kid))
780			return(0);
781	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
782	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
783	greg	1.9	return(0);
784			return(1);
785			}
786			if (ep->type != VAR)
787			return(0);
788			ep1 = ep->v.ln->def;
789			if (ep1 == NULL \|\| ep1->type != ':')
790			return(0);
791	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
792	greg	1.9	return(0);
793			return(1);
794	greg	1.1	}
795	greg	1.11
796
797	greg	2.18	int
798	schorsch	2.28	isconstfun( /* is ep linked to a constant function? */
799			register EPNODE *ep
800			)
801	greg	1.11	{
802			register EPNODE *dp;
803			register LIBR *lp;
804
805			if (ep->type != VAR)
806			return(0);
807	schorsch	2.25	if ((dp = ep->v.ln->def) != NULL) {
808	greg	2.18	if (dp->v.kid->type == FUNC)
809			return(dp->type == ':');
810			else
811			return(0); /* don't identify masked library functions */
812	schorsch	2.25	}
813	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
814	greg	2.3	return(lp->atyp == ':');
815			return(0);
816	greg	1.11	}