ViewVC Help

View File | Revision Log | Show Annotations | Download File | Root Listing

root/Development/ray/src/common/caldefn.c

Comparing ray/src/common/caldefn.c (file contents):
Revision 1.5 by greg, Thu Jul 19 11:15:31 1990 UTC vs.
Revision 2.7 by greg, Thu Feb 16 09:49:27 1995 UTC

#	Line 1 | Line 1
1	<	/* Copyright (c) 1986 Regents of the University of California */
1	>	/* Copyright (c) 1992 Regents of the University of California */
2
3		#ifndef lint
4		static char SCCSid[] = "$SunId$ LBL";
#	Line 18 | Line 18 | static char SCCSid[] = "$SunId$ LBL";
18		*  11/16/88  Added VARDEF structure for hard linking.
19		*
20		*  5/31/90  Added conditional compile (REDEFW) for redefinition warning.
21	+	*
22	+	*  4/23/91  Added ':' assignment for constant expressions
23	+	*
24	+	*  8/7/91  Added optional context path to append to variable names
25		*/
26
27		#include  <stdio.h>
#	Line 26 | Line 30 | static char SCCSid[] = "$SunId$ LBL";
30
31		#include  "calcomp.h"
32
33	<	#ifndef  NHASH
34	<	#define  NHASH          521             /* hash size (a prime!) */
33	>	#ifndef  NHASH
34	>	#define  NHASH          521             /* hash size (a prime!) */
35		#endif
36
37	<	#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))
37	>	#define  hash(s)        (shash(s)%NHASH)
38
39	<	extern char  *ecalloc(), *savestr();
39	>	#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))
40
41	+	extern char  *ecalloc(), *emalloc(), *savestr(), *strcpy();
42	+
43		static double  dvalue();
44
45		long  eclock = -1;                      /* value storage timer */
46
47	+	static char  context[MAXWORD+1];        /* current context path */
48	+
49		static VARDEF  *hashtbl[NHASH];         /* definition list */
50		static int  htndx;                      /* index for */
51		static VARDEF  *htpos;                  /* ...dfirst() and */
52	<	#ifdef  OUTCHAN
52	>	#ifdef  OUTCHAN
53		static EPNODE  *ochpos;                 /* ...dnext */
54		static EPNODE  *outchan;
55		#endif
56
57	<	#ifdef  FUNCTION
58	<	EPNODE  *curfunc;
59	<	#define  dname(ep)      ((ep)->v.kid->type == SYM ? \
57	>	#ifdef  FUNCTION
58	>	EPNODE  *curfunc;
59	>	#define  dname(ep)      ((ep)->v.kid->type == SYM ? \
60		(ep)->v.kid->v.name : \
61		(ep)->v.kid->v.kid->v.name)
62		#else
63	<	#define  dname(ep)      ((ep)->v.kid->v.name)
63	>	#define  dname(ep)      ((ep)->v.kid->v.name)
64		#endif
65
66
#	Line 70 | Line 78 | char  *fname;
78		}
79		initfile(fp, fname, 0);
80		while (nextc != EOF)
81	<	loaddefn();
81	>	getstatement();
82		if (fname != NULL)
83		fclose(fp);
84		}
#	Line 83 | Line 91 | int  ln;
91		{
92		initstr(str, fn, ln);
93		while (nextc != EOF)
94	<	loaddefn();
94	>	getstatement();
95		}
96
97
#	Line 97 | Line 105 | char  *vname;
105
106		double
107		evariable(ep)                   /* evaluate a variable */
108	<	EPNODE  *ep;
108	>	EPNODE  *ep;
109		{
110		register VARDEF  *dp = ep->v.ln;
111
#	Line 105 | Line 113 | EPNODE  *ep;
113		}
114
115
116	<	varset(vname, val)              /* set a variable's value */
116	>	varset(vname, assign, val)      /* set a variable's value */
117		char  *vname;
118	<	double  val;
118	>	int  assign;
119	>	double  val;
120		{
121	+	char  *qname;
122		register EPNODE  *ep1, *ep2;
123	+	/* get qualified name */
124	+	qname = qualname(vname, 0);
125		/* check for quick set */
126	<	if ((ep1 = dlookup(vname)) != NULL && ep1->v.kid->type == SYM) {
126	>	if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) {
127		ep2 = ep1->v.kid->sibling;
128		if (ep2->type == NUM) {
129		ep2->v.num = val;
130	+	ep1->type = assign;
131		return;
132		}
133		}
134		/* hand build definition */
135		ep1 = newnode();
136	<	ep1->type = '=';
136	>	ep1->type = assign;
137		ep2 = newnode();
138		ep2->type = SYM;
139		ep2->v.name = savestr(vname);
#	Line 129 | Line 142 | double  val;
142		ep2->type = NUM;
143		ep2->v.num = val;
144		addekid(ep1, ep2);
145	<	dclear(vname);
146	<	dpush(ep1);
145	>	dremove(qname);
146	>	dpush(qname, ep1);
147		}
148
149
150	<	dclear(name)                    /* delete all definitions of name */
150	>	dclear(name)                    /* delete variable definitions of name */
151		char  *name;
152		{
153		register EPNODE  *ep;
154
155	+	while ((ep = dpop(name)) != NULL) {
156	+	if (ep->type == ':') {
157	+	dpush(name, ep);            /* don't clear constants */
158	+	return;
159	+	}
160	+	epfree(ep);
161	+	}
162	+	}
163	+
164	+
165	+	dremove(name)                   /* delete all definitions of name */
166	+	char  *name;
167	+	{
168	+	register EPNODE  *ep;
169	+
170		while ((ep = dpop(name)) != NULL)
171		epfree(ep);
172		}
#	Line 153 | Line 181 | char  *name;
181		}
182
183
184	<	#ifdef  OUTCHAN
185	<	chanout()                       /* set output channels */
184	>	char *
185	>	setcontext(ctx)                 /* set a new context path */
186	>	register char  *ctx;
187		{
188	+	register char  *cpp;
189	+
190	+	if (ctx == NULL)
191	+	return(context);                /* just asking */
192	+	while (*ctx == CNTXMARK)
193	+	ctx++;                          /* skip past marks */
194	+	if (!*ctx) {
195	+	context[0] = '\0';              /* empty means clear context */
196	+	return(context);
197	+	}
198	+	cpp = context;                      /* start context with mark */
199	+	*cpp++ = CNTXMARK;
200	+	do {                                /* carefully copy new context */
201	+	if (cpp >= context+MAXWORD)
202	+	break;                      /* just copy what we can */
203	+	if (isid(*ctx))
204	+	*cpp++ = *ctx++;
205	+	else {
206	+	*cpp++ = '_'; ctx++;
207	+	}
208	+	} while (*ctx);
209	+	while (cpp[-1] == CNTXMARK)         /* cannot end in context mark */
210	+	cpp--;
211	+	*cpp = '\0';
212	+	return(context);
213	+	}
214	+
215	+
216	+	char *
217	+	pushcontext(ctx)                /* push on another context */
218	+	char  *ctx;
219	+	{
220	+	extern char  *strncpy(), *strcpy();
221	+	char  oldcontext[MAXWORD+1];
222	+	register int  n;
223	+
224	+	strcpy(oldcontext, context);        /* save old context */
225	+	setcontext(ctx);                    /* set new context */
226	+	n = strlen(context);                /* tack on old */
227	+	if (n+strlen(oldcontext) > MAXWORD) {
228	+	strncpy(context+n, oldcontext, MAXWORD-n);
229	+	context[MAXWORD] = '\0';
230	+	} else
231	+	strcpy(context+n, oldcontext);
232	+	return(context);
233	+	}
234	+
235	+
236	+	char *
237	+	popcontext()                    /* pop off top context */
238	+	{
239	+	register char  *cp1, *cp2;
240	+
241	+	if (!context[0])                    /* nothing left to pop */
242	+	return(context);
243	+	cp2 = context;                      /* find mark */
244	+	while (*++cp2 && *cp2 != CNTXMARK)
245	+	;
246	+	cp1 = context;                      /* copy tail to front */
247	+	while (*cp1++ = *cp2++)
248	+	;
249	+	return(context);
250	+	}
251	+
252	+
253	+	char *
254	+	qualname(nam, lvl)              /* get qualified name */
255	+	register char  *nam;
256	+	int  lvl;
257	+	{
258	+	static char  nambuf[MAXWORD+1];
259	+	register char  *cp = nambuf, *cpp;
260	+	/* check for explicit local */
261	+	if (*nam == CNTXMARK)
262	+	if (lvl > 0)            /* only action is to refuse search */
263	+	return(NULL);
264	+	else
265	+	nam++;
266	+	else if (nam == nambuf)     /* check for repeat call */
267	+	return(lvl > 0 ? NULL : nam);
268	+	/* copy name to static buffer */
269	+	while (*nam) {
270	+	if (cp >= nambuf+MAXWORD)
271	+	goto toolong;
272	+	*cp++ = *nam++;
273	+	}
274	+	/* check for explicit global */
275	+	if (cp > nambuf && cp[-1] == CNTXMARK) {
276	+	if (lvl > 0)
277	+	return(NULL);
278	+	*--cp = '\0';
279	+	return(nambuf);         /* already qualified */
280	+	}
281	+	cpp = context;              /* else skip the requested levels */
282	+	while (lvl-- > 0) {
283	+	if (!*cpp)
284	+	return(NULL);       /* return NULL if past global level */
285	+	while (*++cpp && *cpp != CNTXMARK)
286	+	;
287	+	}
288	+	while (*cpp) {              /* copy context to static buffer */
289	+	if (cp >= nambuf+MAXWORD)
290	+	goto toolong;
291	+	*cp++ = *cpp++;
292	+	}
293	+	toolong:
294	+	*cp = '\0';
295	+	return(nambuf);             /* return qualified name */
296	+	}
297	+
298	+
299	+	incontext(qn)                   /* is qualified name in current context? */
300	+	register char  *qn;
301	+	{
302	+	while (*qn && *qn != CNTXMARK)      /* find context mark */
303	+	qn++;
304	+	return(!strcmp(qn, context));
305	+	}
306	+
307	+
308	+	#ifdef  OUTCHAN
309	+	chanout(cs)                     /* set output channels */
310	+	int  (*cs)();
311	+	{
312		register EPNODE  *ep;
313
314		for (ep = outchan; ep != NULL; ep = ep->sibling)
315	<	chanset(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
315	>	(*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
316
317		}
318		#endif
319
320
321	<	dclearall()                     /* clear all definitions */
321	>	dcleanup(lvl)           /* clear definitions (0->vars,1->output,2->consts) */
322	>	int  lvl;
323		{
324		register int  i;
325		register VARDEF  *vp;
326		register EPNODE  *ep;
327	<
327	>	/* if context is global, clear all */
328		for (i = 0; i < NHASH; i++)
329		for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
330	<	dclear(vp->name);
331	<	#ifdef  OUTCHAN
332	<	for (ep = outchan; ep != NULL; ep = ep->sibling)
333	<	epfree(ep);
334	<	outchan = NULL;
330	>	if (!context[0] || incontext(vp->name))
331	>	if (lvl >= 2)
332	>	dremove(vp->name);
333	>	else
334	>	dclear(vp->name);
335	>	#ifdef  OUTCHAN
336	>	if (lvl >= 1) {
337	>	for (ep = outchan; ep != NULL; ep = ep->sibling)
338	>	epfree(ep);
339	>	outchan = NULL;
340	>	}
341		#endif
342		}
343
#	Line 189 | Line 349 | char  *name;
349		register VARDEF  *vp;
350
351		if ((vp = varlookup(name)) == NULL)
352	<	return(NULL);
352	>	return(NULL);
353		return(vp->def);
354		}
355
#	Line 198 | Line 358 | VARDEF *
358		varlookup(name)                 /* look up a variable */
359		char  *name;
360		{
361	+	int  lvl = 0;
362	+	register char  *qname;
363		register VARDEF  *vp;
364	<
365	<	for (vp = hashtbl[hash(name)]; vp != NULL; vp = vp->next)
366	<	if (!strcmp(vp->name, name))
367	<	return(vp);
364	>	/* find most qualified match */
365	>	while ((qname = qualname(name, lvl++)) != NULL)
366	>	for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next)
367	>	if (!strcmp(vp->name, qname))
368	>	return(vp);
369		return(NULL);
370		}
371
#	Line 212 | Line 375 | varinsert(name)                        /* get a link to a variable */
375		char  *name;
376		{
377		register VARDEF  *vp;
378	<	int  hv;
378	>	int  hv;
379
380	<	hv = hash(name);
381	<	for (vp = hashtbl[hv]; vp != NULL; vp = vp->next)
382	<	if (!strcmp(vp->name, name)) {
383	<	vp->nlinks++;
221	<	return(vp);
222	<	}
380	>	if ((vp = varlookup(name)) != NULL) {
381	>	vp->nlinks++;
382	>	return(vp);
383	>	}
384		vp = (VARDEF *)emalloc(sizeof(VARDEF));
385	+	#ifdef  FUNCTION
386	+	vp->lib = liblookup(name);
387	+	#else
388	+	vp->lib = NULL;
389	+	#endif
390	+	if (vp->lib == NULL)                /* if name not in library */
391	+	name = qualname(name, 0);       /* use fully qualified version */
392	+	hv = hash(name);
393		vp->name = savestr(name);
394		vp->nlinks = 1;
395		vp->def = NULL;
227	–	vp->lib = NULL;
396		vp->next = hashtbl[hv];
397		hashtbl[hv] = vp;
398		return(vp);
399		}
400
401
402	+	#ifdef  FUNCTION
403	+	libupdate(fn)                   /* update library links */
404	+	char  *fn;
405	+	{
406	+	register int  i;
407	+	register VARDEF  *vp;
408	+	/* if fn is NULL then relink all */
409	+	for (i = 0; i < NHASH; i++)
410	+	for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
411	+	if (vp->lib != NULL || fn == NULL || !strcmp(fn, vp->name))
412	+	vp->lib = liblookup(vp->name);
413	+	}
414	+	#endif
415	+
416	+
417		varfree(ln)                             /* release link to variable */
418	<	register VARDEF  *ln;
418	>	register VARDEF  *ln;
419		{
420		register VARDEF  *vp;
421	<	int  hv;
421	>	int  hv;
422
423		if (--ln->nlinks > 0)
424	<	return;                         /* still active */
424	>	return;                         /* still active */
425
426		hv = hash(ln->name);
427		vp = hashtbl[hv];
428		if (vp == ln)
429	<	hashtbl[hv] = vp->next;
429	>	hashtbl[hv] = vp->next;
430		else {
431	<	while (vp->next != ln)          /* must be in list */
432	<	vp = vp->next;
433	<	vp->next = ln->next;
431	>	while (vp->next != ln)          /* must be in list */
432	>	vp = vp->next;
433	>	vp->next = ln->next;
434		}
435		freestr(ln->name);
436		efree((char *)ln);
#	Line 259 | Line 442 | dfirst()                       /* return pointer to first definition */
442		{
443		htndx = 0;
444		htpos = NULL;
445	<	#ifdef  OUTCHAN
445	>	#ifdef  OUTCHAN
446		ochpos = outchan;
447		#endif
448		return(dnext());
#	Line 270 | Line 453 | EPNODE *
453		dnext()                         /* return pointer to next definition */
454		{
455		register EPNODE  *ep;
456	+	register char  *nm;
457
458		while (htndx < NHASH) {
459	<	if (htpos == NULL)
460	<	htpos = hashtbl[htndx++];
461	<	while (htpos != NULL) {
462	<	ep = htpos->def;
463	<	htpos = htpos->next;
464	<	if (ep != NULL)
465	<	return(ep);
466	<	}
459	>	if (htpos == NULL)
460	>	htpos = hashtbl[htndx++];
461	>	while (htpos != NULL) {
462	>	ep = htpos->def;
463	>	nm = htpos->name;
464	>	htpos = htpos->next;
465	>	if (ep != NULL && incontext(nm))
466	>	return(ep);
467	>	}
468		}
469	<	#ifdef  OUTCHAN
469	>	#ifdef  OUTCHAN
470		if ((ep = ochpos) != NULL)
471	<	ochpos = ep->sibling;
471	>	ochpos = ep->sibling;
472		return(ep);
473		#else
474		return(NULL);
#	Line 299 | Line 484 | char  *name;
484		register EPNODE  *dp;
485
486		if ((vp = varlookup(name)) == NULL || vp->def == NULL)
487	<	return(NULL);
487	>	return(NULL);
488		dp = vp->def;
489		vp->def = dp->sibling;
490		varfree(vp);
#	Line 307 | Line 492 | char  *name;
492		}
493
494
495	<	dpush(ep)                       /* push on a definition */
496	<	register EPNODE  *ep;
495	>	dpush(nm, ep)                   /* push on a definition */
496	>	char  *nm;
497	>	register EPNODE  *ep;
498		{
499		register VARDEF  *vp;
500
501	<	vp = varinsert(dname(ep));
501	>	vp = varinsert(nm);
502		ep->sibling = vp->def;
503		vp->def = ep;
504		}
505
506
507	<	#ifdef  OUTCHAN
507	>	#ifdef  OUTCHAN
508		addchan(sp)                     /* add an output channel assignment */
509	<	EPNODE  *sp;
509	>	EPNODE  *sp;
510		{
511	<	int  ch = sp->v.kid->v.chan;
511	>	int  ch = sp->v.kid->v.chan;
512		register EPNODE  *ep, *epl;
513
514		for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling)
#	Line 349 | Line 535 | EPNODE  *sp;
535		#endif
536
537
538	<	loaddefn()                      /* load next definition */
538	>	getstatement()                  /* get next statement */
539		{
540		register EPNODE  *ep;
541	+	char  *qname;
542	+	register VARDEF  *vdef;
543
544		if (nextc == ';') {         /* empty statement */
545		scan();
546		return;
547		}
548	<	#ifdef  OUTCHAN
548	>	#ifdef  OUTCHAN
549		if (nextc == '$') {         /* channel assignment */
550		ep = getchan();
551		addchan(ep);
#	Line 365 | Line 553 | loaddefn()                     /* load next definition */
553		#endif
554		{                           /* ordinary definition */
555		ep = getdefn();
556	<	#ifdef  REDEFW
557	<	if (dlookup(dname(ep)) != NULL) {
558	<	dclear(dname(ep));
559	<	wputs(dname(ep));
560	<	wputs(": redefined\n");
561	<	}
562	<	#else
563	<	dclear(dname(ep));
556	>	qname = qualname(dname(ep), 0);
557	>	#ifdef  REDEFW
558	>	if ((vdef = varlookup(qname)) != NULL)
559	>	if (vdef->def != NULL && epcmp(ep, vdef->def)) {
560	>	wputs(qname);
561	>	if (vdef->def->type == ':')
562	>	wputs(": redefined constant expression\n");
563	>	else
564	>	wputs(": redefined\n");
565	>	}
566	>	#ifdef  FUNCTION
567	>	else if (ep->v.kid->type == FUNC && vdef->lib != NULL) {
568	>	wputs(qname);
569	>	wputs(": definition hides library function\n");
570	>	}
571		#endif
572	<	dpush(ep);
572	>	#endif
573	>	if (ep->type == ':')
574	>	dremove(qname);
575	>	else
576	>	dclear(qname);
577	>	dpush(qname, ep);
578		}
579		if (nextc != EOF) {
580		if (nextc != ';')
#	Line 386 | Line 586 | loaddefn()                     /* load next definition */
586
587		EPNODE *
588		getdefn()                       /* A -> SYM = E1 */
589	<	/*      FUNC(SYM,..) = E1 */
589	>	/*      SYM : E1 */
590	>	/*      FUNC(SYM,..) = E1 */
591	>	/*      FUNC(SYM,..) : E1 */
592		{
593		register EPNODE  *ep1, *ep2;
594
595	<	if (!isalpha(nextc))
595	>	if (!isalpha(nextc) && nextc != CNTXMARK)
596		syntax("illegal variable name");
597
598		ep1 = newnode();
599		ep1->type = SYM;
600		ep1->v.name = savestr(getname());
601
602	<	#ifdef  FUNCTION
602	>	#ifdef  FUNCTION
603		if (nextc == '(') {
604		ep2 = newnode();
605		ep2->type = FUNC;
#	Line 420 | Line 622 | getdefn()                      /* A -> SYM = E1 */
622		curfunc = NULL;
623		#endif
624
625	<	if (nextc != '=')
626	<	syntax("'=' expected");
425	<	scan();
625	>	if (nextc != '=' && nextc != ':')
626	>	syntax("'=' or ':' expected");
627
628		ep2 = newnode();
629	<	ep2->type = '=';
629	>	ep2->type = nextc;
630	>	scan();
631		addekid(ep2, ep1);
632		addekid(ep2, getE1());
633
634	<	#ifdef  FUNCTION
635	<	if (ep1->type == SYM)
634	>	if (
635	>	#ifdef  FUNCTION
636	>	ep1->type == SYM &&
637		#endif
638	<	{
638	>	ep1->sibling->type != NUM) {
639		ep1 = newnode();
640		ep1->type = TICK;
641		ep1->v.tick = -1;
#	Line 446 | Line 649 | getdefn()                      /* A -> SYM = E1 */
649		}
650
651
652	<	#ifdef  OUTCHAN
652	>	#ifdef  OUTCHAN
653		EPNODE *
654		getchan()                       /* A -> $N = E1 */
655		{
#	Line 483 | Line 686 | getchan()                      /* A -> $N = E1 */
686		static double
687		dvalue(name, d)                 /* evaluate a variable */
688		char  *name;
689	<	EPNODE  *d;
689	>	EPNODE  *d;
690		{
691		register EPNODE  *ep1, *ep2;
692
#	Line 497 | Line 700 | EPNODE  *d;
700		return(ep1->v.num);                     /* return if number */
701		ep2 = ep1->sibling;                         /* check time */
702		if (ep2->v.tick < 0 || ep2->v.tick < eclock) {
703	<	ep2->v.tick = eclock;
703	>	ep2->v.tick = d->type == ':' ? 1L<<30 : eclock;
704		ep2 = ep2->sibling;
705		ep2->v.num = evalue(ep1);               /* needs new value */
706		} else
707		ep2 = ep2->sibling;                     /* else reuse old value */
708
709		return(ep2->v.num);
507	–	}
508	–
509	–
510	–	static int
511	–	hash(s)                         /* hash a string */
512	–	register char  *s;
513	–	{
514	–	register int  rval = 0;
515	–
516	–	while (*s)
517	–	rval += *s++;
518	–
519	–	return(rval % NHASH);
710		}

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines (old)
>	Changed lines (new)