src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.55 2025/12/06 04:07:05 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);
    ecurfunc = NULL;
    ep = getE1();
    if (nextc != EOF)
        esyntax("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, *ep1;
    double      combined;

    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)) {
            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()! */
        }
    if (!(esupport & E_RCONST))
        return;
    ep1 = NULL;                 /* combine constants in sum/product */
    for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
        if (ep->type == NUM) {
            if (ep1 == NULL) combined = (ep1 = ep)->v.num;
            else if (epar->type == '+') combined += ep->v.num;
            else /* epar->type=='*' */ combined *= ep->v.num;
        }
    if (ep1 == NULL)
        return;
    ep1->v.num = combined;      /* assumes commutative property, also */
    while (ep1->sibling != NULL)
        if (ep1->sibling->type == NUM) {
            ep = ep1->sibling;
            ep1->sibling = ep->sibling;
            epar->nkids--;
            efree(ep);          /* drop subsumed constant */
        } else
            ep1 = ep1->sibling;

    if (epar->nkids == 1) {     /* late constant expression? */
        ep = epar->v.kid;
        *epar = *ep;
        efree(ep);
    }
}


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';
    escan();
}


void
initstr(                /* prepare input string */
    char  *s,
    char  *fn,
    int  ln
)
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    escan();
}


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
escan(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 == '{') {
            escan();
            while (nextc != '}')
                if (nextc == EOF)
                    esyntax("'}' expected");
                else
                    escan();
            escan();
        }
    } 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
esyntax(                        /* 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 = escan())
        str[i] = lnext;
    str[i] = '\0';
    while (isid(lnext))         /* skip rest of name */
        lnext = escan();

    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 = escan();
    }
    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 = escan();
    }
    if ((lnext == '.') & (i < RMAXWORD)) {
        str[i++] = lnext;
        lnext = escan();
        if (i == 1 && !isdigit(lnext))
            esyntax("badly formed number");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = escan();
        }
    }
    if ((lnext == 'e') | (lnext == 'E') && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = escan();
        if ((lnext == '-') | (lnext == '+') && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = escan();
        }
        if (!isdigit(lnext))
            esyntax("missing exponent");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = escan();
        }
    }
    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;
        escan();
        addekid(ep2, ep1);
        addekid(ep2, getE2());
        if (esupport&E_RCONST && ep1->sibling->type == NUM) {
            if (ep1->type == NUM) {
                ep2 = rconst(ep2);
            } else if (ep2->type == '-') {
                ep1->sibling->v.num *= -1;
                ep2->type = '+';        /* associative&commutative */
            }
        }
        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;
        escan();
        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)
                        esyntax("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;
        escan();
        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 == '-') {
        escan();
        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 == '+')
        escan();
    return(getE5());
}


EPNODE *
getE5(void)                     /* E5 -> (E1) */
                                /*       VAR */
                                /*       NUM */
                                /*       $N */
                                /*       FUNC(E1,..) */
                                /*       ARG */
{
        int      i;
        char  *nam;
        EPNODE  *ep1, *ep2;

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