src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.31 2006/05/10 15:21:20 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 &&
                        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.32
Committed:	Thu May 1 16:42:05 2008 UTC (17 years, 6 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.31:	+3 -3 lines
Log Message:	Math library and warning fixes for Solaris
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.32	static const char RCSid[] = "$Id: calexpr.c,v 2.31 2006/05/10 15:21:20 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	schorsch	2.28	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	schorsch	2.28	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.18	if (esupport&E_RCONST &&
619			ep1->type == NUM && ep1->sibling->type == NUM)
620	greg	1.1	ep2 = rconst(ep2);
621			ep1 = ep2;
622			}
623			return(ep1);
624			}
625
626
627			EPNODE *
628	schorsch	2.28	getE3(void) /* E3 -> E4 ^ E3 */
629	greg	2.6	/* E4 */
630	greg	1.1	{
631			register EPNODE ep1, ep2;
632
633			ep1 = getE4();
634	greg	1.8	if (nextc == '^') {
635	greg	1.1	ep2 = newnode();
636			ep2->type = nextc;
637			scan();
638			addekid(ep2, ep1);
639	greg	1.8	addekid(ep2, getE3());
640	greg	2.18	if (esupport&E_RCONST &&
641			ep1->type == NUM && ep1->sibling->type == NUM)
642	greg	1.1	ep2 = rconst(ep2);
643	greg	1.8	return(ep2);
644	greg	1.1	}
645			return(ep1);
646			}
647
648
649			EPNODE *
650	schorsch	2.28	getE4(void) /* E4 -> ADDOP E5 */
651	greg	2.6	/* E5 */
652	greg	1.1	{
653	greg	1.3	register EPNODE ep1, ep2;
654	greg	1.1
655			if (nextc == '-') {
656			scan();
657	greg	1.3	ep2 = getE5();
658			if (ep2->type == NUM) {
659			ep2->v.num = -ep2->v.num;
660			return(ep2);
661			}
662	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
663			efree((char *)ep2);
664			return(ep2->v.kid);
665			}
666	greg	1.1	ep1 = newnode();
667			ep1->type = UMINUS;
668	greg	1.3	addekid(ep1, ep2);
669	greg	1.1	return(ep1);
670			}
671			if (nextc == '+')
672			scan();
673			return(getE5());
674			}
675
676
677			EPNODE *
678	schorsch	2.28	getE5(void) /* E5 -> (E1) */
679	greg	2.6	/* VAR */
680			/* NUM */
681			/* $N */
682			/* FUNC(E1,..) */
683			/* ARG */
684	greg	1.1	{
685	schorsch	2.22	int i;
686			char *nam;
687			register EPNODE ep1, ep2;
688	greg	1.1
689	schorsch	2.22	if (nextc == '(') {
690			scan();
691			ep1 = getE1();
692			if (nextc != ')')
693			syntax("')' expected");
694			scan();
695			return(ep1);
696			}
697	greg	1.1
698	schorsch	2.22	if (esupport&E_INCHAN && nextc == '$') {
699			scan();
700			ep1 = newnode();
701			ep1->type = CHAN;
702			ep1->v.chan = getinum();
703			return(ep1);
704			}
705	greg	1.1
706	schorsch	2.22	if (esupport&(E_VARIABLE\|E_FUNCTION) &&
707			(isalpha(nextc) \|\| nextc == CNTXMARK)) {
708			nam = getname();
709			ep1 = NULL;
710			if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
711			&& curfunc != NULL)
712			for (i = 1, ep2 = curfunc->v.kid->sibling;
713			ep2 != NULL; i++, ep2 = ep2->sibling)
714			if (!strcmp(ep2->v.name, nam)) {
715			ep1 = newnode();
716			ep1->type = ARG;
717			ep1->v.chan = i;
718			break;
719			}
720			if (ep1 == NULL) {
721			ep1 = newnode();
722			ep1->type = VAR;
723			ep1->v.ln = varinsert(nam);
724	greg	1.1	}
725	schorsch	2.22	if (esupport&E_FUNCTION && nextc == '(') {
726			ep2 = newnode();
727			ep2->type = FUNC;
728			addekid(ep2, ep1);
729			ep1 = ep2;
730			do {
731			scan();
732			addekid(ep1, getE1());
733			} while (nextc == ',');
734			if (nextc != ')')
735			syntax("')' expected");
736			scan();
737			} else if (!(esupport&E_VARIABLE))
738			syntax("'(' expected");
739			if (esupport&E_RCONST && isconstvar(ep1))
740			ep1 = rconst(ep1);
741			return(ep1);
742			}
743	greg	1.1
744	schorsch	2.22	if (isdecimal(nextc)) {
745			ep1 = newnode();
746			ep1->type = NUM;
747			ep1->v.num = getnum();
748			return(ep1);
749			}
750			syntax("unexpected character");
751			return NULL; /* pro forma return */
752	greg	1.1	}
753
754
755			EPNODE *
756	schorsch	2.28	rconst( /* reduce a constant expression */
757			register EPNODE *epar
758			)
759	greg	1.1	{
760			register EPNODE *ep;
761
762			ep = newnode();
763			ep->type = NUM;
764			errno = 0;
765			ep->v.num = evalue(epar);
766	greg	2.20	if (errno == EDOM \|\| errno == ERANGE)
767	greg	2.6	syntax("bad constant expression");
768	greg	1.1	epfree(epar);
769
770			return(ep);
771	greg	1.9	}
772
773
774	greg	2.18	int
775	schorsch	2.28	isconstvar( /* is ep linked to a constant expression? */
776			register EPNODE *ep
777			)
778	greg	1.9	{
779			register EPNODE *ep1;
780	greg	1.10
781	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
782	greg	1.11	if (!isconstfun(ep->v.kid))
783			return(0);
784	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
785	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
786	greg	1.9	return(0);
787			return(1);
788			}
789			if (ep->type != VAR)
790			return(0);
791			ep1 = ep->v.ln->def;
792			if (ep1 == NULL \|\| ep1->type != ':')
793			return(0);
794	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
795	greg	1.9	return(0);
796			return(1);
797	greg	1.1	}
798	greg	1.11
799
800	greg	2.18	int
801	schorsch	2.28	isconstfun( /* is ep linked to a constant function? */
802			register EPNODE *ep
803			)
804	greg	1.11	{
805			register EPNODE *dp;
806			register LIBR *lp;
807
808			if (ep->type != VAR)
809			return(0);
810	schorsch	2.25	if ((dp = ep->v.ln->def) != NULL) {
811	greg	2.18	if (dp->v.kid->type == FUNC)
812			return(dp->type == ':');
813			else
814			return(0); /* don't identify masked library functions */
815	schorsch	2.25	}
816	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
817	greg	2.3	return(lp->atyp == ':');
818			return(0);
819	greg	1.11	}