--- ray/src/common/caldefn.c 1991/08/08 11:22:06 1.13 +++ ray/src/common/caldefn.c 1992/08/10 16:20:43 2.3 @@ -38,11 +38,13 @@ static char SCCSid[] = "$SunId$ LBL"; extern char *ecalloc(), *savestr(), *strcpy(); +static int hash(); + static double dvalue(); long eclock = -1; /* value storage timer */ -static char context[MAXWORD]; /* current context path */ +static char context[MAXWORD+1]; /* current context path */ static VARDEF *hashtbl[NHASH]; /* definition list */ static int htndx; /* index for */ @@ -195,12 +197,8 @@ register char *ctx; if (*ctx != CNTXMARK) *cpp++ = CNTXMARK; /* make sure there's a mark */ do { - if (cpp >= context+MAXWORD-1) { - *cpp = '\0'; - wputs(context); - wputs(": context path too long\n"); - return(NULL); - } + if (cpp >= context+MAXWORD) + break; /* just copy what we can */ if (isid(*ctx)) *cpp++ = *ctx++; else { @@ -217,47 +215,56 @@ qualname(nam, lvl) /* get qualified name */ register char *nam; int lvl; { - static char nambuf[MAXWORD]; - register char *cp = nambuf, *cpp = context; - /* check for repeat call */ - if (nam == nambuf) - return(lvl > 0 ? NULL : nambuf); + 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-1) + if (cp >= nambuf+MAXWORD) goto toolong; - if ((*cp++ = *nam++) == CNTXMARK) - cpp = NULL; /* flag a qualified name */ + *cp++ = *nam++; } - if (cpp == NULL) { + /* check for explicit global */ + if (cp > nambuf && cp[-1] == CNTXMARK) { if (lvl > 0) - return(NULL); /* no higher level */ - if (cp[-1] == CNTXMARK) { - cp--; cpp = context; /* current context explicitly */ - } else - cpp = ""; /* else fully qualified */ - } else /* else skip the requested levels */ - while (lvl-- > 0) { - if (!*cpp) - return(NULL); /* return NULL if past global level */ - while (*++cpp && *cpp != CNTXMARK) - ; - } + 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-1) + if (cp >= nambuf+MAXWORD) goto toolong; *cp++ = *cpp++; } - *cp = '\0'; - return(nambuf); /* return qualified name */ toolong: *cp = '\0'; - wputs(nambuf); - wputs(": name too long\n"); - return(NULL); + 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)(); @@ -277,13 +284,14 @@ 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 (lvl >= 2) - dremove(vp->name); - else - dclear(vp->name); + 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) @@ -333,19 +341,39 @@ char *name; vp->nlinks++; return(vp); } - name = qualname(name, 0); /* use fully qualified name */ - hv = hash(name); 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->lib = 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; { @@ -385,14 +413,16 @@ 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) + if (ep != NULL && incontext(nm)) return(ep); } } @@ -469,7 +499,7 @@ getstatement() /* get next statement */ { register EPNODE *ep; char *qname; - EPNODE *lastdef; + register VARDEF *vdef; if (nextc == ';') { /* empty statement */ scan(); @@ -485,18 +515,19 @@ getstatement() /* get next statement */ ep = getdefn(); qname = qualname(dname(ep), 0); #ifdef REDEFW - if ((lastdef = dlookup(qname)) != NULL) { - wputs(qname); - if (lastdef->type == ':') - wputs(": redefined constant expression\n"); - else - wputs(": redefined\n"); - } + 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 && liblookup(qname) != NULL) { - wputs(qname); - wputs(": definition hides library function\n"); - } + else if (ep->v.kid->type == FUNC && vdef->lib != NULL) { + wputs(qname); + wputs(": definition hides library function\n"); + } #endif #endif if (ep->type == ':') @@ -521,7 +552,7 @@ getdefn() /* A -> SYM = E1 */ { register EPNODE *ep1, *ep2; - if (!isalpha(nextc)) + if (!isalpha(nextc) && nextc != CNTXMARK) syntax("illegal variable name"); ep1 = newnode();