src/common/caldefn.c

/* Copyright (c) 1986 Regents of the University of California */

#ifndef lint
static char SCCSid[] = "$SunId$ LBL";
#endif

/*
 *  Store variable definitions.
 *
 *  7/1/85  Greg Ward
 *
 *  11/11/85  Added conditional compiles (OUTCHAN) for control output.
 *
 *  4/2/86  Added conditional compiles for function definitions (FUNCTION).
 *
 *  1/15/88  Added clock for caching of variable values.
 *
 *  11/16/88  Added VARDEF structure for hard linking.
 */

#include  <stdio.h>

#include  <ctype.h>

#include  "calcomp.h"

#ifndef  NHASH
#define  NHASH          521             /* hash size (a prime!) */
#endif

#define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE))

extern char  *ecalloc(), *savestr();

extern double  dvalue();

long  eclock = -1;                      /* value storage timer */

static VARDEF  *hashtbl[NHASH];         /* definition list */
static int  htndx;                      /* index for */         
static VARDEF  *htpos;                  /* ...dfirst() and */
#ifdef  OUTCHAN
static EPNODE  *ochpos;                 /* ...dnext */
static EPNODE  *outchan;
#endif

#ifdef  FUNCTION
EPNODE  *curfunc;
#define  dname(ep)      ((ep)->v.kid->type == SYM ? \
                        (ep)->v.kid->v.name : \
                        (ep)->v.kid->v.kid->v.name)
#else
#define  dname(ep)      ((ep)->v.kid->v.name)
#endif


fcompile(fname)                 /* get definitions from a file */
char  *fname;
{
    FILE  *fp;

    if (fname == NULL)
        fp = stdin;
    else if ((fp = fopen(fname, "r")) == NULL) {
        eputs(fname);
        eputs(": cannot open\n");
        quit(1);
    }
    initfile(fname, fp);
    while (nextc != EOF)
        loaddefn();
    if (fname != NULL)
        fclose(fp);
}


scompile(file, str)             /* get definitions from a string */
char  *file;
char  *str;
{
    initstr(file, str);
    while (nextc != EOF)
        loaddefn();
}


double
varvalue(vname)                 /* return a variable's value */
char  *vname;
{
    return(dvalue(vname, dlookup(vname)));
}


double
evariable(ep)                   /* evaluate a variable */
EPNODE  *ep;
{
    register VARDEF  *dp = ep->v.ln;

    return(dvalue(dp->name, dp->def));
}


varset(vname, val)              /* set a variable's value */
char  *vname;
double  val;
{
    register EPNODE  *ep1, *ep2;
                                        /* check for quick set */
    if ((ep1 = dlookup(vname)) != NULL && ep1->v.kid->type == SYM) {
        ep2 = ep1->v.kid->sibling;
        if (ep2->type == NUM) {
            ep2->v.num = val;
            ep2->sibling->v.tick = -1;
            return;
        }
    }
                                        /* hand build definition */
    ep1 = newnode();
    ep1->type = '=';
    ep2 = newnode();
    ep2->type = SYM;
    ep2->v.name = savestr(vname);
    addekid(ep1, ep2);
    ep2 = newnode();
    ep2->type = NUM;
    ep2->v.num = val;
    addekid(ep1, ep2);
    ep2 = newnode();
    ep2->type = TICK;
    ep2->v.tick = -1;
    addekid(ep1, ep2);
    ep2 = newnode();
    ep2->type = NUM;
    addekid(ep1, ep2);
    dclear(vname);
    dpush(ep1);
}


dclear(name)                    /* delete all definitions of name */
char  *name;
{
    register EPNODE  *ep;

    while ((ep = dpop(name)) != NULL)
        epfree(ep);
}


vardefined(name)        /* return non-zero if variable defined */
char  *name;
{
    register EPNODE  *dp;

    return((dp = dlookup(name)) != NULL && dp->v.kid->type == SYM);
}


#ifdef  OUTCHAN
chanout()                       /* set output channels */
{
    register EPNODE  *ep;

    for (ep = outchan; ep != NULL; ep = ep->sibling)
        chanset(ep->v.kid->v.chan, evalue(ep->v.kid->sibling));

}
#endif


dclearall()                     /* clear all definitions */
{
    register int  i;
    register VARDEF  *vp;
    register EPNODE  *ep;

    for (i = 0; i < NHASH; i++)
        for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
            dclear(vp->name);
#ifdef  OUTCHAN
    for (ep = outchan; ep != NULL; ep = ep->sibling)
        epfree(ep);
    outchan = NULL;
#endif
}


EPNODE *
dlookup(name)                   /* look up a definition */
char  *name;
{
    register VARDEF  *vp;
    
    if ((vp = varlookup(name)) == NULL)
        return(NULL);
    return(vp->def);
}


VARDEF *
varlookup(name)                 /* look up a variable */
char  *name;
{
    register VARDEF  *vp;
    
    for (vp = hashtbl[hash(name)]; vp != NULL; vp = vp->next)
        if (!strcmp(vp->name, name))
            return(vp);
    return(NULL);
}


VARDEF *
varinsert(name)                 /* get a link to a variable */
char  *name;
{
    register VARDEF  *vp;
    int  hv;
    
    hv = hash(name);
    for (vp = hashtbl[hv]; vp != NULL; vp = vp->next)
        if (!strcmp(vp->name, name)) {
            vp->nlinks++;
            return(vp);
        }
    vp = (VARDEF *)emalloc(sizeof(VARDEF));
    vp->name = savestr(name);
    vp->nlinks = 1;
    vp->def = NULL;
    vp->lib = NULL;
    vp->next = hashtbl[hv];
    hashtbl[hv] = vp;
    return(vp);
}


varfree(ln)                             /* release link to variable */
register VARDEF  *ln;
{
    register VARDEF  *vp;
    int  hv;

    if (--ln->nlinks > 0)
        return;                         /* still active */

    hv = hash(ln->name);
    vp = hashtbl[hv];
    if (vp == ln)
        hashtbl[hv] = vp->next;
    else {
        while (vp->next != ln)          /* must be in list */
                vp = vp->next;
        vp->next = ln->next;
    }
    freestr(ln->name);
    efree((char *)ln);
}


EPNODE *
dfirst()                        /* return pointer to first definition */
{
    htndx = 0;
    htpos = NULL;
#ifdef  OUTCHAN
    ochpos = outchan;
#endif
    return(dnext());
}


EPNODE *
dnext()                         /* return pointer to next definition */
{
    register EPNODE  *ep;

    while (htndx < NHASH) {
        if (htpos == NULL)
                htpos = hashtbl[htndx++];
        while (htpos != NULL) {
            ep = htpos->def;
            htpos = htpos->next;
            if (ep != NULL)
                return(ep);
        }
    }
#ifdef  OUTCHAN
    if ((ep = ochpos) != NULL)
        ochpos = ep->sibling;
    return(ep);
#else
    return(NULL);
#endif
}


EPNODE *
dpop(name)                      /* pop a definition */
char  *name;
{
    register VARDEF  *vp;
    register EPNODE  *dp;
    
    if ((vp = varlookup(name)) == NULL || vp->def == NULL)
        return(NULL);
    dp = vp->def;
    vp->def = dp->sibling;
    varfree(vp);
    return(dp);
}


dpush(ep)                       /* push on a definition */
register EPNODE  *ep;
{
    register VARDEF  *vp;

    vp = varinsert(dname(ep));
    ep->sibling = vp->def;
    vp->def = ep;
}


#ifdef  OUTCHAN
addchan(sp)                     /* add an output channel assignment */
EPNODE  *sp;
{
    int  ch = sp->v.kid->v.chan;
    register EPNODE  *ep, *epl;

    for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling)
        if (ep->v.kid->v.chan >= ch) {
            if (epl != NULL)
                epl->sibling = sp;
            else
                outchan = sp;
            if (ep->v.kid->v.chan > ch)
                sp->sibling = ep;
            else {
                sp->sibling = ep->sibling;
                epfree(ep);
            }
            return;
        }
    if (epl != NULL)
        epl->sibling = sp;
    else
        outchan = sp;
    sp->sibling = NULL;

}
#endif


loaddefn()                      /* load next definition */
{
    register EPNODE  *ep;

    if (nextc == ';') {         /* empty statement */
        scan();
        return;
    }
#ifdef  OUTCHAN
    if (nextc == '$') {         /* channel assignment */
        ep = getchan();
        addchan(ep);
    } else
#endif
    {                           /* ordinary definition */
        ep = getdefn();
        dclear(dname(ep));
        dpush(ep);
    }
    if (nextc != EOF) {
        if (nextc != ';')
            syntax("';' expected");
        scan();
    }
}


EPNODE *
getdefn()                       /* A -> SYM = E1 */
                                /*      FUNC(SYM,..) = E1 */
{
    register EPNODE  *ep1, *ep2;

    if (!isalpha(nextc))
        syntax("illegal variable name");

    ep1 = newnode();
    ep1->type = SYM;
    ep1->v.name = savestr(getname());

#ifdef  FUNCTION
    if (nextc == '(') {
        ep2 = newnode();
        ep2->type = FUNC;
        addekid(ep2, ep1);
        ep1 = ep2;
        do {
            scan();
            if (!isalpha(nextc))
                syntax("illegal variable name");
            ep2 = newnode();
            ep2->type = SYM;
            ep2->v.name = savestr(getname());
            addekid(ep1, ep2);
        } while (nextc == ',');
        if (nextc != ')')
            syntax("')' expected");
        scan();
        curfunc = ep1;
    } else
        curfunc = NULL;
#endif

    if (nextc != '=')
        syntax("'=' expected");
    scan();

    ep2 = newnode();
    ep2->type = '=';
    addekid(ep2, ep1);
    addekid(ep2, getE1());

#ifdef  FUNCTION
    if (ep1->type == SYM)
#endif
    {
        ep1 = newnode();
        ep1->type = TICK;
        ep1->v.tick = -1;
        addekid(ep2, ep1);
        ep1 = newnode();
        ep1->type = NUM;
        addekid(ep2, ep1);
    }

    return(ep2);
}


#ifdef  OUTCHAN
EPNODE *
getchan()                       /* A -> $N = E1 */
{
    register EPNODE  *ep1, *ep2;

    if (nextc != '$')
        syntax("missing '$'");
    scan();

    ep1 = newnode();
    ep1->type = CHAN;
    ep1->v.chan = getinum();

    if (nextc != '=')
        syntax("'=' expected");
    scan();

    ep2 = newnode();
    ep2->type = '=';
    addekid(ep2, ep1);
    addekid(ep2, getE1());

    return(ep2);
}
#endif


/*
 *  The following routines are for internal use only:
 */


static double
dvalue(name, d)                 /* evaluate a variable */
char  *name;
EPNODE  *d;
{
    register EPNODE  *ep1, *ep2;
    
    if (d == NULL || d->v.kid->type != SYM) {
        eputs(name);
        eputs(": undefined variable\n");
        quit(1);
    }
    ep1 = d->v.kid->sibling;                    /* get expression */
    ep2 = ep1->sibling;                         /* check time */
    if (ep2->v.tick < 0 || ep2->v.tick < eclock) {
        ep2->v.tick = eclock;
        ep2 = ep2->sibling;
        ep2->v.num = evalue(ep1);               /* compute new value */
    } else
        ep2 = ep2->sibling;                     /* reuse old value */

    return(ep2->v.num);
}


static int
hash(s)                         /* hash a string */
register char  *s;
{
    register int  rval = 0;

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