--- ray/src/common/caldefn.c	1990/07/19 11:06:37	1.4
+++ ray/src/common/caldefn.c	1991/08/08 12:12:16	1.14
@@ -1,4 +1,4 @@
-/* Copyright (c) 1986 Regents of the University of California */
+/* Copyright (c) 1991 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>
@@ -32,12 +36,14 @@ static char SCCSid[] = "$SunId$ LBL";
 
 #define  newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
 
-extern char  *ecalloc(), *savestr();
+extern char  *ecalloc(), *savestr(), *strcpy();
 
 static double  dvalue();
 
 long  eclock = -1;			/* value storage timer */
 
+static char  context[MAXWORD];		/* current context path */
+
 static VARDEF  *hashtbl[NHASH];		/* definition list */
 static int  htndx;			/* index for */		
 static VARDEF  *htpos;			/* ...dfirst() and */
@@ -70,7 +76,7 @@ char  *fname;
     }
     initfile(fp, fname, 0);
     while (nextc != EOF)
-	loaddefn();
+	getstatement();
     if (fname != NULL)
 	fclose(fp);
 }
@@ -83,7 +89,7 @@ int  ln;
 {
     initstr(str, fn, ln);
     while (nextc != EOF)
-	loaddefn();
+	getstatement();
 }
 
 
@@ -105,23 +111,27 @@ EPNODE  *ep;
 }
 
 
-varset(vname, val)		/* set a variable's value */
+varset(vname, assign, val)	/* set a variable's value */
 char  *vname;
+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;
-	    ep2->sibling->v.tick = -1;
+	    ep1->type = assign;
 	    return;
 	}
     }
 					/* hand build definition */
     ep1 = newnode();
-    ep1->type = '=';
+    ep1->type = assign;
     ep2 = newnode();
     ep2->type = SYM;
     ep2->v.name = savestr(vname);
@@ -130,23 +140,31 @@ double  val;
     ep2->type = NUM;
     ep2->v.num = val;
     addekid(ep1, ep2);
-    ep2 = newnode();
-    ep2->type = TICK;
-    ep2->v.tick = -1;
-    addekid(ep1, ep2);
-    ep2 = newnode();
-    ep2->type = NUM;
-    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);
 }
@@ -161,31 +179,127 @@ char  *name;
 }
 
 
+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-1) {
+	    *cpp = '\0';
+	    wputs(context);
+	    wputs(": context path too long\n");
+	    return(NULL);
+	}
+	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];
+    register char  *cp = nambuf, *cpp = context;
+				/* check for repeat call */
+    if (nam == nambuf)
+	return(lvl > 0 ? NULL : nambuf);
+				/* copy name to static buffer */
+    while (*nam) {
+	if (cp >= nambuf+MAXWORD-1)
+		goto toolong;
+	if ((*cp++ = *nam++) == CNTXMARK)
+	    cpp = NULL;		/* flag a qualified name */
+    }
+    if (cpp == NULL) {
+	if (lvl > 0)
+	    return(NULL);		/* no higher level */
+	if (cp[-1] == CNTXMARK) {
+	    cp--; cpp = context;	/* current context explicitly */
+	} else
+	    cpp = "";			/* else fully qualified */
+    } else			/* 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-1)
+	    goto toolong;
+	*cp++ = *cpp++;
+    }
+    *cp = '\0';
+    return(nambuf);		/* return qualified name */
+toolong:
+    *cp = '\0';
+    eputs(nambuf);
+    eputs(": name too long\n");
+    quit(1);
+}
+
+
+incontext(qn)			/* is qualified name in current context? */
+register char  *qn;
+{
+    while (*qn && *qn != CNTXMARK)	/* find context mark */
+	;
+    return(!strcmp(qn, context));
+}
+
+
 #ifdef  OUTCHAN
-chanout()			/* set output channels */
+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);
+	    if (!context[0] || incontext(vp->name))
+		if (lvl >= 2)
+		    dremove(vp->name);
+		else
+		    dclear(vp->name);
 #ifdef  OUTCHAN
-    for (ep = outchan; ep != NULL; ep = ep->sibling)
-	epfree(ep);
-    outchan = NULL;
+    if (lvl >= 1) {
+	for (ep = outchan; ep != NULL; ep = ep->sibling)
+	    epfree(ep);
+	outchan = NULL;
+    }
 #endif
 }
 
@@ -206,11 +320,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);
 }
 
@@ -222,12 +339,12 @@ char  *name;
     register VARDEF  *vp;
     int  hv;
     
+    if ((vp = varlookup(name)) != NULL) {
+	vp->nlinks++;
+	return(vp);
+    }
+    name = qualname(name, 0);		/* use fully qualified name */
     hv = hash(name);
-    for (vp = hashtbl[hv]; vp != NULL; vp = vp->next)
-    	if (!strcmp(vp->name, name)) {
-    	    vp->nlinks++;
-    	    return(vp);
-    	}
     vp = (VARDEF *)emalloc(sizeof(VARDEF));
     vp->name = savestr(name);
     vp->nlinks = 1;
@@ -315,12 +432,13 @@ char  *name;
 }
 
 
-dpush(ep)			/* push on a definition */
+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;
 }
@@ -357,9 +475,11 @@ EPNODE  *sp;
 #endif
 
 
-loaddefn()			/* load next definition */
+getstatement()			/* get next statement */
 {
     register EPNODE  *ep;
+    char  *qname;
+    EPNODE  *lastdef;
 
     if (nextc == ';') {		/* empty statement */
 	scan();
@@ -373,16 +493,27 @@ loaddefn()			/* load next definition */
 #endif
     {				/* ordinary definition */
 	ep = getdefn();
+	qname = qualname(dname(ep), 0);
 #ifdef  REDEFW
-	if (dlookup(dname(ep)) != NULL) {
-		dclear(dname(ep));
-		wputs(dname(ep));
+	if ((lastdef = dlookup(qname)) != NULL) {
+	    wputs(qname);
+	    if (lastdef->type == ':')
+		wputs(": redefined constant expression\n");
+	    else
 		wputs(": redefined\n");
 	}
-#else
-	dclear(dname(ep));
+#ifdef  FUNCTION
+	else if (ep->v.kid->type == FUNC && liblookup(qname) != 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 != ';')
@@ -394,7 +525,9 @@ loaddefn()			/* load next definition */
 
 EPNODE *
 getdefn()			/* A -> SYM = E1 */
+				/*	SYM : E1 */
 				/*      FUNC(SYM,..) = E1 */
+				/*	FUNC(SYM,..) : E1 */
 {
     register EPNODE  *ep1, *ep2;
 
@@ -428,19 +561,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());
 
+    if (
 #ifdef  FUNCTION
-    if (ep1->type == SYM)
+    	    ep1->type == SYM &&
 #endif
-    {
+	    ep1->sibling->type != NUM) {
 	ep1 = newnode();
 	ep1->type = TICK;
 	ep1->v.tick = -1;
@@ -501,13 +635,15 @@ EPNODE  *d;
 	quit(1);
     }
     ep1 = d->v.kid->sibling;			/* get expression */
+    if (ep1->type == NUM)
+	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);		/* compute new value */
+	ep2->v.num = evalue(ep1);		/* needs new value */
     } else
-	ep2 = ep2->sibling;			/* reuse old value */
+	ep2 = ep2->sibling;			/* else reuse old value */
 
     return(ep2->v.num);
 }