1 |
/* Copyright (c) 1986 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 |
|
23 |
#include <stdio.h> |
24 |
|
25 |
#include <ctype.h> |
26 |
|
27 |
#include "calcomp.h" |
28 |
|
29 |
#ifndef NHASH |
30 |
#define NHASH 521 /* hash size (a prime!) */ |
31 |
#endif |
32 |
|
33 |
#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE)) |
34 |
|
35 |
extern char *ecalloc(), *savestr(); |
36 |
|
37 |
static double dvalue(); |
38 |
|
39 |
long eclock = -1; /* value storage timer */ |
40 |
|
41 |
static VARDEF *hashtbl[NHASH]; /* definition list */ |
42 |
static int htndx; /* index for */ |
43 |
static VARDEF *htpos; /* ...dfirst() and */ |
44 |
#ifdef OUTCHAN |
45 |
static EPNODE *ochpos; /* ...dnext */ |
46 |
static EPNODE *outchan; |
47 |
#endif |
48 |
|
49 |
#ifdef FUNCTION |
50 |
EPNODE *curfunc; |
51 |
#define dname(ep) ((ep)->v.kid->type == SYM ? \ |
52 |
(ep)->v.kid->v.name : \ |
53 |
(ep)->v.kid->v.kid->v.name) |
54 |
#else |
55 |
#define dname(ep) ((ep)->v.kid->v.name) |
56 |
#endif |
57 |
|
58 |
|
59 |
fcompile(fname) /* get definitions from a file */ |
60 |
char *fname; |
61 |
{ |
62 |
FILE *fp; |
63 |
|
64 |
if (fname == NULL) |
65 |
fp = stdin; |
66 |
else if ((fp = fopen(fname, "r")) == NULL) { |
67 |
eputs(fname); |
68 |
eputs(": cannot open\n"); |
69 |
quit(1); |
70 |
} |
71 |
initfile(fp, fname, 0); |
72 |
while (nextc != EOF) |
73 |
loaddefn(); |
74 |
if (fname != NULL) |
75 |
fclose(fp); |
76 |
} |
77 |
|
78 |
|
79 |
scompile(str, fn, ln) /* get definitions from a string */ |
80 |
char *str; |
81 |
char *fn; |
82 |
int ln; |
83 |
{ |
84 |
initstr(str, fn, ln); |
85 |
while (nextc != EOF) |
86 |
loaddefn(); |
87 |
} |
88 |
|
89 |
|
90 |
double |
91 |
varvalue(vname) /* return a variable's value */ |
92 |
char *vname; |
93 |
{ |
94 |
return(dvalue(vname, dlookup(vname))); |
95 |
} |
96 |
|
97 |
|
98 |
double |
99 |
evariable(ep) /* evaluate a variable */ |
100 |
EPNODE *ep; |
101 |
{ |
102 |
register VARDEF *dp = ep->v.ln; |
103 |
|
104 |
return(dvalue(dp->name, dp->def)); |
105 |
} |
106 |
|
107 |
|
108 |
varset(vname, val) /* set a variable's value */ |
109 |
char *vname; |
110 |
double val; |
111 |
{ |
112 |
register EPNODE *ep1, *ep2; |
113 |
/* check for quick set */ |
114 |
if ((ep1 = dlookup(vname)) != NULL && ep1->v.kid->type == SYM) { |
115 |
ep2 = ep1->v.kid->sibling; |
116 |
if (ep2->type == NUM) { |
117 |
ep2->v.num = val; |
118 |
return; |
119 |
} |
120 |
} |
121 |
/* hand build definition */ |
122 |
ep1 = newnode(); |
123 |
ep1->type = '='; |
124 |
ep2 = newnode(); |
125 |
ep2->type = SYM; |
126 |
ep2->v.name = savestr(vname); |
127 |
addekid(ep1, ep2); |
128 |
ep2 = newnode(); |
129 |
ep2->type = NUM; |
130 |
ep2->v.num = val; |
131 |
addekid(ep1, ep2); |
132 |
dclear(vname); |
133 |
dpush(ep1); |
134 |
} |
135 |
|
136 |
|
137 |
dclear(name) /* delete all definitions of name */ |
138 |
char *name; |
139 |
{ |
140 |
register EPNODE *ep; |
141 |
|
142 |
while ((ep = dpop(name)) != NULL) |
143 |
epfree(ep); |
144 |
} |
145 |
|
146 |
|
147 |
vardefined(name) /* return non-zero if variable defined */ |
148 |
char *name; |
149 |
{ |
150 |
register EPNODE *dp; |
151 |
|
152 |
return((dp = dlookup(name)) != NULL && dp->v.kid->type == SYM); |
153 |
} |
154 |
|
155 |
|
156 |
#ifdef OUTCHAN |
157 |
chanout() /* set output channels */ |
158 |
{ |
159 |
register EPNODE *ep; |
160 |
|
161 |
for (ep = outchan; ep != NULL; ep = ep->sibling) |
162 |
chanset(ep->v.kid->v.chan, evalue(ep->v.kid->sibling)); |
163 |
|
164 |
} |
165 |
#endif |
166 |
|
167 |
|
168 |
dclearall() /* clear all definitions */ |
169 |
{ |
170 |
register int i; |
171 |
register VARDEF *vp; |
172 |
register EPNODE *ep; |
173 |
|
174 |
for (i = 0; i < NHASH; i++) |
175 |
for (vp = hashtbl[i]; vp != NULL; vp = vp->next) |
176 |
dclear(vp->name); |
177 |
#ifdef OUTCHAN |
178 |
for (ep = outchan; ep != NULL; ep = ep->sibling) |
179 |
epfree(ep); |
180 |
outchan = NULL; |
181 |
#endif |
182 |
} |
183 |
|
184 |
|
185 |
EPNODE * |
186 |
dlookup(name) /* look up a definition */ |
187 |
char *name; |
188 |
{ |
189 |
register VARDEF *vp; |
190 |
|
191 |
if ((vp = varlookup(name)) == NULL) |
192 |
return(NULL); |
193 |
return(vp->def); |
194 |
} |
195 |
|
196 |
|
197 |
VARDEF * |
198 |
varlookup(name) /* look up a variable */ |
199 |
char *name; |
200 |
{ |
201 |
register VARDEF *vp; |
202 |
|
203 |
for (vp = hashtbl[hash(name)]; vp != NULL; vp = vp->next) |
204 |
if (!strcmp(vp->name, name)) |
205 |
return(vp); |
206 |
return(NULL); |
207 |
} |
208 |
|
209 |
|
210 |
VARDEF * |
211 |
varinsert(name) /* get a link to a variable */ |
212 |
char *name; |
213 |
{ |
214 |
register VARDEF *vp; |
215 |
int hv; |
216 |
|
217 |
hv = hash(name); |
218 |
for (vp = hashtbl[hv]; vp != NULL; vp = vp->next) |
219 |
if (!strcmp(vp->name, name)) { |
220 |
vp->nlinks++; |
221 |
return(vp); |
222 |
} |
223 |
vp = (VARDEF *)emalloc(sizeof(VARDEF)); |
224 |
vp->name = savestr(name); |
225 |
vp->nlinks = 1; |
226 |
vp->def = NULL; |
227 |
vp->lib = NULL; |
228 |
vp->next = hashtbl[hv]; |
229 |
hashtbl[hv] = vp; |
230 |
return(vp); |
231 |
} |
232 |
|
233 |
|
234 |
varfree(ln) /* release link to variable */ |
235 |
register VARDEF *ln; |
236 |
{ |
237 |
register VARDEF *vp; |
238 |
int hv; |
239 |
|
240 |
if (--ln->nlinks > 0) |
241 |
return; /* still active */ |
242 |
|
243 |
hv = hash(ln->name); |
244 |
vp = hashtbl[hv]; |
245 |
if (vp == ln) |
246 |
hashtbl[hv] = vp->next; |
247 |
else { |
248 |
while (vp->next != ln) /* must be in list */ |
249 |
vp = vp->next; |
250 |
vp->next = ln->next; |
251 |
} |
252 |
freestr(ln->name); |
253 |
efree((char *)ln); |
254 |
} |
255 |
|
256 |
|
257 |
EPNODE * |
258 |
dfirst() /* return pointer to first definition */ |
259 |
{ |
260 |
htndx = 0; |
261 |
htpos = NULL; |
262 |
#ifdef OUTCHAN |
263 |
ochpos = outchan; |
264 |
#endif |
265 |
return(dnext()); |
266 |
} |
267 |
|
268 |
|
269 |
EPNODE * |
270 |
dnext() /* return pointer to next definition */ |
271 |
{ |
272 |
register EPNODE *ep; |
273 |
|
274 |
while (htndx < NHASH) { |
275 |
if (htpos == NULL) |
276 |
htpos = hashtbl[htndx++]; |
277 |
while (htpos != NULL) { |
278 |
ep = htpos->def; |
279 |
htpos = htpos->next; |
280 |
if (ep != NULL) |
281 |
return(ep); |
282 |
} |
283 |
} |
284 |
#ifdef OUTCHAN |
285 |
if ((ep = ochpos) != NULL) |
286 |
ochpos = ep->sibling; |
287 |
return(ep); |
288 |
#else |
289 |
return(NULL); |
290 |
#endif |
291 |
} |
292 |
|
293 |
|
294 |
EPNODE * |
295 |
dpop(name) /* pop a definition */ |
296 |
char *name; |
297 |
{ |
298 |
register VARDEF *vp; |
299 |
register EPNODE *dp; |
300 |
|
301 |
if ((vp = varlookup(name)) == NULL || vp->def == NULL) |
302 |
return(NULL); |
303 |
dp = vp->def; |
304 |
vp->def = dp->sibling; |
305 |
varfree(vp); |
306 |
return(dp); |
307 |
} |
308 |
|
309 |
|
310 |
dpush(ep) /* push on a definition */ |
311 |
register EPNODE *ep; |
312 |
{ |
313 |
register VARDEF *vp; |
314 |
|
315 |
vp = varinsert(dname(ep)); |
316 |
ep->sibling = vp->def; |
317 |
vp->def = ep; |
318 |
} |
319 |
|
320 |
|
321 |
#ifdef OUTCHAN |
322 |
addchan(sp) /* add an output channel assignment */ |
323 |
EPNODE *sp; |
324 |
{ |
325 |
int ch = sp->v.kid->v.chan; |
326 |
register EPNODE *ep, *epl; |
327 |
|
328 |
for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling) |
329 |
if (ep->v.kid->v.chan >= ch) { |
330 |
if (epl != NULL) |
331 |
epl->sibling = sp; |
332 |
else |
333 |
outchan = sp; |
334 |
if (ep->v.kid->v.chan > ch) |
335 |
sp->sibling = ep; |
336 |
else { |
337 |
sp->sibling = ep->sibling; |
338 |
epfree(ep); |
339 |
} |
340 |
return; |
341 |
} |
342 |
if (epl != NULL) |
343 |
epl->sibling = sp; |
344 |
else |
345 |
outchan = sp; |
346 |
sp->sibling = NULL; |
347 |
|
348 |
} |
349 |
#endif |
350 |
|
351 |
|
352 |
loaddefn() /* load next definition */ |
353 |
{ |
354 |
register EPNODE *ep; |
355 |
|
356 |
if (nextc == ';') { /* empty statement */ |
357 |
scan(); |
358 |
return; |
359 |
} |
360 |
#ifdef OUTCHAN |
361 |
if (nextc == '$') { /* channel assignment */ |
362 |
ep = getchan(); |
363 |
addchan(ep); |
364 |
} else |
365 |
#endif |
366 |
{ /* ordinary definition */ |
367 |
ep = getdefn(); |
368 |
#ifdef REDEFW |
369 |
if (dlookup(dname(ep)) != NULL) { |
370 |
dclear(dname(ep)); |
371 |
wputs(dname(ep)); |
372 |
wputs(": redefined\n"); |
373 |
} |
374 |
#else |
375 |
dclear(dname(ep)); |
376 |
#endif |
377 |
dpush(ep); |
378 |
} |
379 |
if (nextc != EOF) { |
380 |
if (nextc != ';') |
381 |
syntax("';' expected"); |
382 |
scan(); |
383 |
} |
384 |
} |
385 |
|
386 |
|
387 |
EPNODE * |
388 |
getdefn() /* A -> SYM = E1 */ |
389 |
/* FUNC(SYM,..) = E1 */ |
390 |
{ |
391 |
register EPNODE *ep1, *ep2; |
392 |
|
393 |
if (!isalpha(nextc)) |
394 |
syntax("illegal variable name"); |
395 |
|
396 |
ep1 = newnode(); |
397 |
ep1->type = SYM; |
398 |
ep1->v.name = savestr(getname()); |
399 |
|
400 |
#ifdef FUNCTION |
401 |
if (nextc == '(') { |
402 |
ep2 = newnode(); |
403 |
ep2->type = FUNC; |
404 |
addekid(ep2, ep1); |
405 |
ep1 = ep2; |
406 |
do { |
407 |
scan(); |
408 |
if (!isalpha(nextc)) |
409 |
syntax("illegal variable name"); |
410 |
ep2 = newnode(); |
411 |
ep2->type = SYM; |
412 |
ep2->v.name = savestr(getname()); |
413 |
addekid(ep1, ep2); |
414 |
} while (nextc == ','); |
415 |
if (nextc != ')') |
416 |
syntax("')' expected"); |
417 |
scan(); |
418 |
curfunc = ep1; |
419 |
} else |
420 |
curfunc = NULL; |
421 |
#endif |
422 |
|
423 |
if (nextc != '=') |
424 |
syntax("'=' expected"); |
425 |
scan(); |
426 |
|
427 |
ep2 = newnode(); |
428 |
ep2->type = '='; |
429 |
addekid(ep2, ep1); |
430 |
addekid(ep2, getE1()); |
431 |
|
432 |
#ifdef FUNCTION |
433 |
if (ep1->type == SYM) |
434 |
#endif |
435 |
{ |
436 |
ep1 = newnode(); |
437 |
ep1->type = TICK; |
438 |
ep1->v.tick = -1; |
439 |
addekid(ep2, ep1); |
440 |
ep1 = newnode(); |
441 |
ep1->type = NUM; |
442 |
addekid(ep2, ep1); |
443 |
} |
444 |
|
445 |
return(ep2); |
446 |
} |
447 |
|
448 |
|
449 |
#ifdef OUTCHAN |
450 |
EPNODE * |
451 |
getchan() /* A -> $N = E1 */ |
452 |
{ |
453 |
register EPNODE *ep1, *ep2; |
454 |
|
455 |
if (nextc != '$') |
456 |
syntax("missing '$'"); |
457 |
scan(); |
458 |
|
459 |
ep1 = newnode(); |
460 |
ep1->type = CHAN; |
461 |
ep1->v.chan = getinum(); |
462 |
|
463 |
if (nextc != '=') |
464 |
syntax("'=' expected"); |
465 |
scan(); |
466 |
|
467 |
ep2 = newnode(); |
468 |
ep2->type = '='; |
469 |
addekid(ep2, ep1); |
470 |
addekid(ep2, getE1()); |
471 |
|
472 |
return(ep2); |
473 |
} |
474 |
#endif |
475 |
|
476 |
|
477 |
|
478 |
/* |
479 |
* The following routines are for internal use only: |
480 |
*/ |
481 |
|
482 |
|
483 |
static double |
484 |
dvalue(name, d) /* evaluate a variable */ |
485 |
char *name; |
486 |
EPNODE *d; |
487 |
{ |
488 |
register EPNODE *ep1, *ep2; |
489 |
|
490 |
if (d == NULL || d->v.kid->type != SYM) { |
491 |
eputs(name); |
492 |
eputs(": undefined variable\n"); |
493 |
quit(1); |
494 |
} |
495 |
ep1 = d->v.kid->sibling; /* get expression */ |
496 |
if (ep1->type == NUM) |
497 |
return(ep1->v.num); /* return if number */ |
498 |
ep2 = ep1->sibling; /* check time */ |
499 |
if (ep2->v.tick < 0 || ep2->v.tick < eclock) { |
500 |
ep2->v.tick = eclock; |
501 |
ep2 = ep2->sibling; |
502 |
ep2->v.num = evalue(ep1); /* needs new value */ |
503 |
} else |
504 |
ep2 = ep2->sibling; /* else reuse old value */ |
505 |
|
506 |
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); |
520 |
} |