home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 8
/
CDASC08.ISO
/
NEWS
/
RADIANCE
/
SRC
/
RT
/
CALDEFN.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-10-07
|
15KB
|
684 lines
/* Copyright (c) 1991 Regents of the University of California */
#ifndef lint
static char SCCSid[] = "@(#)caldefn.c 2.3 8/10/92 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
*
* 8/7/91 Added optional context path to append to variable names
*/
#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(), *emalloc(), *savestr(), *strcpy();
static int hash();
static double dvalue();
long eclock = -1; /* value storage timer */
static char context[MAXWORD+1]; /* current context path */
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)
getstatement();
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)
getstatement();
}
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;
{
char *qname;
register EPNODE *ep1, *ep2;
/* get qualified name */
qname = qualname(vname, 0);
/* check for quick set */
if ((ep1 = dlookup(qname)) != 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(qname);
dpush(qname, ep1);
}
dclear(name) /* delete variable definitions of name */
char *name;
{
register EPNODE *ep;
while ((ep = dpop(name)) != NULL) {
if (ep->type == ':') {
dpush(name, 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);
}
char *
setcontext(ctx) /* set a new context path */
register char *ctx;
{
register char *cpp;
if (ctx == NULL)
return(context); /* just asking */
if (!*ctx) {
context[0] = '\0'; /* clear context */
return(context);
}
cpp = context; /* else copy it (carefully!) */
if (*ctx != CNTXMARK)
*cpp++ = CNTXMARK; /* make sure there's a mark */
do {
if (cpp >= context+MAXWORD)
break; /* just copy what we can */
if (isid(*ctx))
*cpp++ = *ctx++;
else {
*cpp++ = '_'; ctx++;
}
} while (*ctx);
*cpp = '\0';
return(context);
}
char *
qualname(nam, lvl) /* get qualified name */
register char *nam;
int lvl;
{
static char nambuf[MAXWORD+1];
register char *cp = nambuf, *cpp;
/* check for explicit local */
if (*nam == CNTXMARK)
if (lvl > 0) /* only action is to refuse search */
return(NULL);
else
nam++;
else if (nam == nambuf) /* check for repeat call */
return(lvl > 0 ? NULL : nam);
/* copy name to static buffer */
while (*nam) {
if (cp >= nambuf+MAXWORD)
goto toolong;
*cp++ = *nam++;
}
/* check for explicit global */
if (cp > nambuf && cp[-1] == CNTXMARK) {
if (lvl > 0)
return(NULL);
*--cp = '\0';
return(nambuf); /* already qualified */
}
cpp = context; /* else skip the requested levels */
while (lvl-- > 0) {
if (!*cpp)
return(NULL); /* return NULL if past global level */
while (*++cpp && *cpp != CNTXMARK)
;
}
while (*cpp) { /* copy context to static buffer */
if (cp >= nambuf+MAXWORD)
goto toolong;
*cp++ = *cpp++;
}
toolong:
*cp = '\0';
return(nambuf); /* return qualified name */
}
incontext(qn) /* is qualified name in current context? */
register char *qn;
{
while (*qn && *qn != CNTXMARK) /* find context mark */
qn++;
return(!strcmp(qn, context));
}
#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->output,2->consts) */
int lvl;
{
register int i;
register VARDEF *vp;
register EPNODE *ep;
/* if context is global, clear all */
for (i = 0; i < NHASH; i++)
for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
if (!context[0] || incontext(vp->name))
if (lvl >= 2)
dremove(vp->name);
else
dclear(vp->name);
#ifdef OUTCHAN
if (lvl >= 1) {
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;
{
int lvl = 0;
register char *qname;
register VARDEF *vp;
/* find most qualified match */
while ((qname = qualname(name, lvl++)) != NULL)
for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next)
if (!strcmp(vp->name, qname))
return(vp);
return(NULL);
}
VARDEF *
varinsert(name) /* get a link to a variable */
char *name;
{
register VARDEF *vp;
int hv;
if ((vp = varlookup(name)) != NULL) {
vp->nlinks++;
return(vp);
}
vp = (VARDEF *)emalloc(sizeof(VARDEF));
#ifdef FUNCTION
vp->lib = liblookup(name);
#else
vp->lib = NULL;
#endif
if (vp->lib == NULL) /* if name not in library */
name = qualname(name, 0); /* use fully qualified version */
hv = hash(name);
vp->name = savestr(name);
vp->nlinks = 1;
vp->def = NULL;
vp->next = hashtbl[hv];
hashtbl[hv] = vp;
return(vp);
}
#ifdef FUNCTION
libupdate(fn) /* update library links */
char *fn;
{
register int i;
register VARDEF *vp;
/* if fn is NULL then relink all */
for (i = 0; i < NHASH; i++)
for (vp = hashtbl[i]; vp != NULL; vp = vp->next)
if (vp->lib != NULL || fn == NULL || !strcmp(fn, vp->name))
vp->lib = liblookup(vp->name);
}
#endif
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;
register char *nm;
while (htndx < NHASH) {
if (htpos == NULL)
htpos = hashtbl[htndx++];
while (htpos != NULL) {
ep = htpos->def;
nm = htpos->name;
htpos = htpos->next;
if (ep != NULL && incontext(nm))
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(nm, ep) /* push on a definition */
char *nm;
register EPNODE *ep;
{
register VARDEF *vp;
vp = varinsert(nm);
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
getstatement() /* get next statement */
{
register EPNODE *ep;
char *qname;
register VARDEF *vdef;
if (nextc == ';') { /* empty statement */
scan();
return;
}
#ifdef OUTCHAN
if (nextc == '$') { /* channel assignment */
ep = getchan();
addchan(ep);
} else
#endif
{ /* ordinary definition */
ep = getdefn();
qname = qualname(dname(ep), 0);
#ifdef REDEFW
if ((vdef = varlookup(qname)) != NULL)
if (vdef->def != NULL) {
wputs(qname);
if (vdef->def->type == ':')
wputs(": redefined constant expression\n");
else
wputs(": redefined\n");
}
#ifdef FUNCTION
else if (ep->v.kid->type == FUNC && vdef->lib != NULL) {
wputs(qname);
wputs(": definition hides library function\n");
}
#endif
#endif
if (ep->type == ':')
dremove(qname);
else
dclear(qname);
dpush(qname, 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) && nextc != CNTXMARK)
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);
}