--- ray/src/common/caldefn.c	1991/11/12 16:55:27	2.1
+++ ray/src/common/caldefn.c	1995/02/16 09:49:27	2.7
@@ -1,4 +1,4 @@
-/* Copyright (c) 1991 Regents of the University of California */
+/* Copyright (c) 1992 Regents of the University of California */
 
 #ifndef lint
 static char SCCSid[] = "$SunId$ LBL";
@@ -30,15 +30,15 @@ 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  hash(s)	(shash(s)%NHASH)
 
-extern char  *ecalloc(), *savestr(), *strcpy();
+#define	 newnode()	(EPNODE *)ecalloc(1, sizeof(EPNODE))
 
-static int  hash();
+extern char  *ecalloc(), *emalloc(), *savestr(), *strcpy();
 
 static double  dvalue();
 
@@ -49,18 +49,18 @@ static char  context[MAXWORD+1];	/* current context pa
 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
 
 
@@ -105,7 +105,7 @@ char  *vname;
 
 double
 evariable(ep)			/* evaluate a variable */
-EPNODE  *ep;
+EPNODE	*ep;
 {
     register VARDEF  *dp = ep->v.ln;
 
@@ -116,7 +116,7 @@ EPNODE  *ep;
 varset(vname, assign, val)	/* set a variable's value */
 char  *vname;
 int  assign;
-double  val;
+double	val;
 {
     char  *qname;
     register EPNODE  *ep1, *ep2;
@@ -189,14 +189,15 @@ register char  *ctx;
 
     if (ctx == NULL)
 	return(context);		/* just asking */
+    while (*ctx == CNTXMARK)
+	ctx++;				/* skip past marks */
     if (!*ctx) {
-	context[0] = '\0';		/* clear context */
+	context[0] = '\0';		/* empty means clear context */
 	return(context);
     }
-    cpp = context;			/* else copy it (carefully!) */
-    if (*ctx != CNTXMARK)
-	*cpp++ = CNTXMARK;		/* make sure there's a mark */
-    do {
+    cpp = context;			/* start context with mark */
+    *cpp++ = CNTXMARK;
+    do {				/* carefully copy new context */
 	if (cpp >= context+MAXWORD)
 	    break;			/* just copy what we can */
 	if (isid(*ctx))
@@ -205,17 +206,56 @@ register char  *ctx;
 	    *cpp++ = '_'; ctx++;
 	}
     } while (*ctx);
+    while (cpp[-1] == CNTXMARK)		/* cannot end in context mark */
+	cpp--;
     *cpp = '\0';
     return(context);
 }
 
 
 char *
+pushcontext(ctx)		/* push on another context */
+char  *ctx;
+{
+    extern char  *strncpy(), *strcpy();
+    char  oldcontext[MAXWORD+1];
+    register int  n;
+
+    strcpy(oldcontext, context);	/* save old context */
+    setcontext(ctx);			/* set new context */
+    n = strlen(context);		/* tack on old */
+    if (n+strlen(oldcontext) > MAXWORD) {
+	strncpy(context+n, oldcontext, MAXWORD-n);
+	context[MAXWORD] = '\0';
+    } else
+	strcpy(context+n, oldcontext);
+    return(context);
+}
+
+
+char *
+popcontext()			/* pop off top context */
+{
+    register char  *cp1, *cp2;
+
+    if (!context[0])			/* nothing left to pop */
+	return(context);
+    cp2 = context;			/* find mark */
+    while (*++cp2 && *cp2 != CNTXMARK)
+	;
+    cp1 = context;			/* copy tail to front */
+    while (*cp1++ = *cp2++)
+	;
+    return(context);
+}
+
+
+char *
 qualname(nam, lvl)		/* get qualified name */
 register char  *nam;
 int  lvl;
 {
-    static char  nambuf[MAXWORD+1];
+    static char	 nambuf[MAXWORD+1];
     register char  *cp = nambuf, *cpp;
 				/* check for explicit local */
     if (*nam == CNTXMARK)
@@ -265,7 +305,7 @@ register char  *qn;
 }
 
 
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
 chanout(cs)			/* set output channels */
 int  (*cs)();
 {
@@ -292,7 +332,7 @@ int  lvl;
 		    dremove(vp->name);
 		else
 		    dclear(vp->name);
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     if (lvl >= 1) {
 	for (ep = outchan; ep != NULL; ep = ep->sibling)
 	    epfree(ep);
@@ -309,7 +349,7 @@ char  *name;
     register VARDEF  *vp;
     
     if ((vp = varlookup(name)) == NULL)
-    	return(NULL);
+	return(NULL);
     return(vp->def);
 }
 
@@ -318,10 +358,10 @@ VARDEF *
 varlookup(name)			/* look up a variable */
 char  *name;
 {
-    int  lvl = 0;
+    int	 lvl = 0;
     register char  *qname;
     register VARDEF  *vp;
-    				/* find most qualified match */
+				/* 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))
@@ -335,49 +375,62 @@ varinsert(name)			/* get a link to a variable */
 char  *name;
 {
     register VARDEF  *vp;
-    LIBR  *libp;
-    int  hv;
+    int	 hv;
     
     if ((vp = varlookup(name)) != NULL) {
 	vp->nlinks++;
 	return(vp);
     }
-#ifdef  FUNCTION
-    libp = liblookup(name);
+    vp = (VARDEF *)emalloc(sizeof(VARDEF));
+#ifdef	FUNCTION
+    vp->lib = liblookup(name);
 #else
-    libp = NULL;
+    vp->lib = NULL;
 #endif
-    if (libp == NULL)			/* if name not in library */
+    if (vp->lib == NULL)		/* if name not in library */
 	name = qualname(name, 0);	/* use fully qualified version */
     hv = hash(name);
-    vp = (VARDEF *)emalloc(sizeof(VARDEF));
     vp->name = savestr(name);
     vp->nlinks = 1;
     vp->def = NULL;
-    vp->lib = libp;
     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);
@@ -389,7 +442,7 @@ dfirst()			/* return pointer to first definition */
 {
     htndx = 0;
     htpos = NULL;
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     ochpos = outchan;
 #endif
     return(dnext());
@@ -403,19 +456,19 @@ dnext()				/* return pointer to next definition */
     register char  *nm;
 
     while (htndx < NHASH) {
-    	if (htpos == NULL)
-    		htpos = hashtbl[htndx++];
-    	while (htpos != NULL) {
-    	    ep = htpos->def;
+	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);
-    	}
+	    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);
@@ -431,7 +484,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);
@@ -441,7 +494,7 @@ char  *name;
 
 dpush(nm, ep)			/* push on a definition */
 char  *nm;
-register EPNODE  *ep;
+register EPNODE	 *ep;
 {
     register VARDEF  *vp;
 
@@ -451,11 +504,11 @@ register EPNODE  *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)
@@ -492,7 +545,7 @@ getstatement()			/* get next statement */
 	scan();
 	return;
     }
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
     if (nextc == '$') {		/* channel assignment */
 	ep = getchan();
 	addchan(ep);
@@ -501,16 +554,16 @@ getstatement()			/* get next statement */
     {				/* ordinary definition */
 	ep = getdefn();
 	qname = qualname(dname(ep), 0);
-#ifdef  REDEFW
+#ifdef	REDEFW
 	if ((vdef = varlookup(qname)) != NULL)
-	    if (vdef->def != NULL) {
+	    if (vdef->def != NULL && epcmp(ep, vdef->def)) {
 		wputs(qname);
 		if (vdef->def->type == ':')
 		    wputs(": redefined constant expression\n");
 		else
 		    wputs(": redefined\n");
 	    }
-#ifdef  FUNCTION
+#ifdef	FUNCTION
 	    else if (ep->v.kid->type == FUNC && vdef->lib != NULL) {
 		wputs(qname);
 		wputs(": definition hides library function\n");
@@ -534,7 +587,7 @@ getstatement()			/* get next statement */
 EPNODE *
 getdefn()			/* A -> SYM = E1 */
 				/*	SYM : E1 */
-				/*      FUNC(SYM,..) = E1 */
+				/*	FUNC(SYM,..) = E1 */
 				/*	FUNC(SYM,..) : E1 */
 {
     register EPNODE  *ep1, *ep2;
@@ -546,7 +599,7 @@ getdefn()			/* A -> SYM = E1 */
     ep1->type = SYM;
     ep1->v.name = savestr(getname());
 
-#ifdef  FUNCTION
+#ifdef	FUNCTION
     if (nextc == '(') {
 	ep2 = newnode();
 	ep2->type = FUNC;
@@ -579,8 +632,8 @@ getdefn()			/* A -> SYM = E1 */
     addekid(ep2, getE1());
 
     if (
-#ifdef  FUNCTION
-    	    ep1->type == SYM &&
+#ifdef	FUNCTION
+	    ep1->type == SYM &&
 #endif
 	    ep1->sibling->type != NUM) {
 	ep1 = newnode();
@@ -596,7 +649,7 @@ getdefn()			/* A -> SYM = E1 */
 }
 
 
-#ifdef  OUTCHAN
+#ifdef	OUTCHAN
 EPNODE *
 getchan()			/* A -> $N = E1 */
 {
@@ -633,7 +686,7 @@ getchan()			/* A -> $N = E1 */
 static double
 dvalue(name, d)			/* evaluate a variable */
 char  *name;
-EPNODE  *d;
+EPNODE	*d;
 {
     register EPNODE  *ep1, *ep2;
     
@@ -654,17 +707,4 @@ EPNODE  *d;
 	ep2 = ep2->sibling;			/* else reuse old value */
 
     return(ep2->v.num);
-}
-
-
-static int
-hash(s)				/* hash a string */
-register char  *s;
-{
-    register int  rval = 0;
-
-    while (*s)
-	rval += *s++;
-    
-    return(rval % NHASH);
 }