28 |
|
#include "copyright.h" |
29 |
|
|
30 |
|
#include <stdio.h> |
31 |
– |
|
31 |
|
#include <string.h> |
33 |
– |
|
32 |
|
#include <ctype.h> |
33 |
|
|
34 |
+ |
#include "rterror.h" |
35 |
+ |
#include "rtio.h" |
36 |
+ |
#include "rtmisc.h" |
37 |
|
#include "calcomp.h" |
38 |
|
|
39 |
|
#ifndef NHASH |
44 |
|
|
45 |
|
#define newnode() (EPNODE *)ecalloc(1, sizeof(EPNODE)) |
46 |
|
|
47 |
< |
static double dvalue(); |
47 |
> |
static double dvalue(char *name, EPNODE *d); |
48 |
|
|
49 |
|
#define MAXCLOCK (1L<<31) /* clock wrap value */ |
50 |
|
|
115 |
|
EPNODE *ep |
116 |
|
) |
117 |
|
{ |
118 |
< |
register VARDEF *dp = ep->v.ln; |
118 |
> |
VARDEF *dp = ep->v.ln; |
119 |
|
|
120 |
|
return(dvalue(dp->name, dp->def)); |
121 |
|
} |
129 |
|
) |
130 |
|
{ |
131 |
|
char *qname; |
132 |
< |
register EPNODE *ep1, *ep2; |
132 |
> |
EPNODE *ep1, *ep2; |
133 |
|
/* get qualified name */ |
134 |
|
qname = qualname(vname, 0); |
135 |
|
/* check for quick set */ |
136 |
< |
if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) { |
136 |
> |
if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM && |
137 |
> |
(ep1->type == ':') <= (assign == ':')) { |
138 |
|
ep2 = ep1->v.kid->sibling; |
139 |
|
if (ep2->type == NUM) { |
140 |
|
ep2->v.num = val; |
153 |
|
ep2->type = NUM; |
154 |
|
ep2->v.num = val; |
155 |
|
addekid(ep1, ep2); |
156 |
< |
dremove(qname); |
156 |
> |
if (assign == ':') |
157 |
> |
dremove(qname); |
158 |
> |
else |
159 |
> |
dclear(qname); |
160 |
|
dpush(qname, ep1); |
161 |
|
} |
162 |
|
|
166 |
|
char *name |
167 |
|
) |
168 |
|
{ |
169 |
< |
register EPNODE *ep; |
169 |
> |
EPNODE *ep; |
170 |
|
|
171 |
|
while ((ep = dpop(name)) != NULL) { |
172 |
|
if (ep->type == ':') { |
183 |
|
char *name |
184 |
|
) |
185 |
|
{ |
186 |
< |
register EPNODE *ep; |
186 |
> |
EPNODE *ep; |
187 |
|
|
188 |
|
while ((ep = dpop(name)) != NULL) |
189 |
|
epfree(ep); |
195 |
|
char *name |
196 |
|
) |
197 |
|
{ |
198 |
< |
register EPNODE *dp; |
198 |
> |
EPNODE *dp; |
199 |
|
|
200 |
|
return((dp = dlookup(name)) != NULL && dp->v.kid->type == SYM); |
201 |
|
} |
203 |
|
|
204 |
|
char * |
205 |
|
setcontext( /* set a new context path */ |
206 |
< |
register char *ctx |
206 |
> |
char *ctx |
207 |
|
) |
208 |
|
{ |
209 |
< |
register char *cpp; |
209 |
> |
char *cpp; |
210 |
|
|
211 |
|
if (ctx == NULL) |
212 |
|
return(context); /* just asking */ |
240 |
|
) |
241 |
|
{ |
242 |
|
char oldcontext[MAXCNTX+1]; |
243 |
< |
register int n; |
243 |
> |
int n; |
244 |
|
|
245 |
|
strcpy(oldcontext, context); /* save old context */ |
246 |
|
setcontext(ctx); /* set new context */ |
257 |
|
char * |
258 |
|
popcontext(void) /* pop off top context */ |
259 |
|
{ |
260 |
< |
register char *cp1, *cp2; |
260 |
> |
char *cp1, *cp2; |
261 |
|
|
262 |
|
if (!context[0]) /* nothing left to pop */ |
263 |
|
return(context); |
265 |
|
while (*++cp2 && *cp2 != CNTXMARK) |
266 |
|
; |
267 |
|
cp1 = context; /* copy tail to front */ |
268 |
< |
while (*cp1++ = *cp2++) |
268 |
> |
while ( (*cp1++ = *cp2++) ) |
269 |
|
; |
270 |
|
return(context); |
271 |
|
} |
273 |
|
|
274 |
|
char * |
275 |
|
qualname( /* get qualified name */ |
276 |
< |
register char *nam, |
276 |
> |
char *nam, |
277 |
|
int lvl |
278 |
|
) |
279 |
|
{ |
280 |
|
static char nambuf[RMAXWORD+1]; |
281 |
< |
register char *cp = nambuf, *cpp; |
281 |
> |
char *cp = nambuf, *cpp; |
282 |
|
/* check for explicit local */ |
283 |
|
if (*nam == CNTXMARK) |
284 |
|
if (lvl > 0) /* only action is to refuse search */ |
320 |
|
|
321 |
|
int |
322 |
|
incontext( /* is qualified name in current context? */ |
323 |
< |
register char *qn |
323 |
> |
char *qn |
324 |
|
) |
325 |
|
{ |
326 |
|
if (!context[0]) /* global context accepts all */ |
336 |
|
void (*cs)(int n, double v) |
337 |
|
) |
338 |
|
{ |
339 |
< |
register EPNODE *ep; |
339 |
> |
EPNODE *ep; |
340 |
|
|
341 |
|
for (ep = outchan; ep != NULL; ep = ep->sibling) |
342 |
|
(*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling)); |
349 |
|
int lvl |
350 |
|
) |
351 |
|
{ |
352 |
< |
register int i; |
353 |
< |
register VARDEF *vp; |
354 |
< |
register EPNODE *ep; |
352 |
> |
int i; |
353 |
> |
VARDEF *vp; |
354 |
> |
EPNODE *ep; |
355 |
|
/* if context is global, clear all */ |
356 |
|
for (i = 0; i < NHASH; i++) |
357 |
|
for (vp = hashtbl[i]; vp != NULL; vp = vp->next) |
358 |
< |
if (incontext(vp->name)) |
358 |
> |
if (incontext(vp->name)) { |
359 |
|
if (lvl >= 2) |
360 |
|
dremove(vp->name); |
361 |
|
else |
362 |
|
dclear(vp->name); |
363 |
+ |
} |
364 |
|
if (lvl >= 1) { |
365 |
|
for (ep = outchan; ep != NULL; ep = ep->sibling) |
366 |
|
epfree(ep); |
374 |
|
char *name |
375 |
|
) |
376 |
|
{ |
377 |
< |
register VARDEF *vp; |
377 |
> |
VARDEF *vp; |
378 |
|
|
379 |
|
if ((vp = varlookup(name)) == NULL) |
380 |
|
return(NULL); |
388 |
|
) |
389 |
|
{ |
390 |
|
int lvl = 0; |
391 |
< |
register char *qname; |
392 |
< |
register VARDEF *vp; |
391 |
> |
char *qname; |
392 |
> |
VARDEF *vp; |
393 |
|
/* find most qualified match */ |
394 |
|
while ((qname = qualname(name, lvl++)) != NULL) |
395 |
|
for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next) |
404 |
|
char *name |
405 |
|
) |
406 |
|
{ |
407 |
< |
register VARDEF *vp; |
407 |
> |
VARDEF *vp; |
408 |
|
int hv; |
409 |
|
|
410 |
|
if ((vp = varlookup(name)) != NULL) { |
430 |
|
char *fn |
431 |
|
) |
432 |
|
{ |
433 |
< |
register int i; |
434 |
< |
register VARDEF *vp; |
433 |
> |
int i; |
434 |
> |
VARDEF *vp; |
435 |
|
/* if fn is NULL then relink all */ |
436 |
|
for (i = 0; i < NHASH; i++) |
437 |
|
for (vp = hashtbl[i]; vp != NULL; vp = vp->next) |
442 |
|
|
443 |
|
void |
444 |
|
varfree( /* release link to variable */ |
445 |
< |
register VARDEF *ln |
445 |
> |
VARDEF *ln |
446 |
|
) |
447 |
|
{ |
448 |
< |
register VARDEF *vp; |
448 |
> |
VARDEF *vp; |
449 |
|
int hv; |
450 |
|
|
451 |
|
if (--ln->nlinks > 0) |
478 |
|
EPNODE * |
479 |
|
dnext(void) /* return pointer to next definition */ |
480 |
|
{ |
481 |
< |
register EPNODE *ep; |
482 |
< |
register char *nm; |
481 |
> |
EPNODE *ep; |
482 |
> |
char *nm; |
483 |
|
|
484 |
|
while (htndx < NHASH) { |
485 |
|
if (htpos == NULL) |
503 |
|
char *name |
504 |
|
) |
505 |
|
{ |
506 |
< |
register VARDEF *vp; |
507 |
< |
register EPNODE *dp; |
506 |
> |
VARDEF *vp; |
507 |
> |
EPNODE *dp; |
508 |
|
|
509 |
|
if ((vp = varlookup(name)) == NULL || vp->def == NULL) |
510 |
|
return(NULL); |
518 |
|
void |
519 |
|
dpush( /* push on a definition */ |
520 |
|
char *nm, |
521 |
< |
register EPNODE *ep |
521 |
> |
EPNODE *ep |
522 |
|
) |
523 |
|
{ |
524 |
< |
register VARDEF *vp; |
524 |
> |
VARDEF *vp; |
525 |
|
|
526 |
|
vp = varinsert(nm); |
527 |
|
ep->sibling = vp->def; |
535 |
|
) |
536 |
|
{ |
537 |
|
int ch = sp->v.kid->v.chan; |
538 |
< |
register EPNODE *ep, *epl; |
538 |
> |
EPNODE *ep, *epl; |
539 |
|
|
540 |
|
for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling) |
541 |
|
if (ep->v.kid->v.chan >= ch) { |
563 |
|
void |
564 |
|
getstatement(void) /* get next statement */ |
565 |
|
{ |
566 |
< |
register EPNODE *ep; |
566 |
> |
EPNODE *ep; |
567 |
|
char *qname; |
568 |
< |
register VARDEF *vdef; |
568 |
> |
VARDEF *vdef; |
569 |
|
|
570 |
|
if (nextc == ';') { /* empty statement */ |
571 |
|
scan(); |
578 |
|
} else { /* ordinary definition */ |
579 |
|
ep = getdefn(); |
580 |
|
qname = qualname(dname(ep), 0); |
581 |
< |
if (esupport&E_REDEFW && (vdef = varlookup(qname)) != NULL) |
581 |
> |
if (esupport&E_REDEFW && (vdef = varlookup(qname)) != NULL) { |
582 |
|
if (vdef->def != NULL && epcmp(ep, vdef->def)) { |
583 |
|
wputs(qname); |
584 |
|
if (vdef->def->type == ':') |
589 |
|
wputs(qname); |
590 |
|
wputs(": definition hides library function\n"); |
591 |
|
} |
592 |
+ |
} |
593 |
|
if (ep->type == ':') |
594 |
|
dremove(qname); |
595 |
|
else |
611 |
|
/* FUNC(SYM,..) = E1 */ |
612 |
|
/* FUNC(SYM,..) : E1 */ |
613 |
|
{ |
614 |
< |
register EPNODE *ep1, *ep2; |
614 |
> |
EPNODE *ep1, *ep2; |
615 |
|
|
616 |
|
if (!isalpha(nextc) && nextc != CNTXMARK) |
617 |
|
syntax("illegal variable name"); |
628 |
|
do { |
629 |
|
scan(); |
630 |
|
if (!isalpha(nextc)) |
631 |
< |
syntax("illegal variable name"); |
631 |
> |
syntax("illegal parameter name"); |
632 |
|
ep2 = newnode(); |
633 |
|
ep2->type = SYM; |
634 |
|
ep2->v.name = savestr(getname()); |
651 |
|
|
652 |
|
if (ep1->type == SYM && ep1->sibling->type != NUM) { |
653 |
|
ep1 = newnode(); |
654 |
< |
ep1->type = TICK; |
654 |
> |
ep1->type = CLKT; |
655 |
|
ep1->v.tick = 0; |
656 |
|
addekid(ep2, ep1); |
657 |
|
ep1 = newnode(); |
667 |
|
EPNODE * |
668 |
|
getchan(void) /* A -> $N = E1 */ |
669 |
|
{ |
670 |
< |
register EPNODE *ep1, *ep2; |
670 |
> |
EPNODE *ep1, *ep2; |
671 |
|
|
672 |
|
if (nextc != '$') |
673 |
|
syntax("missing '$'"); |
696 |
|
*/ |
697 |
|
|
698 |
|
|
699 |
< |
static double |
700 |
< |
dvalue( /* evaluate a variable */ |
694 |
< |
char *name, |
695 |
< |
EPNODE *d |
696 |
< |
) |
699 |
> |
static double /* evaluate a variable */ |
700 |
> |
dvalue(char *name, EPNODE *d) |
701 |
|
{ |
702 |
< |
register EPNODE *ep1, *ep2; |
702 |
> |
EPNODE *ep1, *ep2; |
703 |
|
|
704 |
|
if (d == NULL || d->v.kid->type != SYM) { |
705 |
|
eputs(name); |
713 |
|
if (eclock >= MAXCLOCK) |
714 |
|
eclock = 1; /* wrap clock counter */ |
715 |
|
if (ep2->v.tick < MAXCLOCK && |
716 |
< |
ep2->v.tick == 0 | ep2->v.tick != eclock) { |
716 |
> |
(ep2->v.tick == 0) | (ep2->v.tick != eclock)) { |
717 |
|
ep2->v.tick = d->type == ':' ? MAXCLOCK : eclock; |
718 |
|
ep2 = ep2->sibling; |
719 |
|
ep2->v.num = evalue(ep1); /* needs new value */ |