--- ray/src/common/calexpr.c	1989/06/14 22:29:01	1.3
+++ ray/src/common/calexpr.c	1993/09/08 09:12:37	2.15
@@ -1,4 +1,4 @@
-/* Copyright (c) 1986 Regents of the University of California */
+/* Copyright (c) 1992 Regents of the University of California */
 
 #ifndef lint
 static char SCCSid[] = "$SunId$ LBL";
@@ -24,43 +24,48 @@ static char SCCSid[] = "$SunId$ LBL";
 
 #include  <errno.h>
 
+#include  <math.h>
+
 #include  "calcomp.h"
 
-#define  MAXLINE	256		/* maximum line length */
-#define  MAXWORD	64		/* maximum word length */
+#define	 MAXLINE	256		/* maximum line length */
 
-#define  newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
+#define	 newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
 
-#define  isid(c)	(isalnum(c) || (c) == '_' || (c) == '.')
+#define	 isdecimal(c)	(isdigit(c) || (c) == '.')
 
-#define  isdecimal(c)	(isdigit(c) || (c) == '.')
-
-extern double  atof(), pow();
-extern char  *fgets(), *savestr();
+extern char  *savestr();
 extern char  *emalloc(), *ecalloc();
 extern EPNODE  *curfunc;
-extern double  efunc(), evariable(), enumber(), euminus(), echannel();
-extern double  eargument(), eadd(), esubtr(), emult(), edivi(), epow();
-extern double  ebotch();
-extern int  errno;
+extern double  efunc(), evariable();
+static double  euminus(), eargument(), enumber();
+#ifdef  INCHAN
+static double  echannel();
+#endif
+static double  eadd(), esubtr(), emult(), edivi(), epow();
+static double  ebotch();
 
+#ifdef  DCL_ATOF
+extern double  atof();
+#endif
+
 int  nextc;				/* lookahead character */
 
-double  (*eoper[])() = {		/* expression operations */
+double	(*eoper[])() = {		/* expression operations */
 	ebotch,
-#ifdef  VARIABLE
+#ifdef	VARIABLE
 	evariable,
 #else
 	ebotch,
 #endif
 	enumber,
 	euminus,
-#ifdef  INCHAN
+#ifdef	INCHAN
 	echannel,
 #else
 	ebotch,
 #endif
-#ifdef  FUNCTION
+#ifdef	FUNCTION
 	efunc,
 	eargument,
 #else
@@ -77,16 +82,19 @@ double  (*eoper[])() = {		/* expression operations */
 	esubtr,
 	0,
 	edivi,
-	0,0,0,0,0,0,0,0,0,0,0,0,0,
+	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 char  *infile;			/* input file name */
 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 */
 
 
@@ -96,7 +104,7 @@ char  *expr;
 {
     EPNODE  *ep;
 
-    initstr(NULL, expr);
+    initstr(expr, NULL, 0);
 #if  defined(VARIABLE) && defined(FUNCTION)
     curfunc = NULL;
 #endif
@@ -122,7 +130,7 @@ char  *expr;
 
 
 epfree(epar)			/* free a parse tree */
-register EPNODE  *epar;
+register EPNODE	 *epar;
 {
     register EPNODE  *ep;
 
@@ -132,11 +140,11 @@ register EPNODE  *epar;
 	case VAR:
 	    varfree(epar->v.ln);
 	    break;
-#endif
 	    
 	case SYM:
 	    freestr(epar->v.name);
 	    break;
+#endif
 
 	case NUM:
 	case CHAN:
@@ -145,8 +153,10 @@ register EPNODE  *epar;
 	    break;
 
 	default:
-	    for (ep = epar->v.kid; ep != NULL; ep = ep->sibling)
+	    while ((ep = epar->v.kid) != NULL) {
+		epar->v.kid = ep->sibling;
 		epfree(ep);
+	    }
 	    break;
 
     }
@@ -155,10 +165,10 @@ register EPNODE  *epar;
 }
 
 				/* the following used to be a switch */
-#ifdef  FUNCTION
+#ifdef	FUNCTION
 static double
 eargument(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     return(argument(ep->v.chan));
 }
@@ -166,24 +176,24 @@ EPNODE  *ep;
 
 static double
 enumber(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     return(ep->v.num);
 }
 
 static double
 euminus(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
 
     return(-evalue(ep1));
 }
 
-#ifdef  INCHAN
+#ifdef	INCHAN
 static double
 echannel(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     return(chanvalue(ep->v.chan));
 }
@@ -191,7 +201,7 @@ EPNODE  *ep;
 
 static double
 eadd(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
 
@@ -200,7 +210,7 @@ EPNODE  *ep;
 
 static double
 esubtr(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
 
@@ -209,7 +219,7 @@ EPNODE  *ep;
 
 static double
 emult(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
 
@@ -218,7 +228,7 @@ EPNODE  *ep;
 
 static double
 edivi(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
     double  d;
@@ -234,16 +244,16 @@ EPNODE  *ep;
 
 static double
 epow(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register EPNODE  *ep1 = ep->v.kid;
     double  d;
-    int  lasterrno;
+    int	 lasterrno;
 
     lasterrno = errno;
     errno = 0;
     d = pow(evalue(ep1), evalue(ep1->sibling));
-#ifdef  IEEE
+#ifdef	IEEE
     if (!finite(d))
 	errno = EDOM;
 #endif
@@ -257,7 +267,7 @@ EPNODE  *ep;
 
 static double
 ebotch(ep)
-EPNODE  *ep;
+EPNODE	*ep;
 {
     eputs("Bad expression!\n");
     quit(1);
@@ -266,7 +276,7 @@ EPNODE  *ep;
 
 EPNODE *
 ekid(ep, n)			/* return pointer to a node's nth kid */
-register EPNODE  *ep;
+register EPNODE	 *ep;
 register int  n;
 {
 
@@ -280,7 +290,7 @@ register int  n;
 
 int
 nekids(ep)			/* return # of kids for node ep */
-register EPNODE  *ep;
+register EPNODE	 *ep;
 {
     register int  n = 0;
 
@@ -291,45 +301,68 @@ register EPNODE  *ep;
 }
 
 
-initfile(file, fp)		/* prepare input file */
-char  *file;
+initfile(fp, fn, ln)		/* prepare input file */
 FILE  *fp;
+char  *fn;
+int  ln;
 {
-    static char  inpbuf[MAXLINE];
+    static char	 inpbuf[MAXLINE];
 
-    infile = file;
     infp = fp;
     linbuf = inpbuf;
+    infile = fn;
+    lineno = ln;
     linepos = 0;
     inpbuf[0] = '\0';
     scan();
 }
 
 
-initstr(file, s)		/* prepare input string */
-char  *file;
+initstr(s, fn, ln)		/* prepare input string */
 char  *s;
+char  *fn;
+int  ln;
 {
-    infile = file;
     infp = NULL;
+    infile = fn;
+    lineno = ln;
     linbuf = s;
     linepos = 0;
     scan();
 }
 
 
-scan()				/* scan next character */
+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 != '}')
@@ -340,24 +373,55 @@ scan()				/* scan next character */
 	    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);
+}
+
+
 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[0] == '\0' || linbuf[strlen(linbuf)-1] != '\n')
+    if (linbuf[strlen(linbuf)-1] != '\n')
 	eputs("\n");
     for (i = 0; i < linepos-1; i++)
 	eputs(linbuf[i] == '\t' ? "\t" : " ");
     eputs("^ ");
-    if (infile != NULL) {
-	eputs(infile);
-	eputs(": ");
-    }
     eputs(err);
     eputs("\n");
     quit(1);
@@ -365,8 +429,8 @@ char  *err;
 
 
 addekid(ep, ekid)			/* add a child to ep */
-register EPNODE  *ep;
-EPNODE  *ekid;
+register EPNODE	 *ep;
+EPNODE	*ekid;
 {
     if (ep->v.kid == NULL)
 	ep->v.kid = ekid;
@@ -379,29 +443,35 @@ EPNODE  *ekid;
 }
 
 
+#if  defined(VARIABLE) || defined(FUNCTION)
 char *
 getname()			/* scan an identifier */
 {
-    static char  str[MAXWORD+1];
-    register int  i;
+    static char	 str[MAXWORD+1];
+    register int  i, lnext;
 
-    for (i = 0; i < MAXWORD && isid(nextc); i++, scan())
-	str[i] = nextc;
+    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);
 }
+#endif
 
 
 int
 getinum()			/* scan a positive integer */
 {
-    register int  n;
+    register int  n, lnext;
 
     n = 0;
-    while (isdigit(nextc)) {
-	n = n * 10 + nextc - '0';
-	scan();
+    lnext = nextc;
+    while (isdigit(lnext)) {
+	n = n * 10 + lnext - '0';
+	lnext = scan();
     }
     return(n);
 }
@@ -410,32 +480,33 @@ getinum()			/* scan a positive integer */
 double
 getnum()			/* scan a positive float */
 {
-    register int  i;
+    register int  i, lnext;
     char  str[MAXWORD+1];
 
     i = 0;
-    while (isdigit(nextc) && i < MAXWORD) {
-	str[i++] = nextc;
-	scan();
+    lnext = nextc;
+    while (isdigit(lnext) && i < MAXWORD) {
+	str[i++] = lnext;
+	lnext = scan();
     }
-    if (nextc == '.' && i < MAXWORD) {
-    	str[i++] = nextc;
-    	scan();
-	while (isdigit(nextc) && i < MAXWORD) {
-	    str[i++] = nextc;
-	    scan();
+    if (lnext == '.' && i < MAXWORD) {
+	str[i++] = lnext;
+	lnext = scan();
+	while (isdigit(lnext) && i < MAXWORD) {
+	    str[i++] = lnext;
+	    lnext = scan();
 	}
     }
-    if ((nextc == 'e' || nextc == 'E') && i < MAXWORD) {
-    	str[i++] = nextc;
-    	scan();
-	if ((nextc == '-' || nextc == '+') && i < MAXWORD) {
-	    str[i++] = nextc;
-	    scan();
+    if ((lnext == 'e' || lnext == 'E') && i < MAXWORD) {
+	str[i++] = lnext;
+	lnext = scan();
+	if ((lnext == '-' || lnext == '+') && i < MAXWORD) {
+	    str[i++] = lnext;
+	    lnext = scan();
 	}
-	while (isdigit(nextc) && i < MAXWORD) {
-	    str[i++] = nextc;
-	    scan();
+	while (isdigit(lnext) && i < MAXWORD) {
+	    str[i++] = lnext;
+	    lnext = scan();
 	}
     }
     str[i] = '\0';
@@ -446,7 +517,7 @@ getnum()			/* scan a positive float */
 
 EPNODE *
 getE1()				/* E1 -> E1 ADDOP E2 */
-				/*       E2 */
+				/*	 E2 */
 {
     register EPNODE  *ep1, *ep2;
 
@@ -457,7 +528,7 @@ getE1()				/* E1 -> E1 ADDOP E2 */
 	scan();
 	addekid(ep2, ep1);
 	addekid(ep2, getE2());
-#ifdef  RCONST
+#ifdef	RCONST
 	if (ep1->type == NUM && ep1->sibling->type == NUM)
 		ep2 = rconst(ep2);
 #endif
@@ -469,7 +540,7 @@ getE1()				/* E1 -> E1 ADDOP E2 */
 
 EPNODE *
 getE2()				/* E2 -> E2 MULOP E3 */
-				/*       E3 */
+				/*	 E3 */
 {
     register EPNODE  *ep1, *ep2;
 
@@ -480,7 +551,7 @@ getE2()				/* E2 -> E2 MULOP E3 */
 	scan();
 	addekid(ep2, ep1);
 	addekid(ep2, getE3());
-#ifdef  RCONST
+#ifdef	RCONST
 	if (ep1->type == NUM && ep1->sibling->type == NUM)
 		ep2 = rconst(ep2);
 #endif
@@ -491,23 +562,23 @@ getE2()				/* E2 -> E2 MULOP E3 */
 
 
 EPNODE *
-getE3()				/* E3 -> E3 ^ E4 */
-				/*       E4 */
+getE3()				/* E3 -> E4 ^ E3 */
+				/*	 E4 */
 {
     register EPNODE  *ep1, *ep2;
 
     ep1 = getE4();
-    while (nextc == '^') {
+    if (nextc == '^') {
 	ep2 = newnode();
 	ep2->type = nextc;
 	scan();
 	addekid(ep2, ep1);
-	addekid(ep2, getE4());
-#ifdef  RCONST
+	addekid(ep2, getE3());
+#ifdef	RCONST
 	if (ep1->type == NUM && ep1->sibling->type == NUM)
 		ep2 = rconst(ep2);
 #endif
-	ep1 = ep2;
+	return(ep2);
     }
     return(ep1);
 }
@@ -515,7 +586,7 @@ getE3()				/* E3 -> E3 ^ E4 */
 
 EPNODE *
 getE4()				/* E4 -> ADDOP E5 */
-				/*       E5 */
+				/*	 E5 */
 {
     register EPNODE  *ep1, *ep2;
 
@@ -526,6 +597,10 @@ getE4()				/* E4 -> ADDOP E5 */
 		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);
@@ -539,13 +614,14 @@ getE4()				/* E4 -> ADDOP E5 */
 
 EPNODE *
 getE5()				/* E5 -> (E1) */
-				/*       VAR */
-				/*       NUM */
-				/*       $N */
-				/*       FUNC(E1,..) */
-				/*       ARG */
+				/*	 VAR */
+				/*	 NUM */
+				/*	 $N */
+				/*	 FUNC(E1,..) */
+				/*	 ARG */
 {
-    int  i;
+    int	 i;
+    char  *nam;
     register EPNODE  *ep1, *ep2;
 
     if (nextc == '(') {
@@ -557,7 +633,7 @@ getE5()				/* E5 -> (E1) */
 	return(ep1);
     }
 
-#ifdef  INCHAN
+#ifdef	INCHAN
     if (nextc == '$') {
 	scan();
 	ep1 = newnode();
@@ -568,24 +644,27 @@ getE5()				/* E5 -> (E1) */
 #endif
 
 #if  defined(VARIABLE) || defined(FUNCTION)
-    if (isalpha(nextc)) {
-	ep1 = newnode();
-	ep1->type = VAR;
-	ep1->v.ln = varinsert(getname());
-
+    if (isalpha(nextc) || nextc == CNTXMARK) {
+	nam = getname();
 #if  defined(VARIABLE) && defined(FUNCTION)
+	ep1 = NULL;
 	if (curfunc != NULL)
 	    for (i = 1, ep2 = curfunc->v.kid->sibling;
-	    			ep2 != NULL; i++, ep2 = ep2->sibling)
-		if (!strcmp(ep2->v.name, ep1->v.ln->name)) {
-		    epfree(ep1);
+				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)
 #endif
-#ifdef  FUNCTION
+	{
+	    ep1 = newnode();
+	    ep1->type = VAR;
+	    ep1->v.ln = varinsert(nam);
+	}
+#ifdef	FUNCTION
 	if (nextc == '(') {
 	    ep2 = newnode();
 	    ep2->type = FUNC;
@@ -599,11 +678,15 @@ getE5()				/* E5 -> (E1) */
 		syntax("')' expected");
 	    scan();
 	}
-#ifndef  VARIABLE
+#ifndef	 VARIABLE
 	else
 	    syntax("'(' expected");
 #endif
 #endif
+#ifdef	RCONST
+	if (isconstvar(ep1))
+	    ep1 = rconst(ep1);
+#endif
 	return(ep1);
     }
 #endif
@@ -618,10 +701,10 @@ getE5()				/* E5 -> (E1) */
 }
 
 
-#ifdef  RCONST
+#ifdef	RCONST
 EPNODE *
 rconst(epar)			/* reduce a constant expression */
-register EPNODE  *epar;
+register EPNODE	 *epar;
 {
     register EPNODE  *ep;
 
@@ -630,9 +713,59 @@ register EPNODE  *epar;
     errno = 0;
     ep->v.num = evalue(epar);
     if (errno)
-    	syntax("bad constant expression");
+	syntax("bad constant expression");
     epfree(epar);
  
     return(ep);
 }
+
+
+isconstvar(ep)			/* is ep linked to a constant expression? */
+register EPNODE	 *ep;
+{
+#ifdef	VARIABLE
+    register EPNODE  *ep1;
+#ifdef	FUNCTION
+
+    if (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);
+    }
+#endif
+    if (ep->type != VAR)
+	return(0);
+    ep1 = ep->v.ln->def;
+    if (ep1 == NULL || ep1->type != ':')
+	return(0);
+#ifdef	FUNCTION
+    if (ep1->v.kid->type != SYM)
+	return(0);
+#endif
+    return(1);
+#else
+    return(ep->type == FUNC);
+#endif
+}
+
+
+#if  defined(FUNCTION) && defined(VARIABLE)
+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 && dp->v.kid->type == FUNC)
+	return(dp->type == ':');
+    if ((lp = ep->v.ln->lib) != NULL)
+	return(lp->atyp == ':');
+    return(0);
+}
+#endif
 #endif