src/common/calexpr.c

#ifndef lint
static const char       RCSid[] = "$Id$";
#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.
 */

/* ====================================================================
 * The Radiance Software License, Version 1.0
 *
 * Copyright (c) 1990 - 2002 The Regents of the University of California,
 * through Lawrence Berkeley National Laboratory.   All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *         notice, this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright
 *       notice, this list of conditions and the following disclaimer in
 *       the documentation and/or other materials provided with the
 *       distribution.
 *
 * 3. The end-user documentation included with the redistribution,
 *           if any, must include the following acknowledgment:
 *             "This product includes Radiance software
 *                 (http://radsite.lbl.gov/)
 *                 developed by the Lawrence Berkeley National Laboratory
 *               (http://www.lbl.gov/)."
 *       Alternately, this acknowledgment may appear in the software itself,
 *       if and wherever such third-party acknowledgments normally appear.
 *
 * 4. The names "Radiance," "Lawrence Berkeley National Laboratory"
 *       and "The Regents of the University of California" must
 *       not be used to endorse or promote products derived from this
 *       software without prior written permission. For written
 *       permission, please contact [email protected].
 *
 * 5. Products derived from this software may not be called "Radiance",
 *       nor may "Radiance" appear in their name, without prior written
 *       permission of Lawrence Berkeley National Laboratory.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED.   IN NO EVENT SHALL Lawrence Berkeley National Laboratory OR
 * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 * ====================================================================
 *
 * This software consists of voluntary contributions made by many
 * individuals on behalf of Lawrence Berkeley National Laboratory.   For more
 * information on Lawrence Berkeley National Laboratory, please see
 * <http://www.lbl.gov/>.
 */

#include  <stdio.h>

#include  <ctype.h>

#include  <errno.h>

#include  <math.h>

#include  <stdlib.h>

#include  "calcomp.h"

#define  MAXLINE        256             /* maximum line length */

#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))

#define  isdecimal(c)   (isdigit(c) || (c) == '.')

static double  euminus(), eargument(), enumber();
static double  echannel();
static double  eadd(), esubtr(), emult(), edivi(), epow();
static double  ebotch();

unsigned int  esupport =                /* what to support */
                E_VARIABLE | E_FUNCTION | E_REDEFW;

int  nextc;                             /* lookahead character */

double  (*eoper[])() = {                /* 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(expr)                    /* 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(expr)                      /* evaluate an expression string */
char  *expr;
{
    register EPNODE  *ep;
    double  rval;

    ep = eparse(expr);
    rval = evalue(ep);
    epfree(ep);
    return(rval);
}


int
epcmp(ep1, ep2)                 /* compare two expressions for equivalence */
register EPNODE  *ep1, *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 TICK:
        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(epar)                    /* free a parse tree */
register EPNODE  *epar;
{
    register 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 TICK:
            break;

        default:
            while ((ep = epar->v.kid) != NULL) {
                epar->v.kid = ep->sibling;
                epfree(ep);
            }
            break;

    }

    efree((char *)epar);
}

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

static double
enumber(ep)
EPNODE  *ep;
{
    return(ep->v.num);
}

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

    return(-evalue(ep1));
}

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

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

    return(evalue(ep1) + evalue(ep1->sibling));
}

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

    return(evalue(ep1) - evalue(ep1->sibling));
}

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

    return(evalue(ep1) * evalue(ep1->sibling));
}

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

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

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

    lasterrno = errno;
    errno = 0;
    d = pow(evalue(ep1), evalue(ep1->sibling));
#ifdef  IEEE
    if (!finite(d))
        errno = EDOM;
#endif
    if (errno) {
        wputs("Illegal power\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}

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


EPNODE *
ekid(ep, n)                     /* return pointer to a node's nth kid */
register EPNODE  *ep;
register int  n;
{

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        if (--n < 0)
            break;

    return(ep);
}


int
nekids(ep)                      /* return # of kids for node ep */
register EPNODE  *ep;
{
    register int  n = 0;

    for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
        n++;

    return(n);
}


void
initfile(fp, fn, ln)            /* 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(s, fn, ln)              /* prepare input string */
char  *s;
char  *fn;
int  ln;
{
    infp = NULL;
    infile = fn;
    lineno = ln;
    linbuf = s;
    linepos = 0;
    scan();
}


void
getscanpos(fnp, lnp, spp, fpp)  /* 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()                          /* scan next character, return literal next */
{
    register 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 == '{') {
            scan();
            while (nextc != '}')
                if (nextc == EOF)
                    syntax("'}' expected");
                else
                    scan();
            scan();
        }
    } while (isspace(nextc));
    return(lnext);
}


char *
long2ascii(l)                         /* convert long to ascii */
long  l;
{
    static char  buf[16];
    register 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(err)                     /* report syntax error and quit */
char  *err;
{
    register 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(ep, ekid)                       /* add a child to ep */
register EPNODE  *ep;
EPNODE  *ekid;
{
    if (ep->v.kid == NULL)
        ep->v.kid = ekid;
    else {
        for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
            ;
        ep->sibling = ekid;
    }
    ekid->sibling = NULL;
}


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

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

    return(str);
}


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

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


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

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

    return(atof(str));
}


EPNODE *
getE1()                         /* E1 -> E1 ADDOP E2 */
                                /*       E2 */
{
    register 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()                         /* E2 -> E2 MULOP E3 */
                                /*       E3 */
{
    register EPNODE  *ep1, *ep2;

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


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

    ep1 = getE4();
    if (nextc == '^') {
        ep2 = newnode();
        ep2->type = nextc;
        scan();
        addekid(ep2, ep1);
        addekid(ep2, getE3());
        if (esupport&E_RCONST &&
                        ep1->type == NUM && ep1->sibling->type == NUM)
                ep2 = rconst(ep2);
        return(ep2);
    }
    return(ep1);
}


EPNODE *
getE4()                         /* E4 -> ADDOP E5 */
                                /*       E5 */
{
    register 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) */
            efree((char *)ep2);
            return(ep2->v.kid);
        }
        ep1 = newnode();
        ep1->type = UMINUS;
        addekid(ep1, ep2);
        return(ep1);
    }
    if (nextc == '+')
        scan();
    return(getE5());
}


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


EPNODE *
rconst(epar)                    /* reduce a constant expression */
register EPNODE  *epar;
{
    register EPNODE  *ep;

    ep = newnode();
    ep->type = NUM;
    errno = 0;
    ep->v.num = evalue(epar);
    if (errno)
        syntax("bad constant expression");
    epfree(epar);
 
    return(ep);
}


int
isconstvar(ep)                  /* is ep linked to a constant expression? */
register EPNODE  *ep;
{
    register 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(ep)                  /* is ep linked to a constant function? */
register EPNODE  *ep;
{
    register EPNODE  *dp;
    register 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.18
Committed:	Sat Feb 22 02:07:21 2003 UTC (21 years, 2 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.17:	+97 -84 lines
Log Message:	Changes and check-in for 3.5 release Includes new source files and modifications not recorded for many years See ray/doc/notes/ReleaseNotes for notes between 3.1 and 3.5 release
#	Content
1	#ifndef lint
2	static const char RCSid[] = "$Id$";
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	/* ====================================================================
21	* The Radiance Software License, Version 1.0
22	*
23	* Copyright (c) 1990 - 2002 The Regents of the University of California,
24	* through Lawrence Berkeley National Laboratory. All rights reserved.
25	*
26	* Redistribution and use in source and binary forms, with or without
27	* modification, are permitted provided that the following conditions
28	* are met:
29	*
30	* 1. Redistributions of source code must retain the above copyright
31	* notice, this list of conditions and the following disclaimer.
32	*
33	* 2. Redistributions in binary form must reproduce the above copyright
34	* notice, this list of conditions and the following disclaimer in
35	* the documentation and/or other materials provided with the
36	* distribution.
37	*
38	* 3. The end-user documentation included with the redistribution,
39	* if any, must include the following acknowledgment:
40	* "This product includes Radiance software
41	* (http://radsite.lbl.gov/)
42	* developed by the Lawrence Berkeley National Laboratory
43	* (http://www.lbl.gov/)."
44	* Alternately, this acknowledgment may appear in the software itself,
45	* if and wherever such third-party acknowledgments normally appear.
46	*
47	* 4. The names "Radiance," "Lawrence Berkeley National Laboratory"
48	* and "The Regents of the University of California" must
49	* not be used to endorse or promote products derived from this
50	* software without prior written permission. For written
51	* permission, please contact [email protected].
52	*
53	* 5. Products derived from this software may not be called "Radiance",
54	* nor may "Radiance" appear in their name, without prior written
55	* permission of Lawrence Berkeley National Laboratory.
56	*
57	* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
58	* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
59	* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
60	* DISCLAIMED. IN NO EVENT SHALL Lawrence Berkeley National Laboratory OR
61	* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
62	* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
63	* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
64	* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
65	* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
66	* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
67	* OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
68	* SUCH DAMAGE.
69	* ====================================================================
70	*
71	* This software consists of voluntary contributions made by many
72	* individuals on behalf of Lawrence Berkeley National Laboratory. For more
73	* information on Lawrence Berkeley National Laboratory, please see
74	* <http://www.lbl.gov/>.
75	*/
76
77	#include <stdio.h>
78
79	#include <ctype.h>
80
81	#include <errno.h>
82
83	#include <math.h>
84
85	#include <stdlib.h>
86
87	#include "calcomp.h"
88
89	#define MAXLINE 256 /* maximum line length */
90
91	#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE))
92
93	#define isdecimal(c) (isdigit(c) \|\| (c) == '.')
94
95	static double euminus(), eargument(), enumber();
96	static double echannel();
97	static double eadd(), esubtr(), emult(), edivi(), epow();
98	static double ebotch();
99
100	unsigned int esupport = /* what to support */
101	E_VARIABLE \| E_FUNCTION \| E_REDEFW;
102
103	int nextc; /* lookahead character */
104
105	double (eoper[])() = { / expression operations */
106	ebotch,
107	evariable,
108	enumber,
109	euminus,
110	echannel,
111	efunc,
112	eargument,
113	ebotch,
114	ebotch,
115	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
116	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
117	emult,
118	eadd,
119	0,
120	esubtr,
121	0,
122	edivi,
123	0,0,0,0,0,0,0,0,0,0,
124	ebotch,
125	0,0,
126	ebotch,
127	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
128	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
129	epow,
130	};
131
132	static FILE infp; / input file pointer */
133	static char linbuf; / line buffer */
134	static char infile; / input file name */
135	static int lineno; /* input line number */
136	static int linepos; /* position in buffer */
137
138
139	EPNODE *
140	eparse(expr) /* parse an expression string */
141	char *expr;
142	{
143	EPNODE *ep;
144
145	initstr(expr, NULL, 0);
146	curfunc = NULL;
147	ep = getE1();
148	if (nextc != EOF)
149	syntax("unexpected character");
150	return(ep);
151	}
152
153
154	double
155	eval(expr) /* evaluate an expression string */
156	char *expr;
157	{
158	register EPNODE *ep;
159	double rval;
160
161	ep = eparse(expr);
162	rval = evalue(ep);
163	epfree(ep);
164	return(rval);
165	}
166
167
168	int
169	epcmp(ep1, ep2) /* compare two expressions for equivalence */
170	register EPNODE ep1, ep2;
171	{
172	double d;
173
174	if (ep1->type != ep2->type)
175	return(1);
176
177	switch (ep1->type) {
178
179	case VAR:
180	return(ep1->v.ln != ep2->v.ln);
181
182	case NUM:
183	if (ep2->v.num == 0)
184	return(ep1->v.num != 0);
185	d = ep1->v.num / ep2->v.num;
186	return(d > 1.000000000001 \| d < 0.999999999999);
187
188	case CHAN:
189	case ARG:
190	return(ep1->v.chan != ep2->v.chan);
191
192	case '=':
193	case ':':
194	return(epcmp(ep1->v.kid->sibling, ep2->v.kid->sibling));
195
196	case TICK:
197	case SYM: /* should never get this one */
198	return(0);
199
200	default:
201	ep1 = ep1->v.kid;
202	ep2 = ep2->v.kid;
203	while (ep1 != NULL) {
204	if (ep2 == NULL)
205	return(1);
206	if (epcmp(ep1, ep2))
207	return(1);
208	ep1 = ep1->sibling;
209	ep2 = ep2->sibling;
210	}
211	return(ep2 != NULL);
212	}
213	}
214
215
216	void
217	epfree(epar) /* free a parse tree */
218	register EPNODE *epar;
219	{
220	register EPNODE *ep;
221
222	switch (epar->type) {
223
224	case VAR:
225	varfree(epar->v.ln);
226	break;
227
228	case SYM:
229	freestr(epar->v.name);
230	break;
231
232	case NUM:
233	case CHAN:
234	case ARG:
235	case TICK:
236	break;
237
238	default:
239	while ((ep = epar->v.kid) != NULL) {
240	epar->v.kid = ep->sibling;
241	epfree(ep);
242	}
243	break;
244
245	}
246
247	efree((char *)epar);
248	}
249
250	/* the following used to be a switch */
251	static double
252	eargument(ep)
253	EPNODE *ep;
254	{
255	return(argument(ep->v.chan));
256	}
257
258	static double
259	enumber(ep)
260	EPNODE *ep;
261	{
262	return(ep->v.num);
263	}
264
265	static double
266	euminus(ep)
267	EPNODE *ep;
268	{
269	register EPNODE *ep1 = ep->v.kid;
270
271	return(-evalue(ep1));
272	}
273
274	static double
275	echannel(ep)
276	EPNODE *ep;
277	{
278	return(chanvalue(ep->v.chan));
279	}
280
281	static double
282	eadd(ep)
283	EPNODE *ep;
284	{
285	register EPNODE *ep1 = ep->v.kid;
286
287	return(evalue(ep1) + evalue(ep1->sibling));
288	}
289
290	static double
291	esubtr(ep)
292	EPNODE *ep;
293	{
294	register EPNODE *ep1 = ep->v.kid;
295
296	return(evalue(ep1) - evalue(ep1->sibling));
297	}
298
299	static double
300	emult(ep)
301	EPNODE *ep;
302	{
303	register EPNODE *ep1 = ep->v.kid;
304
305	return(evalue(ep1) * evalue(ep1->sibling));
306	}
307
308	static double
309	edivi(ep)
310	EPNODE *ep;
311	{
312	register EPNODE *ep1 = ep->v.kid;
313	double d;
314
315	d = evalue(ep1->sibling);
316	if (d == 0.0) {
317	wputs("Division by zero\n");
318	errno = ERANGE;
319	return(0.0);
320	}
321	return(evalue(ep1) / d);
322	}
323
324	static double
325	epow(ep)
326	EPNODE *ep;
327	{
328	register EPNODE *ep1 = ep->v.kid;
329	double d;
330	int lasterrno;
331
332	lasterrno = errno;
333	errno = 0;
334	d = pow(evalue(ep1), evalue(ep1->sibling));
335	#ifdef IEEE
336	if (!finite(d))
337	errno = EDOM;
338	#endif
339	if (errno) {
340	wputs("Illegal power\n");
341	return(0.0);
342	}
343	errno = lasterrno;
344	return(d);
345	}
346
347	static double
348	ebotch(ep)
349	EPNODE *ep;
350	{
351	eputs("Bad expression!\n");
352	quit(1);
353	}
354
355
356	EPNODE *
357	ekid(ep, n) /* return pointer to a node's nth kid */
358	register EPNODE *ep;
359	register int n;
360	{
361
362	for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
363	if (--n < 0)
364	break;
365
366	return(ep);
367	}
368
369
370	int
371	nekids(ep) /* return # of kids for node ep */
372	register EPNODE *ep;
373	{
374	register int n = 0;
375
376	for (ep = ep->v.kid; ep != NULL; ep = ep->sibling)
377	n++;
378
379	return(n);
380	}
381
382
383	void
384	initfile(fp, fn, ln) /* prepare input file */
385	FILE *fp;
386	char *fn;
387	int ln;
388	{
389	static char inpbuf[MAXLINE];
390
391	infp = fp;
392	linbuf = inpbuf;
393	infile = fn;
394	lineno = ln;
395	linepos = 0;
396	inpbuf[0] = '\0';
397	scan();
398	}
399
400
401	void
402	initstr(s, fn, ln) /* prepare input string */
403	char *s;
404	char *fn;
405	int ln;
406	{
407	infp = NULL;
408	infile = fn;
409	lineno = ln;
410	linbuf = s;
411	linepos = 0;
412	scan();
413	}
414
415
416	void
417	getscanpos(fnp, lnp, spp, fpp) /* return current scan position */
418	char **fnp;
419	int *lnp;
420	char **spp;
421	FILE **fpp;
422	{
423	if (fnp != NULL) *fnp = infile;
424	if (lnp != NULL) *lnp = lineno;
425	if (spp != NULL) *spp = linbuf+linepos;
426	if (fpp != NULL) *fpp = infp;
427	}
428
429
430	int
431	scan() /* scan next character, return literal next */
432	{
433	register int lnext = 0;
434
435	do {
436	if (linbuf[linepos] == '\0')
437	if (infp == NULL \|\| fgets(linbuf, MAXLINE, infp) == NULL)
438	nextc = EOF;
439	else {
440	nextc = linbuf[0];
441	lineno++;
442	linepos = 1;
443	}
444	else
445	nextc = linbuf[linepos++];
446	if (!lnext)
447	lnext = nextc;
448	if (nextc == '{') {
449	scan();
450	while (nextc != '}')
451	if (nextc == EOF)
452	syntax("'}' expected");
453	else
454	scan();
455	scan();
456	}
457	} while (isspace(nextc));
458	return(lnext);
459	}
460
461
462	char *
463	long2ascii(l) /* convert long to ascii */
464	long l;
465	{
466	static char buf[16];
467	register char *cp;
468	int neg = 0;
469
470	if (l == 0)
471	return("0");
472	if (l < 0) {
473	l = -l;
474	neg++;
475	}
476	cp = buf + sizeof(buf);
477	*--cp = '\0';
478	while (l) {
479	*--cp = l % 10 + '0';
480	l /= 10;
481	}
482	if (neg)
483	*--cp = '-';
484	return(cp);
485	}
486
487
488	void
489	syntax(err) /* report syntax error and quit */
490	char *err;
491	{
492	register int i;
493
494	if (infile != NULL \|\| lineno != 0) {
495	if (infile != NULL) eputs(infile);
496	if (lineno != 0) {
497	eputs(infile != NULL ? ", line " : "line ");
498	eputs(long2ascii((long)lineno));
499	}
500	eputs(":\n");
501	}
502	eputs(linbuf);
503	if (linbuf[strlen(linbuf)-1] != '\n')
504	eputs("\n");
505	for (i = 0; i < linepos-1; i++)
506	eputs(linbuf[i] == '\t' ? "\t" : " ");
507	eputs("^ ");
508	eputs(err);
509	eputs("\n");
510	quit(1);
511	}
512
513
514	void
515	addekid(ep, ekid) /* add a child to ep */
516	register EPNODE *ep;
517	EPNODE *ekid;
518	{
519	if (ep->v.kid == NULL)
520	ep->v.kid = ekid;
521	else {
522	for (ep = ep->v.kid; ep->sibling != NULL; ep = ep->sibling)
523	;
524	ep->sibling = ekid;
525	}
526	ekid->sibling = NULL;
527	}
528
529
530	char *
531	getname() /* scan an identifier */
532	{
533	static char str[MAXWORD+1];
534	register int i, lnext;
535
536	lnext = nextc;
537	for (i = 0; i < MAXWORD && isid(lnext); i++, lnext = scan())
538	str[i] = lnext;
539	str[i] = '\0';
540	while (isid(lnext)) /* skip rest of name */
541	lnext = scan();
542
543	return(str);
544	}
545
546
547	int
548	getinum() /* scan a positive integer */
549	{
550	register int n, lnext;
551
552	n = 0;
553	lnext = nextc;
554	while (isdigit(lnext)) {
555	n = n * 10 + lnext - '0';
556	lnext = scan();
557	}
558	return(n);
559	}
560
561
562	double
563	getnum() /* scan a positive float */
564	{
565	register int i, lnext;
566	char str[MAXWORD+1];
567
568	i = 0;
569	lnext = nextc;
570	while (isdigit(lnext) && i < MAXWORD) {
571	str[i++] = lnext;
572	lnext = scan();
573	}
574	if (lnext == '.' && i < MAXWORD) {
575	str[i++] = lnext;
576	lnext = scan();
577	if (i == 1 && !isdigit(lnext))
578	syntax("badly formed number");
579	while (isdigit(lnext) && i < MAXWORD) {
580	str[i++] = lnext;
581	lnext = scan();
582	}
583	}
584	if ((lnext == 'e' \| lnext == 'E') && i < MAXWORD) {
585	str[i++] = lnext;
586	lnext = scan();
587	if ((lnext == '-' \| lnext == '+') && i < MAXWORD) {
588	str[i++] = lnext;
589	lnext = scan();
590	}
591	if (!isdigit(lnext))
592	syntax("missing exponent");
593	while (isdigit(lnext) && i < MAXWORD) {
594	str[i++] = lnext;
595	lnext = scan();
596	}
597	}
598	str[i] = '\0';
599
600	return(atof(str));
601	}
602
603
604	EPNODE *
605	getE1() /* E1 -> E1 ADDOP E2 */
606	/* E2 */
607	{
608	register EPNODE ep1, ep2;
609
610	ep1 = getE2();
611	while (nextc == '+' \|\| nextc == '-') {
612	ep2 = newnode();
613	ep2->type = nextc;
614	scan();
615	addekid(ep2, ep1);
616	addekid(ep2, getE2());
617	if (esupport&E_RCONST &&
618	ep1->type == NUM && ep1->sibling->type == NUM)
619	ep2 = rconst(ep2);
620	ep1 = ep2;
621	}
622	return(ep1);
623	}
624
625
626	EPNODE *
627	getE2() /* E2 -> E2 MULOP E3 */
628	/* E3 */
629	{
630	register EPNODE ep1, ep2;
631
632	ep1 = getE3();
633	while (nextc == '*' \|\| nextc == '/') {
634	ep2 = newnode();
635	ep2->type = nextc;
636	scan();
637	addekid(ep2, ep1);
638	addekid(ep2, getE3());
639	if (esupport&E_RCONST &&
640	ep1->type == NUM && ep1->sibling->type == NUM)
641	ep2 = rconst(ep2);
642	ep1 = ep2;
643	}
644	return(ep1);
645	}
646
647
648	EPNODE *
649	getE3() /* E3 -> E4 ^ E3 */
650	/* E4 */
651	{
652	register EPNODE ep1, ep2;
653
654	ep1 = getE4();
655	if (nextc == '^') {
656	ep2 = newnode();
657	ep2->type = nextc;
658	scan();
659	addekid(ep2, ep1);
660	addekid(ep2, getE3());
661	if (esupport&E_RCONST &&
662	ep1->type == NUM && ep1->sibling->type == NUM)
663	ep2 = rconst(ep2);
664	return(ep2);
665	}
666	return(ep1);
667	}
668
669
670	EPNODE *
671	getE4() /* E4 -> ADDOP E5 */
672	/* E5 */
673	{
674	register EPNODE ep1, ep2;
675
676	if (nextc == '-') {
677	scan();
678	ep2 = getE5();
679	if (ep2->type == NUM) {
680	ep2->v.num = -ep2->v.num;
681	return(ep2);
682	}
683	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
684	efree((char *)ep2);
685	return(ep2->v.kid);
686	}
687	ep1 = newnode();
688	ep1->type = UMINUS;
689	addekid(ep1, ep2);
690	return(ep1);
691	}
692	if (nextc == '+')
693	scan();
694	return(getE5());
695	}
696
697
698	EPNODE *
699	getE5() /* E5 -> (E1) */
700	/* VAR */
701	/* NUM */
702	/* $N */
703	/* FUNC(E1,..) */
704	/* ARG */
705	{
706	int i;
707	char *nam;
708	register EPNODE ep1, ep2;
709
710	if (nextc == '(') {
711	scan();
712	ep1 = getE1();
713	if (nextc != ')')
714	syntax("')' expected");
715	scan();
716	return(ep1);
717	}
718
719	if (esupport&E_INCHAN && nextc == '$') {
720	scan();
721	ep1 = newnode();
722	ep1->type = CHAN;
723	ep1->v.chan = getinum();
724	return(ep1);
725	}
726
727	if (esupport&(E_VARIABLE\|E_FUNCTION) &&
728	(isalpha(nextc) \|\| nextc == CNTXMARK)) {
729	nam = getname();
730	ep1 = NULL;
731	if ((esupport&(E_VARIABLE\|E_FUNCTION)) == (E_VARIABLE\|E_FUNCTION)
732	&& curfunc != NULL)
733	for (i = 1, ep2 = curfunc->v.kid->sibling;
734	ep2 != NULL; i++, ep2 = ep2->sibling)
735	if (!strcmp(ep2->v.name, nam)) {
736	ep1 = newnode();
737	ep1->type = ARG;
738	ep1->v.chan = i;
739	break;
740	}
741	if (ep1 == NULL) {
742	ep1 = newnode();
743	ep1->type = VAR;
744	ep1->v.ln = varinsert(nam);
745	}
746	if (esupport&E_FUNCTION && nextc == '(') {
747	ep2 = newnode();
748	ep2->type = FUNC;
749	addekid(ep2, ep1);
750	ep1 = ep2;
751	do {
752	scan();
753	addekid(ep1, getE1());
754	} while (nextc == ',');
755	if (nextc != ')')
756	syntax("')' expected");
757	scan();
758	} else if (!(esupport&E_VARIABLE))
759	syntax("'(' expected");
760	if (esupport&E_RCONST && isconstvar(ep1))
761	ep1 = rconst(ep1);
762	return(ep1);
763	}
764
765	if (isdecimal(nextc)) {
766	ep1 = newnode();
767	ep1->type = NUM;
768	ep1->v.num = getnum();
769	return(ep1);
770	}
771	syntax("unexpected character");
772	}
773
774
775	EPNODE *
776	rconst(epar) /* reduce a constant expression */
777	register EPNODE *epar;
778	{
779	register EPNODE *ep;
780
781	ep = newnode();
782	ep->type = NUM;
783	errno = 0;
784	ep->v.num = evalue(epar);
785	if (errno)
786	syntax("bad constant expression");
787	epfree(epar);
788
789	return(ep);
790	}
791
792
793	int
794	isconstvar(ep) /* is ep linked to a constant expression? */
795	register EPNODE *ep;
796	{
797	register EPNODE *ep1;
798
799	if (esupport&E_FUNCTION && ep->type == FUNC) {
800	if (!isconstfun(ep->v.kid))
801	return(0);
802	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
803	if (ep1->type != NUM && !isconstfun(ep1))
804	return(0);
805	return(1);
806	}
807	if (ep->type != VAR)
808	return(0);
809	ep1 = ep->v.ln->def;
810	if (ep1 == NULL \|\| ep1->type != ':')
811	return(0);
812	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
813	return(0);
814	return(1);
815	}
816
817
818	int
819	isconstfun(ep) /* is ep linked to a constant function? */
820	register EPNODE *ep;
821	{
822	register EPNODE *dp;
823	register LIBR *lp;
824
825	if (ep->type != VAR)
826	return(0);
827	if ((dp = ep->v.ln->def) != NULL)
828	if (dp->v.kid->type == FUNC)
829	return(dp->type == ':');
830	else
831	return(0); /* don't identify masked library functions */
832	if ((lp = ep->v.ln->lib) != NULL)
833	return(lp->atyp == ':');
834	return(0);
835	}