--- ray/src/common/caldefn.c	2003/07/17 09:21:29	2.18
+++ ray/src/common/caldefn.c	2024/06/20 21:21:24	2.39
@@ -1,5 +1,5 @@
 #ifndef lint
-static const char	RCSid[] = "$Id: caldefn.c,v 2.18 2003/07/17 09:21:29 schorsch Exp $";
+static const char	RCSid[] = "$Id: caldefn.c,v 2.39 2024/06/20 21:21:24 greg Exp $";
 #endif
 /*
  *  Store variable definitions.
@@ -27,11 +27,11 @@ static const char	RCSid[] = "$Id: caldefn.c,v 2.18 200
 
 #include "copyright.h"
 
-#include  <stdio.h>
-#include  <string.h>
 #include  <ctype.h>
 
 #include  "rterror.h"
+#include  "rtio.h"
+#include  "rtmisc.h"
 #include  "calcomp.h"
 
 #ifndef	 NHASH
@@ -58,10 +58,9 @@ static VARDEF  *htpos;			/* ...dfirst() and */
 static EPNODE  *ochpos;			/* ...dnext */
 static EPNODE  *outchan;
 
+static int  optimized = 0;		/* are we optimized? */
+
 EPNODE	*curfunc = NULL;
-#define	 dname(ep)	((ep)->v.kid->type == SYM ? \
-			(ep)->v.kid->v.name : \
-			(ep)->v.kid->v.kid->v.name)
 
 
 void
@@ -78,11 +77,18 @@ fcompile(			/* get definitions from a file */
 	eputs(": cannot open\n");
 	quit(1);
     }
-    initfile(fp, fname, 0);
+#ifdef getc_unlocked			/* avoid stupid semaphores */
+    flockfile(fp);
+#endif
+   initfile(fp, fname, 0);
     while (nextc != EOF)
 	getstatement();
     if (fname != NULL)
 	fclose(fp);
+#ifdef getc_unlocked
+    else
+	funlockfile(fp);
+#endif
 }
 
 
@@ -113,7 +119,7 @@ evariable(			/* evaluate a variable */
 	EPNODE	*ep
 )
 {
-    register VARDEF  *dp = ep->v.ln;
+    VARDEF  *dp = ep->v.ln;
 
     return(dvalue(dp->name, dp->def));
 }
@@ -127,11 +133,12 @@ varset(		/* set a variable's value */
 )
 {
     char  *qname;
-    register EPNODE  *ep1, *ep2;
+    EPNODE  *ep1, *ep2;
 					/* get qualified name */
     qname = qualname(vname, 0);
 					/* check for quick set */
-    if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) {
+    if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM &&
+		(ep1->type == ':') <= (assign == ':')) {
 	ep2 = ep1->v.kid->sibling;
 	if (ep2->type == NUM) {
 	    ep2->v.num = val;
@@ -139,6 +146,13 @@ varset(		/* set a variable's value */
 	    return;
 	}
     }
+    if (ep1 != NULL && esupport&E_REDEFW) {
+	wputs(qname);
+	if (ep1->type == ':')
+	    wputs(": reset constant expression\n");
+	else
+	    wputs(": reset expression\n");
+    }
 					/* hand build definition */
     ep1 = newnode();
     ep1->type = assign;
@@ -150,7 +164,10 @@ varset(		/* set a variable's value */
     ep2->type = NUM;
     ep2->v.num = val;
     addekid(ep1, ep2);
-    dremove(qname);
+    if (assign == ':')
+	dremove(qname);
+    else
+	dclear(qname);
     dpush(qname, ep1);
 }
 
@@ -160,14 +177,14 @@ dclear(			/* delete variable definitions of name */
 	char  *name
 )
 {
-    register EPNODE  *ep;
+    VARDEF  *vp;
+    EPNODE  *dp;
 
-    while ((ep = dpop(name)) != NULL) {
-	if (ep->type == ':') {
-	    dpush(name, ep);		/* don't clear constants */
-	    return;
-	}
-	epfree(ep);
+    while ((vp = varlookup(name)) != NULL &&
+    		(dp = vp->def) != NULL && dp->type == '=') {
+	vp->def = dp->sibling;
+	epfree(dp,1);
+	varfree(vp);
     }
 }
 
@@ -177,30 +194,33 @@ dremove(			/* delete all definitions of name */
 	char  *name
 )
 {
-    register EPNODE  *ep;
+    EPNODE  *ep;
 
     while ((ep = dpop(name)) != NULL)
-	epfree(ep);
+	epfree(ep,1);
 }
 
 
 int
-vardefined(	/* return non-zero if variable defined */
+vardefined(	/* return '=' or ':' if variable/constant defined */
 	char  *name
 )
 {
-    register EPNODE  *dp;
+    EPNODE  *dp = dlookup(name);
 
-    return((dp = dlookup(name)) != NULL && dp->v.kid->type == SYM);
+    if (dp == NULL || dp->v.kid->type != SYM)
+    	return(0);
+
+    return(dp->type);
 }
 
 
 char *
-setcontext(			/* set a new context path */
-	register char  *ctx
+calcontext(			/* set a new context path */
+	char  *ctx
 )
 {
-    register char  *cpp;
+    char  *cpp;
 
     if (ctx == NULL)
 	return(context);		/* just asking */
@@ -234,10 +254,10 @@ pushcontext(		/* push on another context */
 )
 {
     char  oldcontext[MAXCNTX+1];
-    register int  n;
+    int  n;
 
     strcpy(oldcontext, context);	/* save old context */
-    setcontext(ctx);			/* set new context */
+    calcontext(ctx);			/* set new context */
     n = strlen(context);		/* tack on old */
     if (n+strlen(oldcontext) > MAXCNTX) {
 	strncpy(context+n, oldcontext, MAXCNTX-n);
@@ -251,7 +271,7 @@ pushcontext(		/* push on another context */
 char *
 popcontext(void)			/* pop off top context */
 {
-    register char  *cp1, *cp2;
+    char  *cp1, *cp2;
 
     if (!context[0])			/* nothing left to pop */
 	return(context);
@@ -259,7 +279,7 @@ popcontext(void)			/* pop off top context */
     while (*++cp2 && *cp2 != CNTXMARK)
 	;
     cp1 = context;			/* copy tail to front */
-    while (*cp1++ = *cp2++)
+    while ( (*cp1++ = *cp2++) )
 	;
     return(context);
 }
@@ -267,19 +287,18 @@ popcontext(void)			/* pop off top context */
 
 char *
 qualname(		/* get qualified name */
-	register char  *nam,
+	char  *nam,
 	int  lvl
 )
 {
     static char	 nambuf[RMAXWORD+1];
-    register char  *cp = nambuf, *cpp;
+    char  *cp = nambuf, *cpp;
 				/* check for explicit local */
-    if (*nam == CNTXMARK)
+    if (*nam == CNTXMARK) {
 	if (lvl > 0)		/* only action is to refuse search */
 	    return(NULL);
-	else
-	    nam++;
-    else if (nam == nambuf)	/* check for repeat call */
+	nam++;
+    } else if (nam == nambuf)	/* check for repeat call */
 	return(lvl > 0 ? NULL : nam);
 				/* copy name to static buffer */
     while (*nam) {
@@ -301,7 +320,7 @@ qualname(		/* get qualified name */
 	while (*++cpp && *cpp != CNTXMARK)
 	    ;
     }
-    while (*cpp) {		/* copy context to static buffer */
+    while (*cpp) {		/* add remaining context to name */
 	if (cp >= nambuf+RMAXWORD)
 	    goto toolong;
 	*cp++ = *cpp++;
@@ -314,7 +333,7 @@ toolong:
 
 int
 incontext(			/* is qualified name in current context? */
-	register char  *qn
+	char  *qn
 )
 {
     if (!context[0])			/* global context accepts all */
@@ -330,7 +349,7 @@ chanout(			/* set output channels */
 	void  (*cs)(int n, double v)
 )
 {
-    register EPNODE  *ep;
+    EPNODE  *ep;
 
     for (ep = outchan; ep != NULL; ep = ep->sibling)
 	(*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
@@ -339,26 +358,44 @@ chanout(			/* set output channels */
 
 
 void
+doptimize(int activate)		/* optimize current and future definitions? */
+{
+    EPNODE	*ep;
+
+    if (activate && optimized)
+    	return;			/* already going */
+
+    if (!(optimized = activate))
+    	return;			/* switching off */
+
+    for (ep = dfirst(); ep != NULL; ep = dnext())
+    	epoptimize(ep);
+}
+
+
+void
 dcleanup(		/* clear definitions (0->vars,1->output,2->consts) */
 	int  lvl
 )
 {
-    register int  i;
-    register VARDEF  *vp;
-    register EPNODE  *ep;
+    int  i;
+    VARDEF  *vp;
+    EPNODE  *ep;
 				/* if context is global, clear all */
     for (i = 0; i < NHASH; i++)
 	for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
-	    if (incontext(vp->name))
+	    if (incontext(vp->name)) {
 		if (lvl >= 2)
 		    dremove(vp->name);
 		else
 		    dclear(vp->name);
-    if (lvl >= 1) {
-	for (ep = outchan; ep != NULL; ep = ep->sibling)
-	    epfree(ep);
-	outchan = NULL;
-    }
+	    }
+    if (lvl >= 1)
+    	while (outchan != NULL) {
+    	    ep = outchan;
+    	    outchan = ep->sibling;
+	    epfree(ep,1);
+	}
 }
 
 
@@ -367,7 +404,7 @@ dlookup(			/* look up a definition */
 	char  *name
 )
 {
-    register VARDEF  *vp;
+    VARDEF  *vp;
     
     if ((vp = varlookup(name)) == NULL)
 	return(NULL);
@@ -381,8 +418,8 @@ varlookup(			/* look up a variable */
 )
 {
     int	 lvl = 0;
-    register char  *qname;
-    register VARDEF  *vp;
+    char  *qname;
+    VARDEF  *vp;
 				/* find most qualified match */
     while ((qname = qualname(name, lvl++)) != NULL)
 	for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next)
@@ -397,7 +434,7 @@ varinsert(			/* get a link to a variable */
 	char  *name
 )
 {
-    register VARDEF  *vp;
+    VARDEF  *vp;
     int	 hv;
     
     if ((vp = varlookup(name)) != NULL) {
@@ -423,22 +460,22 @@ libupdate(			/* update library links */
 	char  *fn
 )
 {
-    register int  i;
-    register VARDEF  *vp;
+    int  i;
+    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))
+	    if ((vp->lib != NULL) | (fn == NULL) || !strcmp(fn, vp->name))
 		vp->lib = liblookup(vp->name);
 }
 
 
 void
 varfree(				/* release link to variable */
-	register VARDEF	 *ln
+	VARDEF	 *ln
 )
 {
-    register VARDEF  *vp;
+    VARDEF  *vp;
     int	 hv;
 
     if (--ln->nlinks > 0)
@@ -454,7 +491,7 @@ varfree(				/* release link to variable */
 	vp->next = ln->next;
     }
     freestr(ln->name);
-    efree((char *)ln);
+    efree(ln);
 }
 
 
@@ -471,8 +508,8 @@ dfirst(void)			/* return pointer to first definition *
 EPNODE *
 dnext(void)				/* return pointer to next definition */
 {
-    register EPNODE  *ep;
-    register char  *nm;
+    EPNODE  *ep;
+    char  *nm;
 
     while (htndx < NHASH) {
 	if (htpos == NULL)
@@ -496,8 +533,8 @@ dpop(			/* pop a definition */
 	char  *name
 )
 {
-    register VARDEF  *vp;
-    register EPNODE  *dp;
+    VARDEF  *vp;
+    EPNODE  *dp;
     
     if ((vp = varlookup(name)) == NULL || vp->def == NULL)
 	return(NULL);
@@ -511,10 +548,10 @@ dpop(			/* pop a definition */
 void
 dpush(			/* push on a definition */
 	char  *nm,
-	register EPNODE	 *ep
+	EPNODE	 *ep
 )
 {
-    register VARDEF  *vp;
+    VARDEF  *vp;
 
     vp = varinsert(nm);
     ep->sibling = vp->def;
@@ -528,7 +565,7 @@ addchan(			/* add an output channel assignment */
 )
 {
     int	 ch = sp->v.kid->v.chan;
-    register EPNODE  *ep, *epl;
+    EPNODE  *ep, *epl;
 
     for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling)
 	if (ep->v.kid->v.chan >= ch) {
@@ -540,7 +577,7 @@ addchan(			/* add an output channel assignment */
 		sp->sibling = ep;
 	    else {
 		sp->sibling = ep->sibling;
-		epfree(ep);
+		epfree(ep,1);
 	    }
 	    return;
 	}
@@ -556,9 +593,9 @@ addchan(			/* add an output channel assignment */
 void
 getstatement(void)			/* get next statement */
 {
-    register EPNODE  *ep;
+    EPNODE  *ep;
     char  *qname;
-    register VARDEF  *vdef;
+    VARDEF  *vdef;
 
     if (nextc == ';') {		/* empty statement */
 	scan();
@@ -567,11 +604,15 @@ getstatement(void)			/* get next statement */
     if (esupport&E_OUTCHAN &&
 		nextc == '$') {		/* channel assignment */
 	ep = getchan();
+	if (optimized)
+	    epoptimize(ep);		/* optimize new chan expr */
 	addchan(ep);
     } else {				/* ordinary definition */
 	ep = getdefn();
-	qname = qualname(dname(ep), 0);
-	if (esupport&E_REDEFW && (vdef = varlookup(qname)) != NULL)
+    	if (optimized)
+    	    epoptimize(ep);		/* optimize new statement */
+	qname = qualname(dfn_name(ep), 0);
+	if (esupport&E_REDEFW && (vdef = varlookup(qname)) != NULL) {
 	    if (vdef->def != NULL && epcmp(ep, vdef->def)) {
 		wputs(qname);
 		if (vdef->def->type == ':')
@@ -582,6 +623,7 @@ getstatement(void)			/* get next statement */
 		wputs(qname);
 		wputs(": definition hides library function\n");
 	    }
+	}
 	if (ep->type == ':')
 	    dremove(qname);
 	else
@@ -603,9 +645,9 @@ getdefn(void)
 	/*	FUNC(SYM,..) = E1 */
 	/*	FUNC(SYM,..) : E1 */
 {
-    register EPNODE  *ep1, *ep2;
+    EPNODE  *ep1, *ep2;
 
-    if (!isalpha(nextc) && nextc != CNTXMARK)
+    if (!isalpha(nextc) & (nextc != CNTXMARK))
 	syntax("illegal variable name");
 
     ep1 = newnode();
@@ -620,10 +662,12 @@ getdefn(void)
 	do {
 	    scan();
 	    if (!isalpha(nextc))
-		syntax("illegal variable name");
+		syntax("illegal parameter name");
 	    ep2 = newnode();
 	    ep2->type = SYM;
 	    ep2->v.name = savestr(getname());
+	    if (strchr(ep2->v.name, CNTXMARK) != NULL)
+		syntax("illegal parameter name");
 	    addekid(ep1, ep2);
 	} while (nextc == ',');
 	if (nextc != ')')
@@ -632,7 +676,7 @@ getdefn(void)
 	curfunc = ep1;
     }
 
-    if (nextc != '=' && nextc != ':')
+    if ((nextc != '=') & (nextc != ':'))
 	syntax("'=' or ':' expected");
 
     ep2 = newnode();
@@ -643,7 +687,7 @@ getdefn(void)
 
     if (ep1->type == SYM && ep1->sibling->type != NUM) {
 	ep1 = newnode();
-	ep1->type = TICK;
+	ep1->type = CLKT;
 	ep1->v.tick = 0;
 	addekid(ep2, ep1);
 	ep1 = newnode();
@@ -659,7 +703,7 @@ getdefn(void)
 EPNODE *
 getchan(void)			/* A -> $N = E1 */
 {
-    register EPNODE  *ep1, *ep2;
+    EPNODE  *ep1, *ep2;
 
     if (nextc != '$')
 	syntax("missing '$'");
@@ -689,9 +733,9 @@ getchan(void)			/* A -> $N = E1 */
 
 
 static double			/* evaluate a variable */
-dvalue(char  *name, EPNODE	*d)
+dvalue(char *name, EPNODE *d)
 {
-    register EPNODE  *ep1, *ep2;
+    EPNODE  *ep1, *ep2;
     
     if (d == NULL || d->v.kid->type != SYM) {
 	eputs(name);
@@ -701,11 +745,15 @@ dvalue(char  *name, EPNODE	*d)
     ep1 = d->v.kid->sibling;			/* get expression */
     if (ep1->type == NUM)
 	return(ep1->v.num);			/* return if number */
+    if (esupport&E_RCONST && d->type == ':') {
+	wputs(name);
+	wputs(": assigned non-constant value\n");
+    }
     ep2 = ep1->sibling;				/* check time */
     if (eclock >= MAXCLOCK)
 	eclock = 1;				/* wrap clock counter */
     if (ep2->v.tick < MAXCLOCK &&
-		ep2->v.tick == 0 | ep2->v.tick != eclock) {
+		(ep2->v.tick == 0) | (ep2->v.tick != eclock)) {
 	ep2->v.tick = d->type == ':' ? MAXCLOCK : eclock;
 	ep2 = ep2->sibling;
 	ep2->v.num = evalue(ep1);		/* needs new value */