src/common/caldefn.c

/* Copyright (c) 1991 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.
 *
 *  5/31/90  Added conditional compile (REDEFW) for redefinition warning.
 *
 *  4/23/91  Added ':' assignment for constant expressions
 */

#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();

static 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(fp, fname, 0);
    while (nextc != EOF)
        loaddefn();
    if (fname != NULL)
        fclose(fp);
}


scompile(str, fn, ln)           /* get definitions from a string */
char  *str;
char  *fn;
int  ln;
{
    initstr(str, fn, ln);
    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, assign, val)      /* set a variable's value */
char  *vname;
int  assign;
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;
            ep1->type = assign;
            return;
        }
    }
                                        /* hand build definition */
    ep1 = newnode();
    ep1->type = assign;
    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);
    dremove(vname);
    dpush(ep1);
}


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

    while ((ep = dpop(name)) != NULL) {
        if (ep->type == ':') {
            dpush(ep);          /* don't clear constants */
            return;
        }
        epfree(ep);
    }
}


dremove(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(cs)                     /* set output channels */
int  (*cs)();
{
    register EPNODE  *ep;

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

}
#endif


dcleanup(lvl)                   /* clear definitions (0->vars,1->consts,2->output) */
int  lvl;
{
    register int  i;
    register VARDEF  *vp;
    register EPNODE  *ep;

    for (i = 0; i < NHASH; i++)
        for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
            if (lvl >= 1)
                dremove(vp->name);
            else
                dclear(vp->name);
#ifdef  OUTCHAN
    if (lvl >= 2) {
        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;
    EPNODE  *lastdef;

    if (nextc == ';') {         /* empty statement */
        scan();
        return;
    }
#ifdef  OUTCHAN
    if (nextc == '$') {         /* channel assignment */
        ep = getchan();
        addchan(ep);
    } else
#endif
    {                           /* ordinary definition */
        ep = getdefn();
#ifdef  REDEFW
        if ((lastdef = dlookup(dname(ep))) != NULL) {
            wputs(dname(ep));
            if (lastdef->type == ':')
                wputs(": redefined constant expression\n");
            else
                wputs(": redefined\n");
        }
#ifdef  FUNCTION
        else if (ep->v.kid->type == FUNC &&
                        liblookup(ep->v.kid->v.kid->v.name) != NULL) {
            wputs(ep->v.kid->v.kid->v.name);
            wputs(": redefined library function\n");
        }
#endif
#endif
        if (ep->type == ':')
            dremove(dname(ep));
        else
            dclear(dname(ep));
        dpush(ep);
    }
    if (nextc != EOF) {
        if (nextc != ';')
            syntax("';' expected");
        scan();
    }
}


EPNODE *
getdefn()                       /* A -> SYM = E1 */
                                /*      SYM : E1 */
                                /*      FUNC(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 != '=' && nextc != ':')
        syntax("'=' or ':' expected");

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

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