ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/caldefn.c
Revision: 1.15
Committed: Thu Aug 8 12:28:30 1991 UTC (32 years, 8 months ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 1.14: +3 -0 lines
Log Message:
added explicit global id's starting with context mark

File Contents

# Content
1 /* Copyright (c) 1991 Regents of the University of California */
2
3 #ifndef lint
4 static char SCCSid[] = "$SunId$ LBL";
5 #endif
6
7 /*
8 * Store variable definitions.
9 *
10 * 7/1/85 Greg Ward
11 *
12 * 11/11/85 Added conditional compiles (OUTCHAN) for control output.
13 *
14 * 4/2/86 Added conditional compiles for function definitions (FUNCTION).
15 *
16 * 1/15/88 Added clock for caching of variable values.
17 *
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>
28
29 #include <ctype.h>
30
31 #include "calcomp.h"
32
33 #ifndef NHASH
34 #define NHASH 521 /* hash size (a prime!) */
35 #endif
36
37 #define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE))
38
39 extern char *ecalloc(), *savestr(), *strcpy();
40
41 static double dvalue();
42
43 long eclock = -1; /* value storage timer */
44
45 static char context[MAXWORD]; /* current context path */
46
47 static VARDEF *hashtbl[NHASH]; /* definition list */
48 static int htndx; /* index for */
49 static VARDEF *htpos; /* ...dfirst() and */
50 #ifdef OUTCHAN
51 static EPNODE *ochpos; /* ...dnext */
52 static EPNODE *outchan;
53 #endif
54
55 #ifdef FUNCTION
56 EPNODE *curfunc;
57 #define dname(ep) ((ep)->v.kid->type == SYM ? \
58 (ep)->v.kid->v.name : \
59 (ep)->v.kid->v.kid->v.name)
60 #else
61 #define dname(ep) ((ep)->v.kid->v.name)
62 #endif
63
64
65 fcompile(fname) /* get definitions from a file */
66 char *fname;
67 {
68 FILE *fp;
69
70 if (fname == NULL)
71 fp = stdin;
72 else if ((fp = fopen(fname, "r")) == NULL) {
73 eputs(fname);
74 eputs(": cannot open\n");
75 quit(1);
76 }
77 initfile(fp, fname, 0);
78 while (nextc != EOF)
79 getstatement();
80 if (fname != NULL)
81 fclose(fp);
82 }
83
84
85 scompile(str, fn, ln) /* get definitions from a string */
86 char *str;
87 char *fn;
88 int ln;
89 {
90 initstr(str, fn, ln);
91 while (nextc != EOF)
92 getstatement();
93 }
94
95
96 double
97 varvalue(vname) /* return a variable's value */
98 char *vname;
99 {
100 return(dvalue(vname, dlookup(vname)));
101 }
102
103
104 double
105 evariable(ep) /* evaluate a variable */
106 EPNODE *ep;
107 {
108 register VARDEF *dp = ep->v.ln;
109
110 return(dvalue(dp->name, dp->def));
111 }
112
113
114 varset(vname, assign, val) /* set a variable's value */
115 char *vname;
116 int assign;
117 double val;
118 {
119 char *qname;
120 register EPNODE *ep1, *ep2;
121 /* get qualified name */
122 qname = qualname(vname, 0);
123 /* check for quick set */
124 if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) {
125 ep2 = ep1->v.kid->sibling;
126 if (ep2->type == NUM) {
127 ep2->v.num = val;
128 ep1->type = assign;
129 return;
130 }
131 }
132 /* hand build definition */
133 ep1 = newnode();
134 ep1->type = assign;
135 ep2 = newnode();
136 ep2->type = SYM;
137 ep2->v.name = savestr(vname);
138 addekid(ep1, ep2);
139 ep2 = newnode();
140 ep2->type = NUM;
141 ep2->v.num = val;
142 addekid(ep1, ep2);
143 dremove(qname);
144 dpush(qname, ep1);
145 }
146
147
148 dclear(name) /* delete variable definitions of name */
149 char *name;
150 {
151 register EPNODE *ep;
152
153 while ((ep = dpop(name)) != NULL) {
154 if (ep->type == ':') {
155 dpush(name, ep); /* don't clear constants */
156 return;
157 }
158 epfree(ep);
159 }
160 }
161
162
163 dremove(name) /* delete all definitions of name */
164 char *name;
165 {
166 register EPNODE *ep;
167
168 while ((ep = dpop(name)) != NULL)
169 epfree(ep);
170 }
171
172
173 vardefined(name) /* return non-zero if variable defined */
174 char *name;
175 {
176 register EPNODE *dp;
177
178 return((dp = dlookup(name)) != NULL && dp->v.kid->type == SYM);
179 }
180
181
182 char *
183 setcontext(ctx) /* set a new context path */
184 register char *ctx;
185 {
186 register char *cpp;
187
188 if (ctx == NULL)
189 return(context); /* just asking */
190 if (!*ctx) {
191 context[0] = '\0'; /* clear context */
192 return(context);
193 }
194 cpp = context; /* else copy it (carefully!) */
195 if (*ctx != CNTXMARK)
196 *cpp++ = CNTXMARK; /* make sure there's a mark */
197 do {
198 if (cpp >= context+MAXWORD-1) {
199 *cpp = '\0';
200 wputs(context);
201 wputs(": context path too long\n");
202 return(NULL);
203 }
204 if (isid(*ctx))
205 *cpp++ = *ctx++;
206 else {
207 *cpp++ = '_'; ctx++;
208 }
209 } while (*ctx);
210 *cpp = '\0';
211 return(context);
212 }
213
214
215 char *
216 qualname(nam, lvl) /* get qualified name */
217 register char *nam;
218 int lvl;
219 {
220 static char nambuf[MAXWORD];
221 register char *cp = nambuf, *cpp = context;
222 /* check for explicit global */
223 if (*nam == CNTXMARK)
224 return(lvl > 0 ? NULL : nam+1);
225 /* check for repeat call */
226 if (nam == nambuf)
227 return(lvl > 0 ? NULL : nambuf);
228 /* copy name to static buffer */
229 while (*nam) {
230 if (cp >= nambuf+MAXWORD-1)
231 goto toolong;
232 if ((*cp++ = *nam++) == CNTXMARK)
233 cpp = NULL; /* flag a qualified name */
234 }
235 if (cpp == NULL) {
236 if (lvl > 0)
237 return(NULL); /* no higher level */
238 if (cp[-1] == CNTXMARK) {
239 cp--; cpp = context; /* current context explicitly */
240 } else
241 cpp = ""; /* else fully qualified */
242 } else /* else skip the requested levels */
243 while (lvl-- > 0) {
244 if (!*cpp)
245 return(NULL); /* return NULL if past global level */
246 while (*++cpp && *cpp != CNTXMARK)
247 ;
248 }
249 while (*cpp) { /* copy context to static buffer */
250 if (cp >= nambuf+MAXWORD-1)
251 goto toolong;
252 *cp++ = *cpp++;
253 }
254 *cp = '\0';
255 return(nambuf); /* return qualified name */
256 toolong:
257 *cp = '\0';
258 eputs(nambuf);
259 eputs(": name too long\n");
260 quit(1);
261 }
262
263
264 incontext(qn) /* is qualified name in current context? */
265 register char *qn;
266 {
267 while (*qn && *qn != CNTXMARK) /* find context mark */
268 ;
269 return(!strcmp(qn, context));
270 }
271
272
273 #ifdef OUTCHAN
274 chanout(cs) /* set output channels */
275 int (*cs)();
276 {
277 register EPNODE *ep;
278
279 for (ep = outchan; ep != NULL; ep = ep->sibling)
280 (*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));
281
282 }
283 #endif
284
285
286 dcleanup(lvl) /* clear definitions (0->vars,1->output,2->consts) */
287 int lvl;
288 {
289 register int i;
290 register VARDEF *vp;
291 register EPNODE *ep;
292 /* if context is global, clear all */
293 for (i = 0; i < NHASH; i++)
294 for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
295 if (!context[0] || incontext(vp->name))
296 if (lvl >= 2)
297 dremove(vp->name);
298 else
299 dclear(vp->name);
300 #ifdef OUTCHAN
301 if (lvl >= 1) {
302 for (ep = outchan; ep != NULL; ep = ep->sibling)
303 epfree(ep);
304 outchan = NULL;
305 }
306 #endif
307 }
308
309
310 EPNODE *
311 dlookup(name) /* look up a definition */
312 char *name;
313 {
314 register VARDEF *vp;
315
316 if ((vp = varlookup(name)) == NULL)
317 return(NULL);
318 return(vp->def);
319 }
320
321
322 VARDEF *
323 varlookup(name) /* look up a variable */
324 char *name;
325 {
326 int lvl = 0;
327 register char *qname;
328 register VARDEF *vp;
329 /* find most qualified match */
330 while ((qname = qualname(name, lvl++)) != NULL)
331 for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next)
332 if (!strcmp(vp->name, qname))
333 return(vp);
334 return(NULL);
335 }
336
337
338 VARDEF *
339 varinsert(name) /* get a link to a variable */
340 char *name;
341 {
342 register VARDEF *vp;
343 int hv;
344
345 if ((vp = varlookup(name)) != NULL) {
346 vp->nlinks++;
347 return(vp);
348 }
349 name = qualname(name, 0); /* use fully qualified name */
350 hv = hash(name);
351 vp = (VARDEF *)emalloc(sizeof(VARDEF));
352 vp->name = savestr(name);
353 vp->nlinks = 1;
354 vp->def = NULL;
355 vp->lib = NULL;
356 vp->next = hashtbl[hv];
357 hashtbl[hv] = vp;
358 return(vp);
359 }
360
361
362 varfree(ln) /* release link to variable */
363 register VARDEF *ln;
364 {
365 register VARDEF *vp;
366 int hv;
367
368 if (--ln->nlinks > 0)
369 return; /* still active */
370
371 hv = hash(ln->name);
372 vp = hashtbl[hv];
373 if (vp == ln)
374 hashtbl[hv] = vp->next;
375 else {
376 while (vp->next != ln) /* must be in list */
377 vp = vp->next;
378 vp->next = ln->next;
379 }
380 freestr(ln->name);
381 efree((char *)ln);
382 }
383
384
385 EPNODE *
386 dfirst() /* return pointer to first definition */
387 {
388 htndx = 0;
389 htpos = NULL;
390 #ifdef OUTCHAN
391 ochpos = outchan;
392 #endif
393 return(dnext());
394 }
395
396
397 EPNODE *
398 dnext() /* return pointer to next definition */
399 {
400 register EPNODE *ep;
401
402 while (htndx < NHASH) {
403 if (htpos == NULL)
404 htpos = hashtbl[htndx++];
405 while (htpos != NULL) {
406 ep = htpos->def;
407 htpos = htpos->next;
408 if (ep != NULL)
409 return(ep);
410 }
411 }
412 #ifdef OUTCHAN
413 if ((ep = ochpos) != NULL)
414 ochpos = ep->sibling;
415 return(ep);
416 #else
417 return(NULL);
418 #endif
419 }
420
421
422 EPNODE *
423 dpop(name) /* pop a definition */
424 char *name;
425 {
426 register VARDEF *vp;
427 register EPNODE *dp;
428
429 if ((vp = varlookup(name)) == NULL || vp->def == NULL)
430 return(NULL);
431 dp = vp->def;
432 vp->def = dp->sibling;
433 varfree(vp);
434 return(dp);
435 }
436
437
438 dpush(nm, ep) /* push on a definition */
439 char *nm;
440 register EPNODE *ep;
441 {
442 register VARDEF *vp;
443
444 vp = varinsert(nm);
445 ep->sibling = vp->def;
446 vp->def = ep;
447 }
448
449
450 #ifdef OUTCHAN
451 addchan(sp) /* add an output channel assignment */
452 EPNODE *sp;
453 {
454 int ch = sp->v.kid->v.chan;
455 register EPNODE *ep, *epl;
456
457 for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling)
458 if (ep->v.kid->v.chan >= ch) {
459 if (epl != NULL)
460 epl->sibling = sp;
461 else
462 outchan = sp;
463 if (ep->v.kid->v.chan > ch)
464 sp->sibling = ep;
465 else {
466 sp->sibling = ep->sibling;
467 epfree(ep);
468 }
469 return;
470 }
471 if (epl != NULL)
472 epl->sibling = sp;
473 else
474 outchan = sp;
475 sp->sibling = NULL;
476
477 }
478 #endif
479
480
481 getstatement() /* get next statement */
482 {
483 register EPNODE *ep;
484 char *qname;
485 EPNODE *lastdef;
486
487 if (nextc == ';') { /* empty statement */
488 scan();
489 return;
490 }
491 #ifdef OUTCHAN
492 if (nextc == '$') { /* channel assignment */
493 ep = getchan();
494 addchan(ep);
495 } else
496 #endif
497 { /* ordinary definition */
498 ep = getdefn();
499 qname = qualname(dname(ep), 0);
500 #ifdef REDEFW
501 if ((lastdef = dlookup(qname)) != NULL) {
502 wputs(qname);
503 if (lastdef->type == ':')
504 wputs(": redefined constant expression\n");
505 else
506 wputs(": redefined\n");
507 }
508 #ifdef FUNCTION
509 else if (ep->v.kid->type == FUNC && liblookup(qname) != NULL) {
510 wputs(qname);
511 wputs(": definition hides library function\n");
512 }
513 #endif
514 #endif
515 if (ep->type == ':')
516 dremove(qname);
517 else
518 dclear(qname);
519 dpush(qname, ep);
520 }
521 if (nextc != EOF) {
522 if (nextc != ';')
523 syntax("';' expected");
524 scan();
525 }
526 }
527
528
529 EPNODE *
530 getdefn() /* A -> SYM = E1 */
531 /* SYM : E1 */
532 /* FUNC(SYM,..) = E1 */
533 /* FUNC(SYM,..) : E1 */
534 {
535 register EPNODE *ep1, *ep2;
536
537 if (!isalpha(nextc))
538 syntax("illegal variable name");
539
540 ep1 = newnode();
541 ep1->type = SYM;
542 ep1->v.name = savestr(getname());
543
544 #ifdef FUNCTION
545 if (nextc == '(') {
546 ep2 = newnode();
547 ep2->type = FUNC;
548 addekid(ep2, ep1);
549 ep1 = ep2;
550 do {
551 scan();
552 if (!isalpha(nextc))
553 syntax("illegal variable name");
554 ep2 = newnode();
555 ep2->type = SYM;
556 ep2->v.name = savestr(getname());
557 addekid(ep1, ep2);
558 } while (nextc == ',');
559 if (nextc != ')')
560 syntax("')' expected");
561 scan();
562 curfunc = ep1;
563 } else
564 curfunc = NULL;
565 #endif
566
567 if (nextc != '=' && nextc != ':')
568 syntax("'=' or ':' expected");
569
570 ep2 = newnode();
571 ep2->type = nextc;
572 scan();
573 addekid(ep2, ep1);
574 addekid(ep2, getE1());
575
576 if (
577 #ifdef FUNCTION
578 ep1->type == SYM &&
579 #endif
580 ep1->sibling->type != NUM) {
581 ep1 = newnode();
582 ep1->type = TICK;
583 ep1->v.tick = -1;
584 addekid(ep2, ep1);
585 ep1 = newnode();
586 ep1->type = NUM;
587 addekid(ep2, ep1);
588 }
589
590 return(ep2);
591 }
592
593
594 #ifdef OUTCHAN
595 EPNODE *
596 getchan() /* A -> $N = E1 */
597 {
598 register EPNODE *ep1, *ep2;
599
600 if (nextc != '$')
601 syntax("missing '$'");
602 scan();
603
604 ep1 = newnode();
605 ep1->type = CHAN;
606 ep1->v.chan = getinum();
607
608 if (nextc != '=')
609 syntax("'=' expected");
610 scan();
611
612 ep2 = newnode();
613 ep2->type = '=';
614 addekid(ep2, ep1);
615 addekid(ep2, getE1());
616
617 return(ep2);
618 }
619 #endif
620
621
622
623 /*
624 * The following routines are for internal use only:
625 */
626
627
628 static double
629 dvalue(name, d) /* evaluate a variable */
630 char *name;
631 EPNODE *d;
632 {
633 register EPNODE *ep1, *ep2;
634
635 if (d == NULL || d->v.kid->type != SYM) {
636 eputs(name);
637 eputs(": undefined variable\n");
638 quit(1);
639 }
640 ep1 = d->v.kid->sibling; /* get expression */
641 if (ep1->type == NUM)
642 return(ep1->v.num); /* return if number */
643 ep2 = ep1->sibling; /* check time */
644 if (ep2->v.tick < 0 || ep2->v.tick < eclock) {
645 ep2->v.tick = d->type == ':' ? 1L<<30 : eclock;
646 ep2 = ep2->sibling;
647 ep2->v.num = evalue(ep1); /* needs new value */
648 } else
649 ep2 = ep2->sibling; /* else reuse old value */
650
651 return(ep2->v.num);
652 }
653
654
655 static int
656 hash(s) /* hash a string */
657 register char *s;
658 {
659 register int rval = 0;
660
661 while (*s)
662 rval += *s++;
663
664 return(rval % NHASH);
665 }