--- ray/src/common/caldefn.c	1990/07/19 11:15:31	1.5
+++ ray/src/common/caldefn.c	1992/09/21 12:01:44	2.4
@@ -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";
@@ -18,6 +18,10 @@ static char SCCSid[] = "$SunId$ LBL";
  *  11/16/88  Added VARDEF structure for hard linking.
  *
  *  5/31/90  Added conditional compile (REDEFW) for redefinition warning.
+ *
+ *  4/23/91  Added ':' assignment for constant expressions
+ *
+ *  8/7/91  Added optional context path to append to variable names
  */
 
 #include  <stdio.h>
@@ -26,33 +30,37 @@ static char SCCSid[] = "$SunId$ LBL";
 
 #include  "calcomp.h"
 
-#ifndef  NHASH
-#define  NHASH		521		/* hash size (a prime!) */
+#ifndef	 NHASH
+#define	 NHASH		521		/* hash size (a prime!) */
 #endif
 
-#define  newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
+#define	 newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
 
-extern char  *ecalloc(), *savestr();
+extern char  *ecalloc(), *emalloc(), *savestr(), *strcpy();
 
+static int  hash();
+
 static double  dvalue();
 
 long  eclock = -1;			/* value storage timer */
 
+static char  context[MAXWORD+1];	/* current context path */
+
 static VARDEF  *hashtbl[NHASH];		/* definition list */
 static int  htndx;			/* index for */		
 static VARDEF  *htpos;			/* ...dfirst() and */
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
 static EPNODE  *ochpos;			/* ...dnext */
 static EPNODE  *outchan;
 #endif
 
-#ifdef  FUNCTION
-EPNODE  *curfunc;
-#define  dname(ep)	((ep)->v.kid->type == SYM ? \
+#ifdef	FUNCTION
+EPNODE	*curfunc;
+#define	 dname(ep)	((ep)->v.kid->type == SYM ? \
 			(ep)->v.kid->v.name : \
 			(ep)->v.kid->v.kid->v.name)
 #else
-#define  dname(ep)	((ep)->v.kid->v.name)
+#define	 dname(ep)	((ep)->v.kid->v.name)
 #endif
 
 
@@ -70,7 +78,7 @@ char  *fname;
     }
     initfile(fp, fname, 0);
     while (nextc != EOF)
-	loaddefn();
+	getstatement();
     if (fname != NULL)
 	fclose(fp);
 }
@@ -83,7 +91,7 @@ int  ln;
 {
     initstr(str, fn, ln);
     while (nextc != EOF)
-	loaddefn();
+	getstatement();
 }
 
 
@@ -97,7 +105,7 @@ char  *vname;
 
 double
 evariable(ep)			/* evaluate a variable */
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register VARDEF  *dp = ep->v.ln;
 
@@ -105,22 +113,27 @@ EPNODE  *ep;
 }
 
 
-varset(vname, val)		/* set a variable's value */
+varset(vname, assign, val)	/* set a variable's value */
 char  *vname;
-double  val;
+int  assign;
+double	val;
 {
+    char  *qname;
     register EPNODE  *ep1, *ep2;
+					/* get qualified name */
+    qname = qualname(vname, 0);
 					/* check for quick set */
-    if ((ep1 = dlookup(vname)) != NULL && ep1->v.kid->type == SYM) {
+    if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) {
 	ep2 = ep1->v.kid->sibling;
 	if (ep2->type == NUM) {
 	    ep2->v.num = val;
+	    ep1->type = assign;
 	    return;
 	}
     }
 					/* hand build definition */
     ep1 = newnode();
-    ep1->type = '=';
+    ep1->type = assign;
     ep2 = newnode();
     ep2->type = SYM;
     ep2->v.name = savestr(vname);
@@ -129,16 +142,31 @@ double  val;
     ep2->type = NUM;
     ep2->v.num = val;
     addekid(ep1, ep2);
-    dclear(vname);
-    dpush(ep1);
+    dremove(qname);
+    dpush(qname, ep1);
 }
 
 
-dclear(name)			/* delete all definitions of name */
+dclear(name)			/* delete variable definitions of name */
 char  *name;
 {
     register EPNODE  *ep;
 
+    while ((ep = dpop(name)) != NULL) {
+	if (ep->type == ':') {
+	    dpush(name, ep);		/* don't clear constants */
+	    return;
+	}
+	epfree(ep);
+    }
+}
+
+
+dremove(name)			/* delete all definitions of name */
+char  *name;
+{
+    register EPNODE  *ep;
+
     while ((ep = dpop(name)) != NULL)
 	epfree(ep);
 }
@@ -153,31 +181,123 @@ char  *name;
 }
 
 
-#ifdef  OUTCHAN
-chanout()			/* set output channels */
+char *
+setcontext(ctx)			/* set a new context path */
+register char  *ctx;
 {
+    register char  *cpp;
+
+    if (ctx == NULL)
+	return(context);		/* just asking */
+    if (!*ctx) {
+	context[0] = '\0';		/* clear context */
+	return(context);
+    }
+    cpp = context;			/* else copy it (carefully!) */
+    if (*ctx != CNTXMARK)
+	*cpp++ = CNTXMARK;		/* make sure there's a mark */
+    do {
+	if (cpp >= context+MAXWORD)
+	    break;			/* just copy what we can */
+	if (isid(*ctx))
+	    *cpp++ = *ctx++;
+	else {
+	    *cpp++ = '_'; ctx++;
+	}
+    } while (*ctx);
+    *cpp = '\0';
+    return(context);
+}
+
+
+char *
+qualname(nam, lvl)		/* get qualified name */
+register char  *nam;
+int  lvl;
+{
+    static char	 nambuf[MAXWORD+1];
+    register char  *cp = nambuf, *cpp;
+				/* check for explicit local */
+    if (*nam == CNTXMARK)
+	if (lvl > 0)		/* only action is to refuse search */
+	    return(NULL);
+	else
+	    nam++;
+    else if (nam == nambuf)	/* check for repeat call */
+	return(lvl > 0 ? NULL : nam);
+				/* copy name to static buffer */
+    while (*nam) {
+	if (cp >= nambuf+MAXWORD)
+		goto toolong;
+	*cp++ = *nam++;
+    }
+				/* check for explicit global */
+    if (cp > nambuf && cp[-1] == CNTXMARK) {
+	if (lvl > 0)
+	    return(NULL);
+	*--cp = '\0';
+	return(nambuf);		/* already qualified */
+    }
+    cpp = context;		/* else skip the requested levels */
+    while (lvl-- > 0) {
+	if (!*cpp)
+	    return(NULL);	/* return NULL if past global level */
+	while (*++cpp && *cpp != CNTXMARK)
+	    ;
+    }
+    while (*cpp) {		/* copy context to static buffer */
+	if (cp >= nambuf+MAXWORD)
+	    goto toolong;
+	*cp++ = *cpp++;
+    }
+toolong:
+    *cp = '\0';
+    return(nambuf);		/* return qualified name */
+}
+
+
+incontext(qn)			/* is qualified name in current context? */
+register char  *qn;
+{
+    while (*qn && *qn != CNTXMARK)	/* find context mark */
+	qn++;
+    return(!strcmp(qn, context));
+}
+
+
+#ifdef	OUTCHAN
+chanout(cs)			/* set output channels */
+int  (*cs)();
+{
     register EPNODE  *ep;
 
     for (ep = outchan; ep != NULL; ep = ep->sibling)
-	chanset(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
+	(*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
 
 }
 #endif
 
 
-dclearall()			/* clear all definitions */
+dcleanup(lvl)		/* clear definitions (0->vars,1->output,2->consts) */
+int  lvl;
 {
     register int  i;
     register VARDEF  *vp;
     register EPNODE  *ep;
-
+				/* if context is global, clear all */
     for (i = 0; i < NHASH; i++)
 	for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
-	    dclear(vp->name);
-#ifdef  OUTCHAN
-    for (ep = outchan; ep != NULL; ep = ep->sibling)
-	epfree(ep);
-    outchan = NULL;
+	    if (!context[0] || incontext(vp->name))
+		if (lvl >= 2)
+		    dremove(vp->name);
+		else
+		    dclear(vp->name);
+#ifdef	OUTCHAN
+    if (lvl >= 1) {
+	for (ep = outchan; ep != NULL; ep = ep->sibling)
+	    epfree(ep);
+	outchan = NULL;
+    }
 #endif
 }
 
@@ -189,7 +309,7 @@ char  *name;
     register VARDEF  *vp;
     
     if ((vp = varlookup(name)) == NULL)
-    	return(NULL);
+	return(NULL);
     return(vp->def);
 }
 
@@ -198,11 +318,14 @@ VARDEF *
 varlookup(name)			/* look up a variable */
 char  *name;
 {
+    int	 lvl = 0;
+    register char  *qname;
     register VARDEF  *vp;
-    
-    for (vp = hashtbl[hash(name)]; vp != NULL; vp = vp->next)
-    	if (!strcmp(vp->name, name))
-    	    return(vp);
+				/* find most qualified match */
+    while ((qname = qualname(name, lvl++)) != NULL)
+	for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next)
+	    if (!strcmp(vp->name, qname))
+		return(vp);
     return(NULL);
 }
 
@@ -212,42 +335,62 @@ varinsert(name)			/* get a link to a variable */
 char  *name;
 {
     register VARDEF  *vp;
-    int  hv;
+    int	 hv;
     
-    hv = hash(name);
-    for (vp = hashtbl[hv]; vp != NULL; vp = vp->next)
-    	if (!strcmp(vp->name, name)) {
-    	    vp->nlinks++;
-    	    return(vp);
-    	}
+    if ((vp = varlookup(name)) != NULL) {
+	vp->nlinks++;
+	return(vp);
+    }
     vp = (VARDEF *)emalloc(sizeof(VARDEF));
+#ifdef	FUNCTION
+    vp->lib = liblookup(name);
+#else
+    vp->lib = NULL;
+#endif
+    if (vp->lib == NULL)		/* if name not in library */
+	name = qualname(name, 0);	/* use fully qualified version */
+    hv = hash(name);
     vp->name = savestr(name);
     vp->nlinks = 1;
     vp->def = NULL;
-    vp->lib = NULL;
     vp->next = hashtbl[hv];
     hashtbl[hv] = vp;
     return(vp);
 }
 
 
+#ifdef	FUNCTION
+libupdate(fn)			/* update library links */
+char  *fn;
+{
+    register int  i;
+    register VARDEF  *vp;
+					/* if fn is NULL then relink all */
+    for (i = 0; i < NHASH; i++)
+	for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
+	    if (vp->lib != NULL || fn == NULL || !strcmp(fn, vp->name))
+		vp->lib = liblookup(vp->name);
+}
+#endif
+
+
 varfree(ln)				/* release link to variable */
-register VARDEF  *ln;
+register VARDEF	 *ln;
 {
     register VARDEF  *vp;
-    int  hv;
+    int	 hv;
 
     if (--ln->nlinks > 0)
-    	return;				/* still active */
+	return;				/* still active */
 
     hv = hash(ln->name);
     vp = hashtbl[hv];
     if (vp == ln)
-    	hashtbl[hv] = vp->next;
+	hashtbl[hv] = vp->next;
     else {
-    	while (vp->next != ln)		/* must be in list */
-    		vp = vp->next;
-    	vp->next = ln->next;
+	while (vp->next != ln)		/* must be in list */
+		vp = vp->next;
+	vp->next = ln->next;
     }
     freestr(ln->name);
     efree((char *)ln);
@@ -259,7 +402,7 @@ dfirst()			/* return pointer to first definition */
 {
     htndx = 0;
     htpos = NULL;
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     ochpos = outchan;
 #endif
     return(dnext());
@@ -270,20 +413,22 @@ EPNODE *
 dnext()				/* return pointer to next definition */
 {
     register EPNODE  *ep;
+    register char  *nm;
 
     while (htndx < NHASH) {
-    	if (htpos == NULL)
-    		htpos = hashtbl[htndx++];
-    	while (htpos != NULL) {
-    	    ep = htpos->def;
-    	    htpos = htpos->next;
-    	    if (ep != NULL)
-    	    	return(ep);
-    	}
+	if (htpos == NULL)
+		htpos = hashtbl[htndx++];
+	while (htpos != NULL) {
+	    ep = htpos->def;
+	    nm = htpos->name;
+	    htpos = htpos->next;
+	    if (ep != NULL && incontext(nm))
+		return(ep);
+	}
     }
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     if ((ep = ochpos) != NULL)
-    	ochpos = ep->sibling;
+	ochpos = ep->sibling;
     return(ep);
 #else
     return(NULL);
@@ -299,7 +444,7 @@ char  *name;
     register EPNODE  *dp;
     
     if ((vp = varlookup(name)) == NULL || vp->def == NULL)
-    	return(NULL);
+	return(NULL);
     dp = vp->def;
     vp->def = dp->sibling;
     varfree(vp);
@@ -307,22 +452,23 @@ char  *name;
 }
 
 
-dpush(ep)			/* push on a definition */
-register EPNODE  *ep;
+dpush(nm, ep)			/* push on a definition */
+char  *nm;
+register EPNODE	 *ep;
 {
     register VARDEF  *vp;
 
-    vp = varinsert(dname(ep));
+    vp = varinsert(nm);
     ep->sibling = vp->def;
     vp->def = ep;
 }
 
 
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
 addchan(sp)			/* add an output channel assignment */
-EPNODE  *sp;
+EPNODE	*sp;
 {
-    int  ch = sp->v.kid->v.chan;
+    int	 ch = sp->v.kid->v.chan;
     register EPNODE  *ep, *epl;
 
     for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling)
@@ -349,15 +495,17 @@ EPNODE  *sp;
 #endif
 
 
-loaddefn()			/* load next definition */
+getstatement()			/* get next statement */
 {
     register EPNODE  *ep;
+    char  *qname;
+    register VARDEF  *vdef;
 
     if (nextc == ';') {		/* empty statement */
 	scan();
 	return;
     }
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     if (nextc == '$') {		/* channel assignment */
 	ep = getchan();
 	addchan(ep);
@@ -365,16 +513,28 @@ loaddefn()			/* load next definition */
 #endif
     {				/* ordinary definition */
 	ep = getdefn();
-#ifdef  REDEFW
-	if (dlookup(dname(ep)) != NULL) {
-		dclear(dname(ep));
-		wputs(dname(ep));
-		wputs(": redefined\n");
-	}
-#else
-	dclear(dname(ep));
+	qname = qualname(dname(ep), 0);
+#ifdef	REDEFW
+	if ((vdef = varlookup(qname)) != NULL)
+	    if (vdef->def != NULL) {
+		wputs(qname);
+		if (vdef->def->type == ':')
+		    wputs(": redefined constant expression\n");
+		else
+		    wputs(": redefined\n");
+	    }
+#ifdef	FUNCTION
+	    else if (ep->v.kid->type == FUNC && vdef->lib != NULL) {
+		wputs(qname);
+		wputs(": definition hides library function\n");
+	    }
 #endif
-	dpush(ep);
+#endif
+	if (ep->type == ':')
+	    dremove(qname);
+	else
+	    dclear(qname);
+	dpush(qname, ep);
     }
     if (nextc != EOF) {
 	if (nextc != ';')
@@ -386,18 +546,20 @@ loaddefn()			/* load next definition */
 
 EPNODE *
 getdefn()			/* A -> SYM = E1 */
-				/*      FUNC(SYM,..) = E1 */
+				/*	SYM : E1 */
+				/*	FUNC(SYM,..) = E1 */
+				/*	FUNC(SYM,..) : E1 */
 {
     register EPNODE  *ep1, *ep2;
 
-    if (!isalpha(nextc))
+    if (!isalpha(nextc) && nextc != CNTXMARK)
 	syntax("illegal variable name");
 
     ep1 = newnode();
     ep1->type = SYM;
     ep1->v.name = savestr(getname());
 
-#ifdef  FUNCTION
+#ifdef	FUNCTION
     if (nextc == '(') {
 	ep2 = newnode();
 	ep2->type = FUNC;
@@ -420,19 +582,20 @@ getdefn()			/* A -> SYM = E1 */
 	curfunc = NULL;
 #endif
 
-    if (nextc != '=')
-	syntax("'=' expected");
-    scan();
+    if (nextc != '=' && nextc != ':')
+	syntax("'=' or ':' expected");
 
     ep2 = newnode();
-    ep2->type = '=';
+    ep2->type = nextc;
+    scan();
     addekid(ep2, ep1);
     addekid(ep2, getE1());
 
-#ifdef  FUNCTION
-    if (ep1->type == SYM)
+    if (
+#ifdef	FUNCTION
+	    ep1->type == SYM &&
 #endif
-    {
+	    ep1->sibling->type != NUM) {
 	ep1 = newnode();
 	ep1->type = TICK;
 	ep1->v.tick = -1;
@@ -446,7 +609,7 @@ getdefn()			/* A -> SYM = E1 */
 }
 
 
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
 EPNODE *
 getchan()			/* A -> $N = E1 */
 {
@@ -483,7 +646,7 @@ getchan()			/* A -> $N = E1 */
 static double
 dvalue(name, d)			/* evaluate a variable */
 char  *name;
-EPNODE  *d;
+EPNODE	*d;
 {
     register EPNODE  *ep1, *ep2;
     
@@ -497,7 +660,7 @@ EPNODE  *d;
 	return(ep1->v.num);			/* return if number */
     ep2 = ep1->sibling;				/* check time */
     if (ep2->v.tick < 0 || ep2->v.tick < eclock) {
-	ep2->v.tick = eclock;
+	ep2->v.tick = d->type == ':' ? 1L<<30 : eclock;
 	ep2 = ep2->sibling;
 	ep2->v.num = evalue(ep1);		/* needs new value */
     } else