src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id: calexpr.c,v 2.47 2024/02/25 04:11:10 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)        /* can't handle array allocations */
        return;

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


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

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

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

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

                                /* the following used to be a switch */
static double
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;
    double  den = evalue(ep1->sibling);

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

static double
epow(
    EPNODE      *ep
)
{
    EPNODE  *ep1 = ep->v.kid;
    double  d;
    int  lasterrno;

    lasterrno = errno;
    errno = 0;
    d = pow(evalue(ep1), evalue(ep1->sibling));
#ifdef  isnan
    if (errno == 0) {
        if (isnan(d))
            errno = EDOM;
        else if (isinf(d))
            errno = ERANGE;
    }
#endif
    if ((errno == EDOM) | (errno == ERANGE)) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

static double
ebotch(
    EPNODE      *ep
)
{
    eputs("Bad expression!\n");
    quit(1);
        return 0.0; /* pro forma return */
}


EPNODE *
ekid(                   /* return pointer to a node's nth kid */
    EPNODE       *ep,
    int  n
)
{
    if (ep->nkids < 0) {        /* allocated array? */
        if (n >= -ep->nkids)
            return(NULL);
        return(ep->v.kid + n);
    }
    ep = ep->v.kid;             /* else get from list */
    while (n-- > 0)
        if ((ep = ep->sibling) == NULL)
                break;
    return(ep);
}


void
initfile(               /* prepare input file */
    FILE  *fp,
    char  *fn,
    int  ln
)
{
    static char  inpbuf[MAXLINE];

    infp = fp;
    linbuf = inpbuf;
    infile = fn;
    lineno = ln;
    linepos = 0;
    inpbuf[0] = '\0';
    scan();
}


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


void
getscanpos(     /* return current scan position */
    char  **fnp,
    int  *lnp,
    char  **spp,
    FILE  **fpp
)
{
    if (fnp != NULL) *fnp = infile;
    if (lnp != NULL) *lnp = lineno;
    if (spp != NULL) *spp = linbuf+linepos;
    if (fpp != NULL) *fpp = infp;
}


int
scan(void)              /* scan next character, return literal next */
{
    int  lnext = 0;

    do {
        if (linbuf[linepos] == '\0')
            if (infp == NULL || fgets(linbuf, MAXLINE, infp) == NULL)
                nextc = EOF;
            else {
                nextc = linbuf[0];
                lineno++;
                linepos = 1;
            }
        else
            nextc = linbuf[linepos++];
        if (!lnext)
                lnext = nextc;
        if (nextc == eofc) {
                nextc = EOF;
                break;
        }
        if (nextc == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
    return(lnext);
}


char *
long2ascii(                           /* convert long to ascii */
    long  l
)
{
    static char  buf[16];
    char  *cp;
    int  neg = 0;

    if (l == 0)
        return("0");
    if (l < 0) {
        l = -l;
        neg++;
    }
    cp = buf + sizeof(buf);
    *--cp = '\0';
    while (l) {
        *--cp = l % 10 + '0';
        l /= 10;
    }
    if (neg)
        *--cp = '-';
    return(cp);
}


void
syntax(                 /* report syntax error and quit */
    char  *err
)
{
    int  i;

    if ((infile != NULL) | (lineno != 0)) {
        if (infile != NULL) eputs(infile);
        if (lineno != 0) {
            eputs(infile != NULL ? ", line " : "line ");
            eputs(long2ascii((long)lineno));
        }
        eputs(":\n");
    }
    eputs(linbuf);
    if (linbuf[strlen(linbuf)-1] != '\n')
        eputs("\n");
    for (i = 0; i < linepos-1; i++)
        eputs(linbuf[i] == '\t' ? "\t" : " ");
    eputs("^ ");
    eputs(err);
    eputs("\n");
    quit(1);
}


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


char *
getname(void)                   /* scan an identifier */
{
    static char  str[RMAXWORD+1];
    int  i, lnext;

    lnext = nextc;
    for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
        str[i] = lnext;
    str[i] = '\0';
    while (isid(lnext))         /* skip rest of name */
        lnext = scan();

    return(str);
}


int
getinum(void)                   /* scan a positive integer */
{
    int  n, lnext;

    n = 0;
    lnext = nextc;
    while (isdigit(lnext)) {
        n = n * 10 + lnext - '0';
        lnext = scan();
    }
    return(n);
}


double
getnum(void)                    /* scan a positive float */
{
    int  i, lnext;
    char  str[RMAXWORD+1];

    i = 0;
    lnext = nextc;
    while (isdigit(lnext) && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
    }
    if ((lnext == '.') & (i < RMAXWORD)) {
        str[i++] = lnext;
        lnext = scan();
        if (i == 1 && !isdigit(lnext))
            syntax("badly formed number");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    if ((lnext == 'e') | (lnext == 'E') && i < RMAXWORD) {
        str[i++] = lnext;
        lnext = scan();
        if ((lnext == '-') | (lnext == '+') && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
        if (!isdigit(lnext))
            syntax("missing exponent");
        while (isdigit(lnext) && i < RMAXWORD) {
            str[i++] = lnext;
            lnext = scan();
        }
    }
    str[i] = '\0';

    return(atof(str));
}


EPNODE *
getE1(void)                     /* E1 -> E1 ADDOP E2 */
                                /*       E2 */
{
    EPNODE  *ep1, *ep2;

    ep1 = getE2();
    while ((nextc == '+') | (nextc == '-')) {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE2());
        if (esupport&E_RCONST &&
                        (ep1->type == NUM) & (ep1->sibling->type == NUM))
                ep2 = rconst(ep2);
        ep1 = ep2;
    }
    return(ep1);
}


EPNODE *
getE2(void)                     /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    EPNODE  *ep1, *ep2;

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


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

        ep1 = getE4();
        if (nextc != '^')
                return(ep1);
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST) {
                EPNODE  *ep3 = ep1->sibling;
                if ((ep1->type == NUM) & (ep3->type == NUM)) {
                        ep2 = rconst(ep2);
                } else if (ep1->type == NUM && ep1->v.num == 0) {
                        epfree(ep3,1);          /* (0 ^ E3) */
                        ep1->sibling = NULL;
                        efree(ep2);
                        ep2 = ep1;
                } else if ((ep3->type == NUM && ep3->v.num == 0) |
                                (ep1->type == NUM && ep1->v.num == 1)) {
                        epfree(ep2,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.48
Committed:	Sun Feb 25 04:41:44 2024 UTC (2 months, 2 weeks ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.47:	+9 -12 lines
Log Message:	fix: Made error non-fatal in case optimization done twice
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.48	static const char RCSid[] = "$Id: calexpr.c,v 2.47 2024/02/25 04:11:10 greg Exp $";
3	greg	1.1	#endif
4			/*
5			* Compute data values using expression parser
6			*
7			* 7/1/85 Greg Ward
8			*
9			* 11/11/85 Made channel input conditional with (INCHAN) compiles.
10			*
11			* 4/2/86 Added conditional compiles for function definitions (FUNCTION).
12			*
13			* 1/29/87 Made variables conditional (VARIABLE)
14			*
15			* 5/19/88 Added constant subexpression elimination (RCONST)
16	greg	2.18	*
17			* 2/19/03 Eliminated conditional compiles in favor of esupport extern.
18			*/
19
20	greg	2.19	#include "copyright.h"
21	greg	1.1
22			#include <ctype.h>
23			#include <errno.h>
24	greg	2.8	#include <math.h>
25	greg	2.18	#include <stdlib.h>
26
27	schorsch	2.29	#include "rtmisc.h"
28			#include "rtio.h"
29	schorsch	2.24	#include "rterror.h"
30	greg	1.1	#include "calcomp.h"
31
32	greg	2.6	#define MAXLINE 256 /* maximum line length */
33	greg	1.1
34	greg	2.6	#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE))
35	greg	1.1
36	greg	2.42	#define isdecimal(c) (isdigit(c) \| ((c) == '.'))
37	greg	1.1
38	greg	2.44	#define envalue(ep) ((ep)->type==NUM ? (ep)->v.num : evalue(ep))
39
40	schorsch	2.24	static double euminus(EPNODE ), eargument(EPNODE ), enumber(EPNODE *);
41			static double echannel(EPNODE *);
42			static double eadd(EPNODE ), esubtr(EPNODE ),
43			emult(EPNODE ), edivi(EPNODE ),
44			epow(EPNODE *);
45			static double ebotch(EPNODE *);
46	greg	1.1
47	greg	2.18	unsigned int esupport = /* what to support */
48	greg	2.21	E_VARIABLE \| E_FUNCTION ;
49	greg	2.15
50	greg	2.30	int eofc = 0; /* optional end-of-file character */
51	greg	1.1	int nextc; /* lookahead character */
52
53	greg	2.27	double (eoper[])(EPNODE ) = { /* expression operations */
54	greg	1.1	ebotch,
55			evariable,
56			enumber,
57			euminus,
58			echannel,
59			efunc,
60			eargument,
61			ebotch,
62			ebotch,
63			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
64			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
65			emult,
66			eadd,
67			0,
68			esubtr,
69			0,
70			edivi,
71	greg	1.9	0,0,0,0,0,0,0,0,0,0,
72	greg	1.1	ebotch,
73	greg	1.9	0,0,
74			ebotch,
75	greg	1.1	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
76			0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
77			epow,
78			};
79
80			static FILE infp; / input file pointer */
81			static char linbuf; / line buffer */
82	greg	1.6	static char infile; / input file name */
83			static int lineno; /* input line number */
84	greg	1.1	static int linepos; /* position in buffer */
85
86
87			EPNODE *
88	schorsch	2.28	eparse( /* parse an expression string */
89			char *expr
90			)
91	greg	1.1	{
92			EPNODE *ep;
93
94	greg	1.6	initstr(expr, NULL, 0);
95	greg	1.1	curfunc = NULL;
96			ep = getE1();
97			if (nextc != EOF)
98			syntax("unexpected character");
99			return(ep);
100			}
101
102
103			double
104	schorsch	2.28	eval( /* evaluate an expression string */
105			char *expr
106			)
107	greg	1.1	{
108	greg	2.38	int prev_support = esupport;
109	greg	2.37	EPNODE *ep;
110	greg	1.1	double rval;
111
112	greg	2.38	esupport &= ~E_RCONST; /* don't bother reducing constant expr */
113	greg	1.1	ep = eparse(expr);
114	greg	2.38	esupport = prev_support; /* as you were */
115	greg	1.1	rval = evalue(ep);
116	greg	2.43	epfree(ep,1);
117	greg	1.1	return(rval);
118			}
119
120
121	greg	2.18	int
122	schorsch	2.28	epcmp( /* compare two expressions for equivalence */
123	greg	2.37	EPNODE *ep1,
124			EPNODE *ep2
125	schorsch	2.28	)
126	greg	2.16	{
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	schorsch	2.26	return((d > 1.000000000001) \| (d < 0.999999999999));
142	greg	2.16
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	greg	2.32	case CLKT:
152	greg	2.16	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	greg	2.18	void
172	schorsch	2.28	epfree( /* free a parse tree */
173	greg	2.43	EPNODE *epar,
174			int frep
175	schorsch	2.28	)
176	greg	1.1	{
177	greg	2.43	EPNODE *ep;
178	greg	1.1
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	greg	2.32	case CLKT:
193	greg	1.1	break;
194
195			default:
196	greg	2.43	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	greg	1.1	break;
207
208			}
209	greg	2.43	if (frep)
210			efree(epar);
211			}
212
213	greg	1.1
214	greg	2.45	static void
215	greg	2.44	epflatten( /* flatten hierarchies for '+', '' /
216			EPNODE *epar
217			)
218			{
219			EPNODE *ep;
220
221	greg	2.48	if (epar->nkids < 0) /* can't handle array allocations */
222			return;
223
224	greg	2.44	for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
225	greg	2.48	while (ep->type == epar->type && ep->nkids > 0) {
226	greg	2.44	EPNODE *ep1 = ep->v.kid;
227			while (ep1->sibling != NULL)
228			ep1 = ep1->sibling;
229			ep1->sibling = ep->sibling;
230	greg	2.48	epar->nkids += ep->nkids - 1;
231	greg	2.44	ep1 = ep->v.kid;
232			ep = ep1;
233			efree(ep1); /* not epfree()! */
234			}
235			}
236
237
238			void
239	greg	2.47	epoptimize( /* flatten operations, lists -> arrays */
240	greg	2.43	EPNODE *epar
241			)
242			{
243			EPNODE *ep;
244
245	greg	2.45	if ((epar->type == '+') \| (epar->type == '*'))
246	greg	2.47	epflatten(epar); /* flatten associative operations */
247	greg	2.44
248	greg	2.45	if (epar->nkids) /* do children if any */
249	greg	2.44	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	greg	2.43	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	greg	2.44	epar->nkids = -n;
264	greg	2.43	}
265	greg	1.1	}
266
267			/* the following used to be a switch */
268			static double
269	schorsch	2.28	eargument(
270			EPNODE *ep
271			)
272	greg	1.1	{
273			return(argument(ep->v.chan));
274			}
275
276			static double
277	schorsch	2.28	enumber(
278			EPNODE *ep
279			)
280	greg	1.1	{
281			return(ep->v.num);
282			}
283
284			static double
285	schorsch	2.28	euminus(
286			EPNODE *ep
287			)
288	greg	1.1	{
289	greg	2.37	EPNODE *ep1 = ep->v.kid;
290	greg	1.1
291			return(-evalue(ep1));
292			}
293
294			static double
295	schorsch	2.28	echannel(
296			EPNODE *ep
297			)
298	greg	1.1	{
299			return(chanvalue(ep->v.chan));
300			}
301
302			static double
303	schorsch	2.28	eadd(
304			EPNODE *ep
305			)
306	greg	1.1	{
307	greg	2.44	double sum = 0;
308	greg	2.37	EPNODE *ep1 = ep->v.kid;
309	greg	1.1
310	greg	2.44	do
311			sum += envalue(ep1);
312			while ((ep1 = ep1->sibling) != NULL);
313
314			return(sum);
315	greg	1.1	}
316
317			static double
318	schorsch	2.28	esubtr(
319			EPNODE *ep
320			)
321	greg	1.1	{
322	greg	2.37	EPNODE *ep1 = ep->v.kid;
323	greg	2.44	EPNODE *ep2 = ep1->sibling;
324	greg	1.1
325	greg	2.44	return(envalue(ep1) - envalue(ep2));
326	greg	1.1	}
327
328			static double
329	schorsch	2.28	emult(
330			EPNODE *ep
331			)
332	greg	1.1	{
333	greg	2.44	double prod = 1;
334	greg	2.37	EPNODE *ep1 = ep->v.kid;
335	greg	1.1
336	greg	2.44	do
337			prod *= envalue(ep1);
338			while ((ep1 = ep1->sibling) != NULL);
339
340			return(prod);
341	greg	1.1	}
342
343			static double
344	schorsch	2.28	edivi(
345			EPNODE *ep
346			)
347	greg	1.1	{
348	greg	2.37	EPNODE *ep1 = ep->v.kid;
349	greg	2.48	double den = evalue(ep1->sibling);
350	greg	1.1
351	greg	2.48	if (den == 0.0) {
352	greg	1.1	wputs("Division by zero\n");
353			errno = ERANGE;
354			return(0.0);
355			}
356	greg	2.48	return(envalue(ep1) / den);
357	greg	1.1	}
358
359			static double
360	schorsch	2.28	epow(
361			EPNODE *ep
362			)
363	greg	1.1	{
364	greg	2.37	EPNODE *ep1 = ep->v.kid;
365	greg	1.1	double d;
366	greg	2.6	int lasterrno;
367	greg	1.1
368			lasterrno = errno;
369			errno = 0;
370			d = pow(evalue(ep1), evalue(ep1->sibling));
371	greg	2.31	#ifdef isnan
372	greg	2.36	if (errno == 0) {
373	greg	2.31	if (isnan(d))
374			errno = EDOM;
375			else if (isinf(d))
376			errno = ERANGE;
377	greg	2.36	}
378	greg	1.1	#endif
379	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE)) {
380	greg	1.1	wputs("Illegal power\n");
381			return(0.0);
382			}
383			errno = lasterrno;
384			return(d);
385			}
386
387			static double
388	schorsch	2.28	ebotch(
389			EPNODE *ep
390			)
391	greg	1.1	{
392			eputs("Bad expression!\n");
393			quit(1);
394	schorsch	2.22	return 0.0; /* pro forma return */
395	greg	1.1	}
396
397
398			EPNODE *
399	schorsch	2.28	ekid( /* return pointer to a node's nth kid */
400	greg	2.37	EPNODE *ep,
401			int n
402	schorsch	2.28	)
403	greg	1.1	{
404	greg	2.43	if (ep->nkids < 0) { /* allocated array? */
405			if (n >= -ep->nkids)
406			return(NULL);
407			return(ep->v.kid + n);
408			}
409			ep = ep->v.kid; /* else get from list */
410			while (n-- > 0)
411			if ((ep = ep->sibling) == NULL)
412			break;
413	greg	1.1	return(ep);
414			}
415
416
417	greg	2.18	void
418	schorsch	2.28	initfile( /* prepare input file */
419			FILE *fp,
420			char *fn,
421			int ln
422			)
423	greg	1.1	{
424	greg	2.6	static char inpbuf[MAXLINE];
425	greg	1.1
426			infp = fp;
427			linbuf = inpbuf;
428	greg	1.6	infile = fn;
429			lineno = ln;
430	greg	1.1	linepos = 0;
431			inpbuf[0] = '\0';
432			scan();
433			}
434
435
436	greg	2.18	void
437	schorsch	2.28	initstr( /* prepare input string */
438			char *s,
439			char *fn,
440			int ln
441			)
442	greg	1.1	{
443			infp = NULL;
444	greg	1.6	infile = fn;
445			lineno = ln;
446	greg	1.1	linbuf = s;
447			linepos = 0;
448			scan();
449			}
450
451
452	greg	2.18	void
453	schorsch	2.28	getscanpos( /* return current scan position */
454			char **fnp,
455			int *lnp,
456			char **spp,
457			FILE **fpp
458			)
459	greg	1.13	{
460			if (fnp != NULL) *fnp = infile;
461			if (lnp != NULL) *lnp = lineno;
462			if (spp != NULL) *spp = linbuf+linepos;
463			if (fpp != NULL) *fpp = infp;
464			}
465
466
467	greg	1.12	int
468	schorsch	2.28	scan(void) /* scan next character, return literal next */
469	greg	1.1	{
470	greg	2.37	int lnext = 0;
471	greg	1.12
472	greg	1.1	do {
473			if (linbuf[linepos] == '\0')
474			if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
475			nextc = EOF;
476			else {
477			nextc = linbuf[0];
478	greg	1.6	lineno++;
479	greg	1.1	linepos = 1;
480			}
481			else
482			nextc = linbuf[linepos++];
483	greg	1.12	if (!lnext)
484			lnext = nextc;
485	greg	2.30	if (nextc == eofc) {
486			nextc = EOF;
487			break;
488			}
489	greg	1.1	if (nextc == '{') {
490			scan();
491			while (nextc != '}')
492			if (nextc == EOF)
493			syntax("'}' expected");
494			else
495			scan();
496			scan();
497			}
498			} while (isspace(nextc));
499	greg	1.12	return(lnext);
500	greg	1.1	}
501
502
503	greg	1.6	char *
504	schorsch	2.28	long2ascii( /* convert long to ascii */
505			long l
506			)
507	greg	1.6	{
508	greg	2.6	static char buf[16];
509	greg	2.37	char *cp;
510	greg	2.6	int neg = 0;
511	greg	1.6
512			if (l == 0)
513			return("0");
514			if (l < 0) {
515			l = -l;
516			neg++;
517			}
518			cp = buf + sizeof(buf);
519			*--cp = '\0';
520			while (l) {
521			*--cp = l % 10 + '0';
522			l /= 10;
523			}
524			if (neg)
525			*--cp = '-';
526			return(cp);
527			}
528
529
530	greg	2.18	void
531	schorsch	2.28	syntax( /* report syntax error and quit */
532			char *err
533			)
534	greg	1.1	{
535	greg	2.37	int i;
536	greg	1.1
537	greg	2.42	if ((infile != NULL) \| (lineno != 0)) {
538	greg	1.6	if (infile != NULL) eputs(infile);
539			if (lineno != 0) {
540			eputs(infile != NULL ? ", line " : "line ");
541	greg	2.9	eputs(long2ascii((long)lineno));
542	greg	1.6	}
543	greg	2.7	eputs(":\n");
544	greg	1.1	}
545	greg	1.7	eputs(linbuf);
546			if (linbuf[strlen(linbuf)-1] != '\n')
547			eputs("\n");
548			for (i = 0; i < linepos-1; i++)
549			eputs(linbuf[i] == '\t' ? "\t" : " ");
550			eputs("^ ");
551	greg	1.1	eputs(err);
552			eputs("\n");
553			quit(1);
554			}
555
556
557	greg	2.18	void
558	schorsch	2.28	addekid( /* add a child to ep */
559	greg	2.37	EPNODE *ep,
560	greg	2.43	EPNODE *ek
561	schorsch	2.28	)
562	greg	1.1	{
563	greg	2.47	if (ep->nkids < 0) {
564			eputs("Cannot add kid to EPNODE array\n");
565			quit(1);
566			}
567	greg	2.43	ep->nkids++;
568	greg	1.1	if (ep->v.kid == NULL)
569	greg	2.43	ep->v.kid = ek;
570	greg	1.1	else {
571			for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
572			;
573	greg	2.43	ep->sibling = ek;
574	greg	1.1	}
575	greg	2.44	ek->sibling = NULL; /* shouldn't be necessary */
576	greg	1.1	}
577
578
579			char *
580	schorsch	2.28	getname(void) /* scan an identifier */
581	greg	1.1	{
582	schorsch	2.23	static char str[RMAXWORD+1];
583	greg	2.37	int i, lnext;
584	greg	1.1
585	greg	1.12	lnext = nextc;
586	schorsch	2.23	for (i = 0; i < RMAXWORD && isid(lnext); i++, lnext = scan())
587	greg	1.12	str[i] = lnext;
588	greg	1.1	str[i] = '\0';
589	greg	1.15	while (isid(lnext)) /* skip rest of name */
590			lnext = scan();
591	greg	1.1
592			return(str);
593			}
594
595
596			int
597	schorsch	2.28	getinum(void) /* scan a positive integer */
598	greg	1.1	{
599	greg	2.37	int n, lnext;
600	greg	1.1
601			n = 0;
602	greg	1.12	lnext = nextc;
603			while (isdigit(lnext)) {
604			n = n * 10 + lnext - '0';
605			lnext = scan();
606	greg	1.1	}
607			return(n);
608			}
609
610
611			double
612	schorsch	2.28	getnum(void) /* scan a positive float */
613	greg	1.1	{
614	greg	2.37	int i, lnext;
615	schorsch	2.23	char str[RMAXWORD+1];
616	greg	1.1
617			i = 0;
618	greg	1.12	lnext = nextc;
619	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
620	greg	1.12	str[i++] = lnext;
621			lnext = scan();
622	greg	1.1	}
623	greg	2.42	if ((lnext == '.') & (i < RMAXWORD)) {
624	greg	2.6	str[i++] = lnext;
625			lnext = scan();
626	gwlarson	2.17	if (i == 1 && !isdigit(lnext))
627			syntax("badly formed number");
628	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
629	greg	1.12	str[i++] = lnext;
630			lnext = scan();
631	greg	1.1	}
632			}
633	schorsch	2.26	if ((lnext == 'e') \| (lnext == 'E') && i < RMAXWORD) {
634	greg	2.6	str[i++] = lnext;
635			lnext = scan();
636	schorsch	2.26	if ((lnext == '-') \| (lnext == '+') && i < RMAXWORD) {
637	greg	1.12	str[i++] = lnext;
638			lnext = scan();
639	greg	1.1	}
640	gwlarson	2.17	if (!isdigit(lnext))
641			syntax("missing exponent");
642	schorsch	2.23	while (isdigit(lnext) && i < RMAXWORD) {
643	greg	1.12	str[i++] = lnext;
644			lnext = scan();
645	greg	1.1	}
646			}
647			str[i] = '\0';
648
649			return(atof(str));
650			}
651
652
653			EPNODE *
654	greg	2.34	getE1(void) /* E1 -> E1 ADDOP E2 */
655	greg	2.6	/* E2 */
656	greg	1.1	{
657	greg	2.37	EPNODE ep1, ep2;
658	greg	1.1
659			ep1 = getE2();
660	greg	2.42	while ((nextc == '+') \| (nextc == '-')) {
661	greg	1.1	ep2 = newnode();
662			ep2->type = nextc;
663			scan();
664			addekid(ep2, ep1);
665			addekid(ep2, getE2());
666	greg	2.18	if (esupport&E_RCONST &&
667	greg	2.42	(ep1->type == NUM) & (ep1->sibling->type == NUM))
668	greg	1.1	ep2 = rconst(ep2);
669			ep1 = ep2;
670			}
671			return(ep1);
672			}
673
674
675			EPNODE *
676	greg	2.34	getE2(void) /* E2 -> E2 MULOP E3 */
677	greg	2.6	/* E3 */
678	greg	1.1	{
679	greg	2.37	EPNODE ep1, ep2;
680	greg	1.1
681			ep1 = getE3();
682	greg	2.42	while ((nextc == '*') \| (nextc == '/')) {
683	greg	1.1	ep2 = newnode();
684			ep2->type = nextc;
685			scan();
686			addekid(ep2, ep1);
687			addekid(ep2, getE3());
688	greg	2.34	if (esupport&E_RCONST) {
689			EPNODE *ep3 = ep1->sibling;
690	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
691	greg	2.34	ep2 = rconst(ep2);
692	greg	2.35	} 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	greg	2.43	epfree(ep2,1);
701	greg	2.35	ep2 = ep3;
702			}
703	greg	2.34	} else if (ep1->type == NUM && ep1->v.num == 0) {
704	greg	2.43	epfree(ep3,1); /* (0 * E3) or (0 / E3) */
705	greg	2.34	ep1->sibling = NULL;
706	greg	2.41	efree(ep2);
707	greg	2.34	ep2 = ep1;
708			}
709			}
710	greg	1.1	ep1 = ep2;
711			}
712			return(ep1);
713			}
714
715
716			EPNODE *
717	greg	2.34	getE3(void) /* E3 -> E4 ^ E3 */
718	greg	2.6	/* E4 */
719	greg	1.1	{
720	greg	2.37	EPNODE ep1, ep2;
721	greg	1.1
722	greg	2.34	ep1 = getE4();
723			if (nextc != '^')
724			return(ep1);
725	greg	1.1	ep2 = newnode();
726			ep2->type = nextc;
727			scan();
728			addekid(ep2, ep1);
729	greg	1.8	addekid(ep2, getE3());
730	greg	2.34	if (esupport&E_RCONST) {
731			EPNODE *ep3 = ep1->sibling;
732	greg	2.42	if ((ep1->type == NUM) & (ep3->type == NUM)) {
733	greg	2.34	ep2 = rconst(ep2);
734			} else if (ep1->type == NUM && ep1->v.num == 0) {
735	greg	2.43	epfree(ep3,1); /* (0 ^ E3) */
736	greg	2.34	ep1->sibling = NULL;
737	greg	2.41	efree(ep2);
738	greg	2.34	ep2 = ep1;
739	greg	2.42	} else if ((ep3->type == NUM && ep3->v.num == 0) \|
740	greg	2.34	(ep1->type == NUM && ep1->v.num == 1)) {
741	greg	2.43	epfree(ep2,1); /* (E4 ^ 0) or (1 ^ E3) */
742	greg	2.34	ep2 = newnode();
743			ep2->type = NUM;
744			ep2->v.num = 1;
745	greg	2.40	} else if (ep3->type == NUM && ep3->v.num == 1) {
746	greg	2.41	efree(ep3); /* (E4 ^ 1) */
747	greg	2.40	ep1->sibling = NULL;
748	greg	2.41	efree(ep2);
749	greg	2.40	ep2 = ep1;
750	greg	2.34	}
751			}
752	greg	1.8	return(ep2);
753	greg	1.1	}
754
755
756			EPNODE *
757	greg	2.34	getE4(void) /* E4 -> ADDOP E5 */
758	greg	2.6	/* E5 */
759	greg	1.1	{
760	greg	2.37	EPNODE ep1, ep2;
761	greg	1.1
762			if (nextc == '-') {
763			scan();
764	greg	1.3	ep2 = getE5();
765			if (ep2->type == NUM) {
766			ep2->v.num = -ep2->v.num;
767			return(ep2);
768			}
769	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
770	greg	2.33	ep1 = ep2->v.kid;
771	greg	2.41	efree(ep2);
772	greg	2.33	return(ep1);
773	greg	1.16	}
774	greg	1.1	ep1 = newnode();
775			ep1->type = UMINUS;
776	greg	1.3	addekid(ep1, ep2);
777	greg	1.1	return(ep1);
778			}
779			if (nextc == '+')
780			scan();
781			return(getE5());
782			}
783
784
785			EPNODE *
786	schorsch	2.28	getE5(void) /* E5 -> (E1) */
787	greg	2.6	/* VAR */
788			/* NUM */
789			/* $N */
790			/* FUNC(E1,..) */
791			/* ARG */
792	greg	1.1	{
793	schorsch	2.22	int i;
794			char *nam;
795	greg	2.37	EPNODE ep1, ep2;
796	greg	1.1
797	schorsch	2.22	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	greg	2.42	(isalpha(nextc) \| (nextc == CNTXMARK))) {
814	schorsch	2.22	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	greg	1.1	}
831	schorsch	2.22	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	greg	1.1	}
858
859
860			EPNODE *
861	schorsch	2.28	rconst( /* reduce a constant expression */
862	greg	2.37	EPNODE *epar
863	schorsch	2.28	)
864	greg	1.1	{
865	greg	2.37	EPNODE *ep;
866	greg	1.1
867			ep = newnode();
868			ep->type = NUM;
869			errno = 0;
870			ep->v.num = evalue(epar);
871	greg	2.42	if ((errno == EDOM) \| (errno == ERANGE))
872	greg	2.6	syntax("bad constant expression");
873	greg	2.43	epfree(epar,1);
874	greg	1.1
875			return(ep);
876	greg	1.9	}
877
878
879	greg	2.18	int
880	schorsch	2.28	isconstvar( /* is ep linked to a constant expression? */
881	greg	2.37	EPNODE *ep
882	schorsch	2.28	)
883	greg	1.9	{
884	greg	2.37	EPNODE *ep1;
885	greg	1.10
886	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
887	greg	1.11	if (!isconstfun(ep->v.kid))
888			return(0);
889	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
890	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
891	greg	1.9	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	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
900	greg	1.9	return(0);
901			return(1);
902	greg	1.1	}
903	greg	1.11
904
905	greg	2.18	int
906	schorsch	2.28	isconstfun( /* is ep linked to a constant function? */
907	greg	2.37	EPNODE *ep
908	schorsch	2.28	)
909	greg	1.11	{
910	greg	2.37	EPNODE *dp;
911			LIBR *lp;
912	greg	1.11
913			if (ep->type != VAR)
914			return(0);
915	schorsch	2.25	if ((dp = ep->v.ln->def) != NULL) {
916	greg	2.18	if (dp->v.kid->type == FUNC)
917			return(dp->type == ':');
918			else
919			return(0); /* don't identify masked library functions */
920	schorsch	2.25	}
921	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
922	greg	2.3	return(lp->atyp == ':');
923			return(0);
924	greg	1.11	}