src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.49 2024/02/26 18:16:35 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  <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) == '.'))

#define  envalue(ep)    ((ep)->type==NUM ? (ep)->v.num : evalue(ep))

static double  euminus(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
)
{
    int  prev_support = esupport;
    EPNODE  *ep;
    double  rval;

    esupport &= ~E_RCONST;      /* don't bother reducing constant expr */
    ep = eparse(expr);
    esupport = prev_support;    /* as you were */
    rval = evalue(ep);
    epfree(ep,1);
    return(rval);
}


int
epcmp(                  /* compare two expressions for equivalence */
    EPNODE  *ep1,
    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 */
    EPNODE       *epar,
    int         frep
)
{
    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:
            if (epar->nkids < 0) {
                ep = epar->v.kid - epar->nkids;
                while (ep > epar->v.kid)
                        epfree(--ep, 0);
                efree(ep);      /* free array space */
            } else
                while ((ep = epar->v.kid) != NULL) {
                    epar->v.kid = ep->sibling;
                    epfree(ep, 1);
                }
            break;

    }
    if (frep)
        efree(epar);
    else
        memset(epar, 0, sizeof(EPNODE));
}


static void
epflatten(                      /* flatten hierarchies for '+', '*' */
        EPNODE *epar
)
{
    EPNODE      *ep;

    if (epar->nkids < 0)        /* can't handle array allocations */
        return;

    for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
        while (ep->type == epar->type && ep->nkids > 0) {
            EPNODE      *ep1 = ep->v.kid;
            while (ep1->sibling != NULL)
                ep1 = ep1->sibling;
            ep1->sibling = ep->sibling;
            epar->nkids += ep->nkids - 1;
            ep1 = ep->v.kid;
            *ep = *ep1;
            efree(ep1);         /* not epfree()! */
        }
}


void
epoptimize(                     /* flatten operations, lists -> arrays */
        EPNODE  *epar
)
{
    EPNODE      *ep;

    if ((epar->type == '+') | (epar->type == '*'))
        epflatten(epar);        /* flatten associative operations */

    if (epar->nkids)            /* do children if any */
        for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
            epoptimize(ep);

    if (epar->nkids > 4) {      /* make list into array if > 4 kids */
        int     n = 1;
        epar->v.kid = (EPNODE *)erealloc(epar->v.kid,
                                        sizeof(EPNODE)*epar->nkids);
        while (n < epar->nkids) {
            ep = epar->v.kid[n-1].sibling;
            epar->v.kid[n] = *ep;
            efree(ep);          /* not epfree()! */
            epar->v.kid[n-1].sibling = epar->v.kid + n;
            n++;
        }
        epar->nkids = -n;
    }
}

                                /* the following used to be a switch */
static double
enumber(
    EPNODE      *ep
)
{
    return(ep->v.num);
}

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

    return(-evalue(ep1));
}

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

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

    do
        sum += envalue(ep1);
    while ((ep1 = ep1->sibling) != NULL);

    return(sum);
}

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

    return(envalue(ep1) - envalue(ep2));
}

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

    do
        prod *= envalue(ep1);
    while ((ep1 = ep1->sibling) != NULL);

    return(prod);
}

static double
edivi(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;
    double  den = evalue(ep1->sibling);

    if (den == 0.0) {
        wputs("Division by zero\n");
        errno = ERANGE;
        return(0.0);
    }
    return(envalue(ep1) / den);
}

static double
epow(
    EPNODE      *ep
)
{
    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 */
    EPNODE       *ep,
    int  n
)
{
    if (ep->nkids < 0) {        /* allocated array? */
        if (n >= -ep->nkids)
            return(NULL);
        return(ep->v.kid + n);
    }
    ep = ep->v.kid;             /* else get from list */
    while (n-- > 0)
        if ((ep = ep->sibling) == NULL)
                break;
    return(ep);
}


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 */
{
    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];
    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
)
{
    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 */
    EPNODE       *ep,
    EPNODE      *ek
)
{
    if (ep->nkids < 0) {
        eputs("Cannot add kid to EPNODE array\n");
        quit(1);
    }
    ep->nkids++;
    if (ep->v.kid == NULL)
        ep->v.kid = ek;
    else {
        for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
            ;
        ep->sibling = ek;
    }
    ek->sibling = NULL;         /* shouldn't be necessary */
}


char *
getname(void)                   /* scan an identifier */
{
    static char  str[RMAXWORD+1];
    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 */
{
    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 */
{
    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 */
{
    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 */
{
    EPNODE  *ep1, *ep2;

    ep1 = getE3();
    while ((nextc == '*') | (nextc == '/')) {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST) {
                EPNODE  *ep3 = ep1->sibling;
                if ((ep1->type == NUM) & (ep3->type == NUM)) {
                        ep2 = rconst(ep2);
                } else if (ep3->type == NUM) {
                        if (ep2->type == '/') {
                                if (ep3->v.num == 0)
                                        syntax("divide by zero constant");
                                ep2->type = '*';        /* for speed */
                                ep3->v.num = 1./ep3->v.num;
                        } else if (ep3->v.num == 0) {
                                ep1->sibling = NULL;    /* (E2 * 0) */
                                epfree(ep2,1);
                                ep2 = ep3;
                        }
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3,1);          /* (0 * E3) or (0 / E3) */
                        ep1->sibling = NULL;
                        efree(ep2);
                        ep2 = ep1;
                }
        }
        ep1 = ep2;
    }
    return(ep1);
}


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

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


EPNODE *
getE4(void)                     /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    EPNODE  *ep1, *ep2;

    if (nextc == '-') {
        scan();
        ep2 = getE5();
        if (ep2->type == NUM) {
                ep2->v.num = -ep2->v.num;
                return(ep2);
        }
        if (ep2->type == UMINUS) {      /* don't generate -(-E5) */
            ep1 = ep2->v.kid;
            efree(ep2);
            return(ep1);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


EPNODE *
getE5(void)                     /* E5 -> (E1) */
                                /*       VAR */
                                /*       NUM */
                                /*       $N */
                                /*       FUNC(E1,..) */
                                /*       ARG */
{
        int      i;
        char  *nam;
        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 */
    EPNODE       *epar
)
{
    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,1);
 
    return(ep);
}


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