src/common/calexpr.c

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