src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.53 2025/12/06 02:32:21 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 ((epar->nkids <= 2) | !(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;      /* drop following constants */
    while (ep1->sibling != NULL)
        if (ep1->sibling->type == NUM) {
            ep = ep1->sibling;
            ep1->sibling = ep->sibling;
            efree(ep);
        } else
            ep1 = ep1->sibling;
}


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