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
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.18	static const char RCSid[] = "$Id$";
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			/* ====================================================================
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	greg	1.1	*/
76
77			#include <stdio.h>
78
79			#include <ctype.h>
80
81			#include <errno.h>
82
83	greg	2.8	#include <math.h>
84
85	greg	2.18	#include <stdlib.h>
86
87	greg	1.1	#include "calcomp.h"
88
89	greg	2.6	#define MAXLINE 256 /* maximum line length */
90	greg	1.1
91	greg	2.6	#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE))
92	greg	1.1
93	greg	2.6	#define isdecimal(c) (isdigit(c) \|\| (c) == '.')
94	greg	1.1
95	greg	2.12	static double euminus(), eargument(), enumber();
96			static double echannel();
97	greg	1.5	static double eadd(), esubtr(), emult(), edivi(), epow();
98			static double ebotch();
99	greg	1.1
100	greg	2.18	unsigned int esupport = /* what to support */
101			E_VARIABLE \| E_FUNCTION \| E_REDEFW;
102	greg	2.15
103	greg	1.1	int nextc; /* lookahead character */
104
105	greg	2.6	double (eoper[])() = { / expression operations */
106	greg	1.1	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	greg	1.9	0,0,0,0,0,0,0,0,0,0,
124	greg	1.1	ebotch,
125	greg	1.9	0,0,
126			ebotch,
127	greg	1.1	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	greg	1.6	static char infile; / input file name */
135			static int lineno; /* input line number */
136	greg	1.1	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	greg	1.6	initstr(expr, NULL, 0);
146	greg	1.1	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	greg	2.18	int
169	greg	2.16	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	greg	2.18	void
217	greg	1.1	epfree(epar) /* free a parse tree */
218	greg	2.6	register EPNODE *epar;
219	greg	1.1	{
220	greg	2.11	register EPNODE *ep;
221	greg	1.1
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	greg	2.11	while ((ep = epar->v.kid) != NULL) {
240			epar->v.kid = ep->sibling;
241	greg	1.1	epfree(ep);
242	greg	2.10	}
243	greg	1.1	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	greg	2.6	EPNODE *ep;
254	greg	1.1	{
255			return(argument(ep->v.chan));
256			}
257
258			static double
259			enumber(ep)
260	greg	2.6	EPNODE *ep;
261	greg	1.1	{
262			return(ep->v.num);
263			}
264
265			static double
266			euminus(ep)
267	greg	2.6	EPNODE *ep;
268	greg	1.1	{
269			register EPNODE *ep1 = ep->v.kid;
270
271			return(-evalue(ep1));
272			}
273
274			static double
275			echannel(ep)
276	greg	2.6	EPNODE *ep;
277	greg	1.1	{
278			return(chanvalue(ep->v.chan));
279			}
280
281			static double
282			eadd(ep)
283	greg	2.6	EPNODE *ep;
284	greg	1.1	{
285			register EPNODE *ep1 = ep->v.kid;
286
287			return(evalue(ep1) + evalue(ep1->sibling));
288			}
289
290			static double
291			esubtr(ep)
292	greg	2.6	EPNODE *ep;
293	greg	1.1	{
294			register EPNODE *ep1 = ep->v.kid;
295
296			return(evalue(ep1) - evalue(ep1->sibling));
297			}
298
299			static double
300			emult(ep)
301	greg	2.6	EPNODE *ep;
302	greg	1.1	{
303			register EPNODE *ep1 = ep->v.kid;
304
305			return(evalue(ep1) * evalue(ep1->sibling));
306			}
307
308			static double
309			edivi(ep)
310	greg	2.6	EPNODE *ep;
311	greg	1.1	{
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	greg	2.6	EPNODE *ep;
327	greg	1.1	{
328			register EPNODE *ep1 = ep->v.kid;
329			double d;
330	greg	2.6	int lasterrno;
331	greg	1.1
332			lasterrno = errno;
333			errno = 0;
334			d = pow(evalue(ep1), evalue(ep1->sibling));
335	greg	2.6	#ifdef IEEE
336	greg	1.1	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	greg	2.6	EPNODE *ep;
350	greg	1.1	{
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	greg	2.6	register EPNODE *ep;
359	greg	1.1	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	greg	2.6	register EPNODE *ep;
373	greg	1.1	{
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	greg	2.18	void
384	greg	1.6	initfile(fp, fn, ln) /* prepare input file */
385	greg	1.1	FILE *fp;
386	greg	1.6	char *fn;
387			int ln;
388	greg	1.1	{
389	greg	2.6	static char inpbuf[MAXLINE];
390	greg	1.1
391			infp = fp;
392			linbuf = inpbuf;
393	greg	1.6	infile = fn;
394			lineno = ln;
395	greg	1.1	linepos = 0;
396			inpbuf[0] = '\0';
397			scan();
398			}
399
400
401	greg	2.18	void
402	greg	1.6	initstr(s, fn, ln) /* prepare input string */
403	greg	1.1	char *s;
404	greg	1.6	char *fn;
405			int ln;
406	greg	1.1	{
407			infp = NULL;
408	greg	1.6	infile = fn;
409			lineno = ln;
410	greg	1.1	linbuf = s;
411			linepos = 0;
412			scan();
413			}
414
415
416	greg	2.18	void
417	greg	1.13	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	greg	1.12	int
431			scan() /* scan next character, return literal next */
432	greg	1.1	{
433	greg	1.12	register int lnext = 0;
434
435	greg	1.1	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	greg	1.6	lineno++;
442	greg	1.1	linepos = 1;
443			}
444			else
445			nextc = linbuf[linepos++];
446	greg	1.12	if (!lnext)
447			lnext = nextc;
448	greg	1.1	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	greg	1.12	return(lnext);
459	greg	1.1	}
460
461
462	greg	1.6	char *
463	greg	2.9	long2ascii(l) /* convert long to ascii */
464	greg	1.6	long l;
465			{
466	greg	2.6	static char buf[16];
467	greg	1.6	register char *cp;
468	greg	2.6	int neg = 0;
469	greg	1.6
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	greg	2.18	void
489	greg	1.1	syntax(err) /* report syntax error and quit */
490			char *err;
491			{
492			register int i;
493
494	greg	1.6	if (infile != NULL \|\| lineno != 0) {
495			if (infile != NULL) eputs(infile);
496			if (lineno != 0) {
497			eputs(infile != NULL ? ", line " : "line ");
498	greg	2.9	eputs(long2ascii((long)lineno));
499	greg	1.6	}
500	greg	2.7	eputs(":\n");
501	greg	1.1	}
502	greg	1.7	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	greg	1.1	eputs(err);
509			eputs("\n");
510			quit(1);
511			}
512
513
514	greg	2.18	void
515	greg	1.1	addekid(ep, ekid) /* add a child to ep */
516	greg	2.6	register EPNODE *ep;
517			EPNODE *ekid;
518	greg	1.1	{
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	greg	2.6	static char str[MAXWORD+1];
534	greg	1.12	register int i, lnext;
535	greg	1.1
536	greg	1.12	lnext = nextc;
537			for (i = 0; i < MAXWORD && isid(lnext); i++, lnext = scan())
538			str[i] = lnext;
539	greg	1.1	str[i] = '\0';
540	greg	1.15	while (isid(lnext)) /* skip rest of name */
541			lnext = scan();
542	greg	1.1
543			return(str);
544			}
545
546
547			int
548			getinum() /* scan a positive integer */
549			{
550	greg	1.12	register int n, lnext;
551	greg	1.1
552			n = 0;
553	greg	1.12	lnext = nextc;
554			while (isdigit(lnext)) {
555			n = n * 10 + lnext - '0';
556			lnext = scan();
557	greg	1.1	}
558			return(n);
559			}
560
561
562			double
563			getnum() /* scan a positive float */
564			{
565	greg	1.12	register int i, lnext;
566	greg	1.1	char str[MAXWORD+1];
567
568			i = 0;
569	greg	1.12	lnext = nextc;
570			while (isdigit(lnext) && i < MAXWORD) {
571			str[i++] = lnext;
572			lnext = scan();
573	greg	1.1	}
574	greg	1.12	if (lnext == '.' && i < MAXWORD) {
575	greg	2.6	str[i++] = lnext;
576			lnext = scan();
577	gwlarson	2.17	if (i == 1 && !isdigit(lnext))
578			syntax("badly formed number");
579	greg	1.12	while (isdigit(lnext) && i < MAXWORD) {
580			str[i++] = lnext;
581			lnext = scan();
582	greg	1.1	}
583			}
584	gwlarson	2.17	if ((lnext == 'e' \| lnext == 'E') && i < MAXWORD) {
585	greg	2.6	str[i++] = lnext;
586			lnext = scan();
587	gwlarson	2.17	if ((lnext == '-' \| lnext == '+') && i < MAXWORD) {
588	greg	1.12	str[i++] = lnext;
589			lnext = scan();
590	greg	1.1	}
591	gwlarson	2.17	if (!isdigit(lnext))
592			syntax("missing exponent");
593	greg	1.12	while (isdigit(lnext) && i < MAXWORD) {
594			str[i++] = lnext;
595			lnext = scan();
596	greg	1.1	}
597			}
598			str[i] = '\0';
599
600			return(atof(str));
601			}
602
603
604			EPNODE *
605			getE1() /* E1 -> E1 ADDOP E2 */
606	greg	2.6	/* E2 */
607	greg	1.1	{
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	greg	2.18	if (esupport&E_RCONST &&
618			ep1->type == NUM && ep1->sibling->type == NUM)
619	greg	1.1	ep2 = rconst(ep2);
620			ep1 = ep2;
621			}
622			return(ep1);
623			}
624
625
626			EPNODE *
627			getE2() /* E2 -> E2 MULOP E3 */
628	greg	2.6	/* E3 */
629	greg	1.1	{
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	greg	2.18	if (esupport&E_RCONST &&
640			ep1->type == NUM && ep1->sibling->type == NUM)
641	greg	1.1	ep2 = rconst(ep2);
642			ep1 = ep2;
643			}
644			return(ep1);
645			}
646
647
648			EPNODE *
649	greg	1.8	getE3() /* E3 -> E4 ^ E3 */
650	greg	2.6	/* E4 */
651	greg	1.1	{
652			register EPNODE ep1, ep2;
653
654			ep1 = getE4();
655	greg	1.8	if (nextc == '^') {
656	greg	1.1	ep2 = newnode();
657			ep2->type = nextc;
658			scan();
659			addekid(ep2, ep1);
660	greg	1.8	addekid(ep2, getE3());
661	greg	2.18	if (esupport&E_RCONST &&
662			ep1->type == NUM && ep1->sibling->type == NUM)
663	greg	1.1	ep2 = rconst(ep2);
664	greg	1.8	return(ep2);
665	greg	1.1	}
666			return(ep1);
667			}
668
669
670			EPNODE *
671			getE4() /* E4 -> ADDOP E5 */
672	greg	2.6	/* E5 */
673	greg	1.1	{
674	greg	1.3	register EPNODE ep1, ep2;
675	greg	1.1
676			if (nextc == '-') {
677			scan();
678	greg	1.3	ep2 = getE5();
679			if (ep2->type == NUM) {
680			ep2->v.num = -ep2->v.num;
681			return(ep2);
682			}
683	greg	1.16	if (ep2->type == UMINUS) { /* don't generate -(-E5) */
684			efree((char *)ep2);
685			return(ep2->v.kid);
686			}
687	greg	1.1	ep1 = newnode();
688			ep1->type = UMINUS;
689	greg	1.3	addekid(ep1, ep2);
690	greg	1.1	return(ep1);
691			}
692			if (nextc == '+')
693			scan();
694			return(getE5());
695			}
696
697
698			EPNODE *
699			getE5() /* E5 -> (E1) */
700	greg	2.6	/* VAR */
701			/* NUM */
702			/* $N */
703			/* FUNC(E1,..) */
704			/* ARG */
705	greg	1.1	{
706	greg	2.6	int i;
707	greg	1.14	char *nam;
708	greg	1.1	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	greg	2.18	if (esupport&E_INCHAN && nextc == '$') {
720	greg	1.1	scan();
721			ep1 = newnode();
722			ep1->type = CHAN;
723			ep1->v.chan = getinum();
724			return(ep1);
725			}
726
727	greg	2.18	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	greg	1.1	for (i = 1, ep2 = curfunc->v.kid->sibling;
734	greg	2.6	ep2 != NULL; i++, ep2 = ep2->sibling)
735	greg	1.14	if (!strcmp(ep2->v.name, nam)) {
736	greg	1.1	ep1 = newnode();
737			ep1->type = ARG;
738			ep1->v.chan = i;
739			break;
740			}
741	greg	2.18	if (ep1 == NULL) {
742	greg	1.14	ep1 = newnode();
743			ep1->type = VAR;
744			ep1->v.ln = varinsert(nam);
745			}
746	greg	2.18	if (esupport&E_FUNCTION && nextc == '(') {
747	greg	1.1	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	greg	2.18	} else if (!(esupport&E_VARIABLE))
759	greg	1.1	syntax("'(' expected");
760	greg	2.18	if (esupport&E_RCONST && isconstvar(ep1))
761	greg	1.9	ep1 = rconst(ep1);
762	greg	1.1	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	greg	2.6	register EPNODE *epar;
778	greg	1.1	{
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	greg	2.6	syntax("bad constant expression");
787	greg	1.1	epfree(epar);
788
789			return(ep);
790	greg	1.9	}
791
792
793	greg	2.18	int
794	greg	1.11	isconstvar(ep) /* is ep linked to a constant expression? */
795	greg	2.6	register EPNODE *ep;
796	greg	1.9	{
797			register EPNODE *ep1;
798	greg	1.10
799	greg	2.18	if (esupport&E_FUNCTION && ep->type == FUNC) {
800	greg	1.11	if (!isconstfun(ep->v.kid))
801			return(0);
802	greg	1.9	for (ep1 = ep->v.kid->sibling; ep1 != NULL; ep1 = ep1->sibling)
803	greg	1.11	if (ep1->type != NUM && !isconstfun(ep1))
804	greg	1.9	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	greg	2.18	if (esupport&E_FUNCTION && ep1->v.kid->type != SYM)
813	greg	1.9	return(0);
814			return(1);
815	greg	1.1	}
816	greg	1.11
817
818	greg	2.18	int
819	greg	1.11	isconstfun(ep) /* is ep linked to a constant function? */
820	greg	2.6	register EPNODE *ep;
821	greg	1.11	{
822			register EPNODE *dp;
823			register LIBR *lp;
824
825			if (ep->type != VAR)
826			return(0);
827	greg	2.18	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	greg	2.4	if ((lp = ep->v.ln->lib) != NULL)
833	greg	2.3	return(lp->atyp == ':');
834			return(0);
835	greg	1.11	}