src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.45 2024/02/24 19:11:45 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 *), 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
)
{
    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);
}


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

    if (epar->nkids < 0)        /* we don't really handle this properly */
        epar->nkids *= -1;

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


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

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

    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
eargument(
    EPNODE      *ep
)
{
    return(argument(ep->v.chan));
}

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;
    EPNODE  *ep2 = ep1->sibling;
    double  d;

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

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)          /* we don't really handle this properly */
        ep->nkids *= -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,1);          /* (E4 ^ 0) or (1 ^ E3) */
                        ep2 = newnode();
                        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.46
Committed:	Sat Feb 24 19:26:44 2024 UTC (2 months, 3 weeks ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.45:	+2 -2 lines
Log Message:	perf: Minor optimization
#	Content
1	#ifndef lint
2	static const char RCSid[] = "$Id: calexpr.c,v 2.45 2024/02/24 19:11:45 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 ), 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
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	}
212
213
214	static void
215	epflatten( /* flatten hierarchies for '+', '' /
216	EPNODE *epar
217	)
218	{
219	EPNODE *ep;
220
221	if (epar->nkids < 0) /* we don't really handle this properly */
222	epar->nkids *= -1;
223
224	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
225	while (ep->type == epar->type) {
226	EPNODE *ep1 = ep->v.kid;
227	while (ep1->sibling != NULL)
228	ep1 = ep1->sibling;
229	ep1->sibling = ep->sibling;
230	epar->nkids += nekids(ep) - 1;
231	ep1 = ep->v.kid;
232	ep = ep1;
233	efree(ep1); /* not epfree()! */
234	}
235	}
236
237
238	void
239	epoptimize( /* flatten operations and lists -> arrays */
240	EPNODE *epar
241	)
242	{
243	EPNODE *ep;
244
245	if ((epar->type == '+') \| (epar->type == '*'))
246	epflatten(epar); /* commutative & associative */
247
248	if (epar->nkids) /* do children if any */
249	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
250	epoptimize(ep);
251
252	if (epar->nkids > 4) { /* make list into array if > 4 kids */
253	int n = 1;
254	epar->v.kid = (EPNODE *)erealloc(epar->v.kid,
255	sizeof(EPNODE)*epar->nkids);
256	while (n < epar->nkids) {
257	ep = epar->v.kid[n-1].sibling;
258	epar->v.kid[n] = *ep;
259	efree(ep); /* not epfree()! */
260	epar->v.kid[n-1].sibling = epar->v.kid + n;
261	n++;
262	}
263	epar->nkids = -n;
264	}
265	}
266
267	/* the following used to be a switch */
268	static double
269	eargument(
270	EPNODE *ep
271	)
272	{
273	return(argument(ep->v.chan));
274	}
275
276	static double
277	enumber(
278	EPNODE *ep
279	)
280	{
281	return(ep->v.num);
282	}
283
284	static double
285	euminus(
286	EPNODE *ep
287	)
288	{
289	EPNODE *ep1 = ep->v.kid;
290
291	return(-evalue(ep1));
292	}
293
294	static double
295	echannel(
296	EPNODE *ep
297	)
298	{
299	return(chanvalue(ep->v.chan));
300	}
301
302	static double
303	eadd(
304	EPNODE *ep
305	)
306	{
307	double sum = 0;
308	EPNODE *ep1 = ep->v.kid;
309
310	do
311	sum += envalue(ep1);
312	while ((ep1 = ep1->sibling) != NULL);
313
314	return(sum);
315	}
316
317	static double
318	esubtr(
319	EPNODE *ep
320	)
321	{
322	EPNODE *ep1 = ep->v.kid;
323	EPNODE *ep2 = ep1->sibling;
324
325	return(envalue(ep1) - envalue(ep2));
326	}
327
328	static double
329	emult(
330	EPNODE *ep
331	)
332	{
333	double prod = 1;
334	EPNODE *ep1 = ep->v.kid;
335
336	do
337	prod *= envalue(ep1);
338	while ((ep1 = ep1->sibling) != NULL);
339
340	return(prod);
341	}
342
343	static double
344	edivi(
345	EPNODE *ep
346	)
347	{
348	EPNODE *ep1 = ep->v.kid;
349	EPNODE *ep2 = ep1->sibling;
350	double d;
351
352	d = evalue(ep2);
353	if (d == 0.0) {
354	wputs("Division by zero\n");
355	errno = ERANGE;
356	return(0.0);
357	}
358	return(envalue(ep1) / d);
359	}
360
361	static double
362	epow(
363	EPNODE *ep
364	)
365	{
366	EPNODE *ep1 = ep->v.kid;
367	double d;
368	int lasterrno;
369
370	lasterrno = errno;
371	errno = 0;
372	d = pow(evalue(ep1), evalue(ep1->sibling));
373	#ifdef isnan
374	if (errno == 0) {
375	if (isnan(d))
376	errno = EDOM;
377	else if (isinf(d))
378	errno = ERANGE;
379	}
380	#endif
381	if ((errno == EDOM) \| (errno == ERANGE)) {
382	wputs("Illegal power\n");
383	return(0.0);
384	}
385	errno = lasterrno;
386	return(d);
387	}
388
389	static double
390	ebotch(
391	EPNODE *ep
392	)
393	{
394	eputs("Bad expression!\n");
395	quit(1);
396	return 0.0; /* pro forma return */
397	}
398
399
400	EPNODE *
401	ekid( /* return pointer to a node's nth kid */
402	EPNODE *ep,
403	int n
404	)
405	{
406	if (ep->nkids < 0) { /* allocated array? */
407	if (n >= -ep->nkids)
408	return(NULL);
409	return(ep->v.kid + n);
410	}
411	ep = ep->v.kid; /* else get from list */
412	while (n-- > 0)
413	if ((ep = ep->sibling) == NULL)
414	break;
415	return(ep);
416	}
417
418
419	void
420	initfile( /* prepare input file */
421	FILE *fp,
422	char *fn,
423	int ln
424	)
425	{
426	static char inpbuf[MAXLINE];
427
428	infp = fp;
429	linbuf = inpbuf;
430	infile = fn;
431	lineno = ln;
432	linepos = 0;
433	inpbuf[0] = '\0';
434	scan();
435	}
436
437
438	void
439	initstr( /* prepare input string */
440	char *s,
441	char *fn,
442	int ln
443	)
444	{
445	infp = NULL;
446	infile = fn;
447	lineno = ln;
448	linbuf = s;
449	linepos = 0;
450	scan();
451	}
452
453
454	void
455	getscanpos( /* return current scan position */
456	char **fnp,
457	int *lnp,
458	char **spp,
459	FILE **fpp
460	)
461	{
462	if (fnp != NULL) *fnp = infile;
463	if (lnp != NULL) *lnp = lineno;
464	if (spp != NULL) *spp = linbuf+linepos;
465	if (fpp != NULL) *fpp = infp;
466	}
467
468
469	int
470	scan(void) /* scan next character, return literal next */
471	{
472	int lnext = 0;
473
474	do {
475	if (linbuf[linepos] == '\0')
476	if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
477	nextc = EOF;
478	else {
479	nextc = linbuf[0];
480	lineno++;
481	linepos = 1;
482	}
483	else
484	nextc = linbuf[linepos++];
485	if (!lnext)
486	lnext = nextc;
487	if (nextc == eofc) {
488	nextc = EOF;
489	break;
490	}
491	if (nextc == '{') {
492	scan();
493	while (nextc != '}')
494	if (nextc == EOF)
495	syntax("'}' expected");
496	else
497	scan();
498	scan();
499	}
500	} while (isspace(nextc));
501	return(lnext);
502	}
503
504
505	char *
506	long2ascii( /* convert long to ascii */
507	long l
508	)
509	{
510	static char buf[16];
511	char *cp;
512	int neg = 0;
513
514	if (l == 0)
515	return("0");
516	if (l < 0) {
517	l = -l;
518	neg++;
519	}
520	cp = buf + sizeof(buf);
521	*--cp = '\0';
522	while (l) {
523	*--cp = l % 10 + '0';
524	l /= 10;
525	}
526	if (neg)
527	*--cp = '-';
528	return(cp);
529	}
530
531
532	void
533	syntax( /* report syntax error and quit */
534	char *err
535	)
536	{
537	int i;
538
539	if ((infile != NULL) \| (lineno != 0)) {
540	if (infile != NULL) eputs(infile);
541	if (lineno != 0) {
542	eputs(infile != NULL ? ", line " : "line ");
543	eputs(long2ascii((long)lineno));
544	}
545	eputs(":\n");
546	}
547	eputs(linbuf);
548	if (linbuf[strlen(linbuf)-1] != '\n')
549	eputs("\n");
550	for (i = 0; i < linepos-1; i++)
551	eputs(linbuf[i] == '\t' ? "\t" : " ");
552	eputs("^ ");
553	eputs(err);
554	eputs("\n");
555	quit(1);
556	}
557
558
559	void
560	addekid( /* add a child to ep */
561	EPNODE *ep,
562	EPNODE *ek
563	)
564	{
565	if (ep->nkids < 0) /* we don't really handle this properly */
566	ep->nkids *= -1;
567	ep->nkids++;
568	if (ep->v.kid == NULL)
569	ep->v.kid = ek;
570	else {
571	for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
572	;
573	ep->sibling = ek;
574	}
575	ek->sibling = NULL; /* shouldn't be necessary */
576	}
577
578
579	char *
580	getname(void) /* scan an identifier */
581	{
582	static char str[RMAXWORD+1];
583	int i, lnext;
584
585	lnext = nextc;
586	for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
587	str[i] = lnext;
588	str[i] = '\0';
589	while (isid(lnext)) /* skip rest of name */
590	lnext = scan();
591
592	return(str);
593	}
594
595
596	int
597	getinum(void) /* scan a positive integer */
598	{
599	int n, lnext;
600
601	n = 0;
602	lnext = nextc;
603	while (isdigit(lnext)) {
604	n = n * 10 + lnext - '0';
605	lnext = scan();
606	}
607	return(n);
608	}
609
610
611	double
612	getnum(void) /* scan a positive float */
613	{
614	int i, lnext;
615	char str[RMAXWORD+1];
616
617	i = 0;
618	lnext = nextc;
619	while (isdigit(lnext) && i < RMAXWORD) {
620	str[i++] = lnext;
621	lnext = scan();
622	}
623	if ((lnext == '.') & (i < RMAXWORD)) {
624	str[i++] = lnext;
625	lnext = scan();
626	if (i == 1 && !isdigit(lnext))
627	syntax("badly formed number");
628	while (isdigit(lnext) && i < RMAXWORD) {
629	str[i++] = lnext;
630	lnext = scan();
631	}
632	}
633	if ((lnext == 'e') \| (lnext == 'E') && i < RMAXWORD) {
634	str[i++] = lnext;
635	lnext = scan();
636	if ((lnext == '-') \| (lnext == '+') && i < RMAXWORD) {
637	str[i++] = lnext;
638	lnext = scan();
639	}
640	if (!isdigit(lnext))
641	syntax("missing exponent");
642	while (isdigit(lnext) && i < RMAXWORD) {
643	str[i++] = lnext;
644	lnext = scan();
645	}
646	}
647	str[i] = '\0';
648
649	return(atof(str));
650	}
651
652
653	EPNODE *
654	getE1(void) /* E1 -> E1 ADDOP E2 */
655	/* E2 */
656	{
657	EPNODE ep1, ep2;
658
659	ep1 = getE2();
660	while ((nextc == '+') \| (nextc == '-')) {
661	ep2 = newnode();
662	ep2->type = nextc;
663	scan();
664	addekid(ep2, ep1);
665	addekid(ep2, getE2());
666	if (esupport&E_RCONST &&
667	(ep1->type == NUM) & (ep1->sibling->type == NUM))
668	ep2 = rconst(ep2);
669	ep1 = ep2;
670	}
671	return(ep1);
672	}
673
674
675	EPNODE *
676	getE2(void) /* E2 -> E2 MULOP E3 */
677	/* E3 */
678	{
679	EPNODE ep1, ep2;
680
681	ep1 = getE3();
682	while ((nextc == '*') \| (nextc == '/')) {
683	ep2 = newnode();
684	ep2->type = nextc;
685	scan();
686	addekid(ep2, ep1);
687	addekid(ep2, getE3());
688	if (esupport&E_RCONST) {
689	EPNODE *ep3 = ep1->sibling;
690	if ((ep1->type == NUM) & (ep3->type == NUM)) {
691	ep2 = rconst(ep2);
692	} else if (ep3->type == NUM) {
693	if (ep2->type == '/') {
694	if (ep3->v.num == 0)
695	syntax("divide by zero constant");
696	ep2->type = ''; / for speed */
697	ep3->v.num = 1./ep3->v.num;
698	} else if (ep3->v.num == 0) {
699	ep1->sibling = NULL; /* (E2 * 0) */
700	epfree(ep2,1);
701	ep2 = ep3;
702	}
703	} else if (ep1->type == NUM && ep1->v.num == 0) {
704	epfree(ep3,1); /* (0 * E3) or (0 / E3) */
705	ep1->sibling = NULL;
706	efree(ep2);
707	ep2 = ep1;
708	}
709	}
710	ep1 = ep2;
711	}
712	return(ep1);
713	}
714
715
716	EPNODE *
717	getE3(void) /* E3 -> E4 ^ E3 */
718	/* E4 */
719	{
720	EPNODE ep1, ep2;
721
722	ep1 = getE4();
723	if (nextc != '^')
724	return(ep1);
725	ep2 = newnode();
726	ep2->type = nextc;
727	scan();
728	addekid(ep2, ep1);
729	addekid(ep2, getE3());
730	if (esupport&E_RCONST) {
731	EPNODE *ep3 = ep1->sibling;
732	if ((ep1->type == NUM) & (ep3->type == NUM)) {
733	ep2 = rconst(ep2);
734	} else if (ep1->type == NUM && ep1->v.num == 0) {
735	epfree(ep3,1); /* (0 ^ E3) */
736	ep1->sibling = NULL;
737	efree(ep2);
738	ep2 = ep1;
739	} else if ((ep3->type == NUM && ep3->v.num == 0) \|
740	(ep1->type == NUM && ep1->v.num == 1)) {
741	epfree(ep2,1); /* (E4 ^ 0) or (1 ^ E3) */
742	ep2 = newnode();
743	ep2->type = NUM;
744	ep2->v.num = 1;
745	} else if (ep3->type == NUM && ep3->v.num == 1) {
746	efree(ep3); /* (E4 ^ 1) */
747	ep1->sibling = NULL;
748	efree(ep2);
749	ep2 = ep1;
750	}
751	}
752	return(ep2);
753	}
754
755
756	EPNODE *
757	getE4(void) /* E4 -> ADDOP E5 */
758	/* E5 */
759	{
760	EPNODE ep1, ep2;
761
762	if (nextc == '-') {
763	scan();
764	ep2 = getE5();
765	if (ep2->type == NUM) {
766	ep2->v.num = -ep2->v.num;
767	return(ep2);
768	}
769	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
770	ep1 = ep2->v.kid;
771	efree(ep2);
772	return(ep1);
773	}
774	ep1 = newnode();
775	ep1->type = UMINUS;
776	addekid(ep1, ep2);
777	return(ep1);
778	}
779	if (nextc == '+')
780	scan();
781	return(getE5());
782	}
783
784
785	EPNODE *
786	getE5(void) /* E5 -> (E1) */
787	/* VAR */
788	/* NUM */
789	/* $N */
790	/* FUNC(E1,..) */
791	/* ARG */
792	{
793	int i;
794	char *nam;
795	EPNODE ep1, ep2;
796
797	if (nextc == '(') {
798	scan();
799	ep1 = getE1();
800	if (nextc != ')')
801	syntax("')' expected");
802	scan();
803	return(ep1);
804	}
805	if (esupport&E_INCHAN && nextc == '$') {
806	scan();
807	ep1 = newnode();
808	ep1->type = CHAN;
809	ep1->v.chan = getinum();
810	return(ep1);
811	}
812	if (esupport&(E_VARIABLE\|E_FUNCTION) &&
813	(isalpha(nextc) \| (nextc == CNTXMARK))) {
814	nam = getname();
815	ep1 = NULL;
816	if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
817	&& curfunc != NULL)
818	for (i = 1, ep2 = curfunc->v.kid->sibling;
819	ep2 != NULL; i++, ep2 = ep2->sibling)
820	if (!strcmp(ep2->v.name, nam)) {
821	ep1 = newnode();
822	ep1->type = ARG;
823	ep1->v.chan = i;
824	break;
825	}
826	if (ep1 == NULL) {
827	ep1 = newnode();
828	ep1->type = VAR;
829	ep1->v.ln = varinsert(nam);
830	}
831	if (esupport&E_FUNCTION && nextc == '(') {
832	ep2 = newnode();
833	ep2->type = FUNC;
834	addekid(ep2, ep1);
835	ep1 = ep2;
836	do {
837	scan();
838	addekid(ep1, getE1());
839	} while (nextc == ',');
840	if (nextc != ')')
841	syntax("')' expected");
842	scan();
843	} else if (!(esupport&E_VARIABLE))
844	syntax("'(' expected");
845	if (esupport&E_RCONST && isconstvar(ep1))
846	ep1 = rconst(ep1);
847	return(ep1);
848	}
849	if (isdecimal(nextc)) {
850	ep1 = newnode();
851	ep1->type = NUM;
852	ep1->v.num = getnum();
853	return(ep1);
854	}
855	syntax("unexpected character");
856	return NULL; /* pro forma return */
857	}
858
859
860	EPNODE *
861	rconst( /* reduce a constant expression */
862	EPNODE *epar
863	)
864	{
865	EPNODE *ep;
866
867	ep = newnode();
868	ep->type = NUM;
869	errno = 0;
870	ep->v.num = evalue(epar);
871	if ((errno == EDOM) \| (errno == ERANGE))
872	syntax("bad constant expression");
873	epfree(epar,1);
874
875	return(ep);
876	}
877
878
879	int
880	isconstvar( /* is ep linked to a constant expression? */
881	EPNODE *ep
882	)
883	{
884	EPNODE *ep1;
885
886	if (esupport&E_FUNCTION && ep->type == FUNC) {
887	if (!isconstfun(ep->v.kid))
888	return(0);
889	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
890	if (ep1->type != NUM && !isconstfun(ep1))
891	return(0);
892	return(1);
893	}
894	if (ep->type != VAR)
895	return(0);
896	ep1 = ep->v.ln->def;
897	if (ep1 == NULL \|\| ep1->type != ':')
898	return(0);
899	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
900	return(0);
901	return(1);
902	}
903
904
905	int
906	isconstfun( /* is ep linked to a constant function? */
907	EPNODE *ep
908	)
909	{
910	EPNODE *dp;
911	LIBR *lp;
912
913	if (ep->type != VAR)
914	return(0);
915	if ((dp = ep->v.ln->def) != NULL) {
916	if (dp->v.kid->type == FUNC)
917	return(dp->type == ':');
918	else
919	return(0); /* don't identify masked library functions */
920	}
921	if ((lp = ep->v.ln->lib) != NULL)
922	return(lp->atyp == ':');
923	return(0);
924	}