| 1 | – | /* Copyright (c) 1991 Regents of the University of California */ | 
| 2 | – |  | 
| 1 |  | #ifndef lint | 
| 2 | < | static char SCCSid[] = "$SunId$ LBL"; | 
| 2 | > | static const char       RCSid[] = "$Id$"; | 
| 3 |  | #endif | 
| 6 | – |  | 
| 4 |  | /* | 
| 5 |  | *  Store variable definitions. | 
| 6 |  | * | 
| 16 |  | * | 
| 17 |  | *  5/31/90  Added conditional compile (REDEFW) for redefinition warning. | 
| 18 |  | * | 
| 19 | < | *  4/23/91  Added ':' defines for constant expressions (RCONST) | 
| 19 | > | *  4/23/91  Added ':' assignment for constant expressions | 
| 20 | > | * | 
| 21 | > | *  8/7/91  Added optional context path to append to variable names | 
| 22 | > | * | 
| 23 | > | *  5/17/2001  Fixed clock counter wrapping behavior | 
| 24 | > | * | 
| 25 | > | *  2/19/03     Eliminated conditional compiles in favor of esupport extern. | 
| 26 |  | */ | 
| 27 |  |  | 
| 28 | + | #include "copyright.h" | 
| 29 | + |  | 
| 30 |  | #include  <stdio.h> | 
| 31 |  |  | 
| 32 | + | #include  <string.h> | 
| 33 | + |  | 
| 34 |  | #include  <ctype.h> | 
| 35 |  |  | 
| 36 |  | #include  "calcomp.h" | 
| 37 |  |  | 
| 38 | < | #ifndef  NHASH | 
| 39 | < | #define  NHASH          521             /* hash size (a prime!) */ | 
| 38 | > | #ifndef  NHASH | 
| 39 | > | #define  NHASH          521             /* hash size (a prime!) */ | 
| 40 |  | #endif | 
| 41 |  |  | 
| 42 | < | #define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE)) | 
| 42 | > | #define  hash(s)        (shash(s)%NHASH) | 
| 43 |  |  | 
| 44 | < | extern char  *ecalloc(), *savestr(); | 
| 44 | > | #define  newnode()      (EPNODE *)ecalloc(1, sizeof(EPNODE)) | 
| 45 |  |  | 
| 46 |  | static double  dvalue(); | 
| 47 |  |  | 
| 48 | < | long  eclock = -1;                      /* value storage timer */ | 
| 48 | > | #define  MAXCLOCK       (1L<<31)        /* clock wrap value */ | 
| 49 |  |  | 
| 50 | + | unsigned long  eclock = 0;              /* value storage timer */ | 
| 51 | + |  | 
| 52 | + | #define  MAXCNTX        1023            /* maximum context length */ | 
| 53 | + |  | 
| 54 | + | static char  context[MAXCNTX+1];        /* current context path */ | 
| 55 | + |  | 
| 56 |  | static VARDEF  *hashtbl[NHASH];         /* definition list */ | 
| 57 |  | static int  htndx;                      /* index for */ | 
| 58 |  | static VARDEF  *htpos;                  /* ...dfirst() and */ | 
| 46 | – | #ifdef  OUTCHAN | 
| 59 |  | static EPNODE  *ochpos;                 /* ...dnext */ | 
| 60 |  | static EPNODE  *outchan; | 
| 49 | – | #endif | 
| 61 |  |  | 
| 62 | < | #ifdef  FUNCTION | 
| 63 | < | EPNODE  *curfunc; | 
| 53 | < | #define  dname(ep)      ((ep)->v.kid->type == SYM ? \ | 
| 62 | > | EPNODE  *curfunc = NULL; | 
| 63 | > | #define  dname(ep)      ((ep)->v.kid->type == SYM ? \ | 
| 64 |  | (ep)->v.kid->v.name : \ | 
| 65 |  | (ep)->v.kid->v.kid->v.name) | 
| 56 | – | #else | 
| 57 | – | #define  dname(ep)      ((ep)->v.kid->v.name) | 
| 58 | – | #endif | 
| 66 |  |  | 
| 67 |  |  | 
| 68 | + | void | 
| 69 |  | fcompile(fname)                 /* get definitions from a file */ | 
| 70 |  | char  *fname; | 
| 71 |  | { | 
| 80 |  | } | 
| 81 |  | initfile(fp, fname, 0); | 
| 82 |  | while (nextc != EOF) | 
| 83 | < | loaddefn(); | 
| 83 | > | getstatement(); | 
| 84 |  | if (fname != NULL) | 
| 85 |  | fclose(fp); | 
| 86 |  | } | 
| 87 |  |  | 
| 88 |  |  | 
| 89 | + | void | 
| 90 |  | scompile(str, fn, ln)           /* get definitions from a string */ | 
| 91 |  | char  *str; | 
| 92 |  | char  *fn; | 
| 94 |  | { | 
| 95 |  | initstr(str, fn, ln); | 
| 96 |  | while (nextc != EOF) | 
| 97 | < | loaddefn(); | 
| 97 | > | getstatement(); | 
| 98 |  | } | 
| 99 |  |  | 
| 100 |  |  | 
| 108 |  |  | 
| 109 |  | double | 
| 110 |  | evariable(ep)                   /* evaluate a variable */ | 
| 111 | < | EPNODE  *ep; | 
| 111 | > | EPNODE  *ep; | 
| 112 |  | { | 
| 113 |  | register VARDEF  *dp = ep->v.ln; | 
| 114 |  |  | 
| 116 |  | } | 
| 117 |  |  | 
| 118 |  |  | 
| 119 | + | void | 
| 120 |  | varset(vname, assign, val)      /* set a variable's value */ | 
| 121 |  | char  *vname; | 
| 122 |  | int  assign; | 
| 123 | < | double  val; | 
| 123 | > | double  val; | 
| 124 |  | { | 
| 125 | + | char  *qname; | 
| 126 |  | register EPNODE  *ep1, *ep2; | 
| 127 | + | /* get qualified name */ | 
| 128 | + | qname = qualname(vname, 0); | 
| 129 |  | /* check for quick set */ | 
| 130 | < | if ((ep1 = dlookup(vname)) != NULL && ep1->v.kid->type == SYM) { | 
| 130 | > | if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM) { | 
| 131 |  | ep2 = ep1->v.kid->sibling; | 
| 132 |  | if (ep2->type == NUM) { | 
| 133 |  | ep2->v.num = val; | 
| 146 |  | ep2->type = NUM; | 
| 147 |  | ep2->v.num = val; | 
| 148 |  | addekid(ep1, ep2); | 
| 149 | < | dremove(vname); | 
| 150 | < | dpush(ep1); | 
| 149 | > | dremove(qname); | 
| 150 | > | dpush(qname, ep1); | 
| 151 |  | } | 
| 152 |  |  | 
| 153 |  |  | 
| 154 | + | void | 
| 155 |  | dclear(name)                    /* delete variable definitions of name */ | 
| 156 |  | char  *name; | 
| 157 |  | { | 
| 159 |  |  | 
| 160 |  | while ((ep = dpop(name)) != NULL) { | 
| 161 |  | if (ep->type == ':') { | 
| 162 | < | dpush(ep);          /* don't clear constants */ | 
| 162 | > | dpush(name, ep);            /* don't clear constants */ | 
| 163 |  | return; | 
| 164 |  | } | 
| 165 |  | epfree(ep); | 
| 167 |  | } | 
| 168 |  |  | 
| 169 |  |  | 
| 170 | + | void | 
| 171 |  | dremove(name)                   /* delete all definitions of name */ | 
| 172 |  | char  *name; | 
| 173 |  | { | 
| 178 |  | } | 
| 179 |  |  | 
| 180 |  |  | 
| 181 | + | int | 
| 182 |  | vardefined(name)        /* return non-zero if variable defined */ | 
| 183 |  | char  *name; | 
| 184 |  | { | 
| 188 |  | } | 
| 189 |  |  | 
| 190 |  |  | 
| 191 | < | #ifdef  OUTCHAN | 
| 191 | > | char * | 
| 192 | > | setcontext(ctx)                 /* set a new context path */ | 
| 193 | > | register char  *ctx; | 
| 194 | > | { | 
| 195 | > | register char  *cpp; | 
| 196 | > |  | 
| 197 | > | if (ctx == NULL) | 
| 198 | > | return(context);                /* just asking */ | 
| 199 | > | while (*ctx == CNTXMARK) | 
| 200 | > | ctx++;                          /* skip past marks */ | 
| 201 | > | if (!*ctx) { | 
| 202 | > | context[0] = '\0';              /* empty means clear context */ | 
| 203 | > | return(context); | 
| 204 | > | } | 
| 205 | > | cpp = context;                      /* start context with mark */ | 
| 206 | > | *cpp++ = CNTXMARK; | 
| 207 | > | do {                                /* carefully copy new context */ | 
| 208 | > | if (cpp >= context+MAXCNTX) | 
| 209 | > | break;                      /* just copy what we can */ | 
| 210 | > | if (isid(*ctx)) | 
| 211 | > | *cpp++ = *ctx++; | 
| 212 | > | else { | 
| 213 | > | *cpp++ = '_'; ctx++; | 
| 214 | > | } | 
| 215 | > | } while (*ctx); | 
| 216 | > | while (cpp[-1] == CNTXMARK)         /* cannot end in context mark */ | 
| 217 | > | cpp--; | 
| 218 | > | *cpp = '\0'; | 
| 219 | > | return(context); | 
| 220 | > | } | 
| 221 | > |  | 
| 222 | > |  | 
| 223 | > | char * | 
| 224 | > | pushcontext(ctx)                /* push on another context */ | 
| 225 | > | char  *ctx; | 
| 226 | > | { | 
| 227 | > | extern char  *strncpy(), *strcpy(); | 
| 228 | > | char  oldcontext[MAXCNTX+1]; | 
| 229 | > | register int  n; | 
| 230 | > |  | 
| 231 | > | strcpy(oldcontext, context);        /* save old context */ | 
| 232 | > | setcontext(ctx);                    /* set new context */ | 
| 233 | > | n = strlen(context);                /* tack on old */ | 
| 234 | > | if (n+strlen(oldcontext) > MAXCNTX) { | 
| 235 | > | strncpy(context+n, oldcontext, MAXCNTX-n); | 
| 236 | > | context[MAXCNTX] = '\0'; | 
| 237 | > | } else | 
| 238 | > | strcpy(context+n, oldcontext); | 
| 239 | > | return(context); | 
| 240 | > | } | 
| 241 | > |  | 
| 242 | > |  | 
| 243 | > | char * | 
| 244 | > | popcontext()                    /* pop off top context */ | 
| 245 | > | { | 
| 246 | > | register char  *cp1, *cp2; | 
| 247 | > |  | 
| 248 | > | if (!context[0])                    /* nothing left to pop */ | 
| 249 | > | return(context); | 
| 250 | > | cp2 = context;                      /* find mark */ | 
| 251 | > | while (*++cp2 && *cp2 != CNTXMARK) | 
| 252 | > | ; | 
| 253 | > | cp1 = context;                      /* copy tail to front */ | 
| 254 | > | while (*cp1++ = *cp2++) | 
| 255 | > | ; | 
| 256 | > | return(context); | 
| 257 | > | } | 
| 258 | > |  | 
| 259 | > |  | 
| 260 | > | char * | 
| 261 | > | qualname(nam, lvl)              /* get qualified name */ | 
| 262 | > | register char  *nam; | 
| 263 | > | int  lvl; | 
| 264 | > | { | 
| 265 | > | static char  nambuf[MAXWORD+1]; | 
| 266 | > | register char  *cp = nambuf, *cpp; | 
| 267 | > | /* check for explicit local */ | 
| 268 | > | if (*nam == CNTXMARK) | 
| 269 | > | if (lvl > 0)            /* only action is to refuse search */ | 
| 270 | > | return(NULL); | 
| 271 | > | else | 
| 272 | > | nam++; | 
| 273 | > | else if (nam == nambuf)     /* check for repeat call */ | 
| 274 | > | return(lvl > 0 ? NULL : nam); | 
| 275 | > | /* copy name to static buffer */ | 
| 276 | > | while (*nam) { | 
| 277 | > | if (cp >= nambuf+MAXWORD) | 
| 278 | > | goto toolong; | 
| 279 | > | *cp++ = *nam++; | 
| 280 | > | } | 
| 281 | > | /* check for explicit global */ | 
| 282 | > | if (cp > nambuf && cp[-1] == CNTXMARK) { | 
| 283 | > | if (lvl > 0) | 
| 284 | > | return(NULL); | 
| 285 | > | *--cp = '\0'; | 
| 286 | > | return(nambuf);         /* already qualified */ | 
| 287 | > | } | 
| 288 | > | cpp = context;              /* else skip the requested levels */ | 
| 289 | > | while (lvl-- > 0) { | 
| 290 | > | if (!*cpp) | 
| 291 | > | return(NULL);       /* return NULL if past global level */ | 
| 292 | > | while (*++cpp && *cpp != CNTXMARK) | 
| 293 | > | ; | 
| 294 | > | } | 
| 295 | > | while (*cpp) {              /* copy context to static buffer */ | 
| 296 | > | if (cp >= nambuf+MAXWORD) | 
| 297 | > | goto toolong; | 
| 298 | > | *cp++ = *cpp++; | 
| 299 | > | } | 
| 300 | > | toolong: | 
| 301 | > | *cp = '\0'; | 
| 302 | > | return(nambuf);             /* return qualified name */ | 
| 303 | > | } | 
| 304 | > |  | 
| 305 | > |  | 
| 306 | > | int | 
| 307 | > | incontext(qn)                   /* is qualified name in current context? */ | 
| 308 | > | register char  *qn; | 
| 309 | > | { | 
| 310 | > | if (!context[0])                    /* global context accepts all */ | 
| 311 | > | return(1); | 
| 312 | > | while (*qn && *qn != CNTXMARK)      /* find context mark */ | 
| 313 | > | qn++; | 
| 314 | > | return(!strcmp(qn, context)); | 
| 315 | > | } | 
| 316 | > |  | 
| 317 | > |  | 
| 318 | > | void | 
| 319 |  | chanout(cs)                     /* set output channels */ | 
| 320 |  | int  (*cs)(); | 
| 321 |  | { | 
| 325 |  | (*cs)(ep->v.kid->v.chan, evalue(ep->v.kid->sibling)); | 
| 326 |  |  | 
| 327 |  | } | 
| 185 | – | #endif | 
| 328 |  |  | 
| 329 |  |  | 
| 330 | < | dcleanup(cons, ochans)          /* clear definitions */ | 
| 331 | < | int  cons, ochans; | 
| 330 | > | void | 
| 331 | > | dcleanup(lvl)           /* clear definitions (0->vars,1->output,2->consts) */ | 
| 332 | > | int  lvl; | 
| 333 |  | { | 
| 334 |  | register int  i; | 
| 335 |  | register VARDEF  *vp; | 
| 336 |  | register EPNODE  *ep; | 
| 337 | < |  | 
| 337 | > | /* if context is global, clear all */ | 
| 338 |  | for (i = 0; i < NHASH; i++) | 
| 339 |  | for (vp = hashtbl[i]; vp != NULL; vp = vp->next) | 
| 340 | < | if (cons) | 
| 341 | < | dremove(vp->name); | 
| 342 | < | else | 
| 343 | < | dclear(vp->name); | 
| 344 | < | #ifdef  OUTCHAN | 
| 345 | < | if (ochans) { | 
| 340 | > | if (incontext(vp->name)) | 
| 341 | > | if (lvl >= 2) | 
| 342 | > | dremove(vp->name); | 
| 343 | > | else | 
| 344 | > | dclear(vp->name); | 
| 345 | > | if (lvl >= 1) { | 
| 346 |  | for (ep = outchan; ep != NULL; ep = ep->sibling) | 
| 347 |  | epfree(ep); | 
| 348 |  | outchan = NULL; | 
| 349 |  | } | 
| 207 | – | #endif | 
| 350 |  | } | 
| 351 |  |  | 
| 352 |  |  | 
| 357 |  | register VARDEF  *vp; | 
| 358 |  |  | 
| 359 |  | if ((vp = varlookup(name)) == NULL) | 
| 360 | < | return(NULL); | 
| 360 | > | return(NULL); | 
| 361 |  | return(vp->def); | 
| 362 |  | } | 
| 363 |  |  | 
| 366 |  | varlookup(name)                 /* look up a variable */ | 
| 367 |  | char  *name; | 
| 368 |  | { | 
| 369 | + | int  lvl = 0; | 
| 370 | + | register char  *qname; | 
| 371 |  | register VARDEF  *vp; | 
| 372 | < |  | 
| 373 | < | for (vp = hashtbl[hash(name)]; vp != NULL; vp = vp->next) | 
| 374 | < | if (!strcmp(vp->name, name)) | 
| 375 | < | return(vp); | 
| 372 | > | /* find most qualified match */ | 
| 373 | > | while ((qname = qualname(name, lvl++)) != NULL) | 
| 374 | > | for (vp = hashtbl[hash(qname)]; vp != NULL; vp = vp->next) | 
| 375 | > | if (!strcmp(vp->name, qname)) | 
| 376 | > | return(vp); | 
| 377 |  | return(NULL); | 
| 378 |  | } | 
| 379 |  |  | 
| 383 |  | char  *name; | 
| 384 |  | { | 
| 385 |  | register VARDEF  *vp; | 
| 386 | < | int  hv; | 
| 386 | > | int  hv; | 
| 387 |  |  | 
| 388 | < | hv = hash(name); | 
| 389 | < | for (vp = hashtbl[hv]; vp != NULL; vp = vp->next) | 
| 390 | < | if (!strcmp(vp->name, name)) { | 
| 391 | < | vp->nlinks++; | 
| 247 | < | return(vp); | 
| 248 | < | } | 
| 388 | > | if ((vp = varlookup(name)) != NULL) { | 
| 389 | > | vp->nlinks++; | 
| 390 | > | return(vp); | 
| 391 | > | } | 
| 392 |  | vp = (VARDEF *)emalloc(sizeof(VARDEF)); | 
| 393 | + | vp->lib = liblookup(name); | 
| 394 | + | if (vp->lib == NULL)                /* if name not in library */ | 
| 395 | + | name = qualname(name, 0);       /* use fully qualified version */ | 
| 396 | + | hv = hash(name); | 
| 397 |  | vp->name = savestr(name); | 
| 398 |  | vp->nlinks = 1; | 
| 399 |  | vp->def = NULL; | 
| 253 | – | vp->lib = NULL; | 
| 400 |  | vp->next = hashtbl[hv]; | 
| 401 |  | hashtbl[hv] = vp; | 
| 402 |  | return(vp); | 
| 403 |  | } | 
| 404 |  |  | 
| 405 |  |  | 
| 406 | + | void | 
| 407 | + | libupdate(fn)                   /* update library links */ | 
| 408 | + | char  *fn; | 
| 409 | + | { | 
| 410 | + | register int  i; | 
| 411 | + | register VARDEF  *vp; | 
| 412 | + | /* if fn is NULL then relink all */ | 
| 413 | + | for (i = 0; i < NHASH; i++) | 
| 414 | + | for (vp = hashtbl[i]; vp != NULL; vp = vp->next) | 
| 415 | + | if (vp->lib != NULL || fn == NULL || !strcmp(fn, vp->name)) | 
| 416 | + | vp->lib = liblookup(vp->name); | 
| 417 | + | } | 
| 418 | + |  | 
| 419 | + |  | 
| 420 | + | void | 
| 421 |  | varfree(ln)                             /* release link to variable */ | 
| 422 | < | register VARDEF  *ln; | 
| 422 | > | register VARDEF  *ln; | 
| 423 |  | { | 
| 424 |  | register VARDEF  *vp; | 
| 425 | < | int  hv; | 
| 425 | > | int  hv; | 
| 426 |  |  | 
| 427 |  | if (--ln->nlinks > 0) | 
| 428 | < | return;                         /* still active */ | 
| 428 | > | return;                         /* still active */ | 
| 429 |  |  | 
| 430 |  | hv = hash(ln->name); | 
| 431 |  | vp = hashtbl[hv]; | 
| 432 |  | if (vp == ln) | 
| 433 | < | hashtbl[hv] = vp->next; | 
| 433 | > | hashtbl[hv] = vp->next; | 
| 434 |  | else { | 
| 435 | < | while (vp->next != ln)          /* must be in list */ | 
| 436 | < | vp = vp->next; | 
| 437 | < | vp->next = ln->next; | 
| 435 | > | while (vp->next != ln)          /* must be in list */ | 
| 436 | > | vp = vp->next; | 
| 437 | > | vp->next = ln->next; | 
| 438 |  | } | 
| 439 |  | freestr(ln->name); | 
| 440 |  | efree((char *)ln); | 
| 446 |  | { | 
| 447 |  | htndx = 0; | 
| 448 |  | htpos = NULL; | 
| 288 | – | #ifdef  OUTCHAN | 
| 449 |  | ochpos = outchan; | 
| 290 | – | #endif | 
| 450 |  | return(dnext()); | 
| 451 |  | } | 
| 452 |  |  | 
| 455 |  | dnext()                         /* return pointer to next definition */ | 
| 456 |  | { | 
| 457 |  | register EPNODE  *ep; | 
| 458 | + | register char  *nm; | 
| 459 |  |  | 
| 460 |  | while (htndx < NHASH) { | 
| 461 | < | if (htpos == NULL) | 
| 462 | < | htpos = hashtbl[htndx++]; | 
| 463 | < | while (htpos != NULL) { | 
| 464 | < | ep = htpos->def; | 
| 465 | < | htpos = htpos->next; | 
| 466 | < | if (ep != NULL) | 
| 467 | < | return(ep); | 
| 468 | < | } | 
| 461 | > | if (htpos == NULL) | 
| 462 | > | htpos = hashtbl[htndx++]; | 
| 463 | > | while (htpos != NULL) { | 
| 464 | > | ep = htpos->def; | 
| 465 | > | nm = htpos->name; | 
| 466 | > | htpos = htpos->next; | 
| 467 | > | if (ep != NULL && incontext(nm)) | 
| 468 | > | return(ep); | 
| 469 | > | } | 
| 470 |  | } | 
| 310 | – | #ifdef  OUTCHAN | 
| 471 |  | if ((ep = ochpos) != NULL) | 
| 472 | < | ochpos = ep->sibling; | 
| 472 | > | ochpos = ep->sibling; | 
| 473 |  | return(ep); | 
| 314 | – | #else | 
| 315 | – | return(NULL); | 
| 316 | – | #endif | 
| 474 |  | } | 
| 475 |  |  | 
| 476 |  |  | 
| 482 |  | register EPNODE  *dp; | 
| 483 |  |  | 
| 484 |  | if ((vp = varlookup(name)) == NULL || vp->def == NULL) | 
| 485 | < | return(NULL); | 
| 485 | > | return(NULL); | 
| 486 |  | dp = vp->def; | 
| 487 |  | vp->def = dp->sibling; | 
| 488 |  | varfree(vp); | 
| 490 |  | } | 
| 491 |  |  | 
| 492 |  |  | 
| 493 | < | dpush(ep)                       /* push on a definition */ | 
| 494 | < | register EPNODE  *ep; | 
| 493 | > | void | 
| 494 | > | dpush(nm, ep)                   /* push on a definition */ | 
| 495 | > | char  *nm; | 
| 496 | > | register EPNODE  *ep; | 
| 497 |  | { | 
| 498 |  | register VARDEF  *vp; | 
| 499 |  |  | 
| 500 | < | vp = varinsert(dname(ep)); | 
| 500 | > | vp = varinsert(nm); | 
| 501 |  | ep->sibling = vp->def; | 
| 502 |  | vp->def = ep; | 
| 503 |  | } | 
| 504 |  |  | 
| 505 |  |  | 
| 506 | < | #ifdef  OUTCHAN | 
| 506 | > | void | 
| 507 |  | addchan(sp)                     /* add an output channel assignment */ | 
| 508 | < | EPNODE  *sp; | 
| 508 | > | EPNODE  *sp; | 
| 509 |  | { | 
| 510 | < | int  ch = sp->v.kid->v.chan; | 
| 510 | > | int  ch = sp->v.kid->v.chan; | 
| 511 |  | register EPNODE  *ep, *epl; | 
| 512 |  |  | 
| 513 |  | for (epl = NULL, ep = outchan; ep != NULL; epl = ep, ep = ep->sibling) | 
| 531 |  | sp->sibling = NULL; | 
| 532 |  |  | 
| 533 |  | } | 
| 375 | – | #endif | 
| 534 |  |  | 
| 535 |  |  | 
| 536 | < | loaddefn()                      /* load next definition */ | 
| 536 | > | void | 
| 537 | > | getstatement()                  /* get next statement */ | 
| 538 |  | { | 
| 539 |  | register EPNODE  *ep; | 
| 540 | + | char  *qname; | 
| 541 | + | register VARDEF  *vdef; | 
| 542 |  |  | 
| 543 |  | if (nextc == ';') {         /* empty statement */ | 
| 544 |  | scan(); | 
| 545 |  | return; | 
| 546 |  | } | 
| 547 | < | #ifdef  OUTCHAN | 
| 548 | < | if (nextc == '$') {         /* channel assignment */ | 
| 547 | > | if (esupport&E_OUTCHAN && | 
| 548 | > | nextc == '$') {         /* channel assignment */ | 
| 549 |  | ep = getchan(); | 
| 550 |  | addchan(ep); | 
| 551 | < | } else | 
| 391 | < | #endif | 
| 392 | < | {                           /* ordinary definition */ | 
| 551 | > | } else {                            /* ordinary definition */ | 
| 552 |  | ep = getdefn(); | 
| 553 | < | #ifdef  REDEFW | 
| 554 | < | if (dlookup(dname(ep)) != NULL) { | 
| 555 | < | dclear(dname(ep)); | 
| 556 | < | wputs(dname(ep)); | 
| 557 | < | if (dlookup(dname(ep)) == NULL) | 
| 558 | < | wputs(": redefined\n"); | 
| 559 | < | else | 
| 560 | < | wputs(": redefined constant expression\n"); | 
| 561 | < | } | 
| 562 | < | #ifdef  FUNCTION | 
| 563 | < | else if (ep->v.kid->type == FUNC && | 
| 564 | < | liblookup(ep->v.kid->v.kid->v.name) != NULL) { | 
| 565 | < | wputs(ep->v.kid->v.kid->v.name); | 
| 566 | < | wputs(": redefined library function\n"); | 
| 567 | < | } | 
| 568 | < | #endif | 
| 569 | < | #else | 
| 411 | < | dclear(dname(ep)); | 
| 412 | < | #endif | 
| 413 | < | dpush(ep); | 
| 553 | > | qname = qualname(dname(ep), 0); | 
| 554 | > | if (esupport&E_REDEFW && (vdef = varlookup(qname)) != NULL) | 
| 555 | > | if (vdef->def != NULL && epcmp(ep, vdef->def)) { | 
| 556 | > | wputs(qname); | 
| 557 | > | if (vdef->def->type == ':') | 
| 558 | > | wputs(": redefined constant expression\n"); | 
| 559 | > | else | 
| 560 | > | wputs(": redefined\n"); | 
| 561 | > | } else if (ep->v.kid->type == FUNC && vdef->lib != NULL) { | 
| 562 | > | wputs(qname); | 
| 563 | > | wputs(": definition hides library function\n"); | 
| 564 | > | } | 
| 565 | > | if (ep->type == ':') | 
| 566 | > | dremove(qname); | 
| 567 | > | else | 
| 568 | > | dclear(qname); | 
| 569 | > | dpush(qname, ep); | 
| 570 |  | } | 
| 571 |  | if (nextc != EOF) { | 
| 572 |  | if (nextc != ';') | 
| 579 |  | EPNODE * | 
| 580 |  | getdefn()                       /* A -> SYM = E1 */ | 
| 581 |  | /*      SYM : E1 */ | 
| 582 | < | /*      FUNC(SYM,..) = E1 */ | 
| 582 | > | /*      FUNC(SYM,..) = E1 */ | 
| 583 |  | /*      FUNC(SYM,..) : E1 */ | 
| 584 |  | { | 
| 585 |  | register EPNODE  *ep1, *ep2; | 
| 586 |  |  | 
| 587 | < | if (!isalpha(nextc)) | 
| 587 | > | if (!isalpha(nextc) && nextc != CNTXMARK) | 
| 588 |  | syntax("illegal variable name"); | 
| 589 |  |  | 
| 590 |  | ep1 = newnode(); | 
| 591 |  | ep1->type = SYM; | 
| 592 |  | ep1->v.name = savestr(getname()); | 
| 593 |  |  | 
| 594 | < | #ifdef  FUNCTION | 
| 439 | < | if (nextc == '(') { | 
| 594 | > | if (esupport&E_FUNCTION && nextc == '(') { | 
| 595 |  | ep2 = newnode(); | 
| 596 |  | ep2->type = FUNC; | 
| 597 |  | addekid(ep2, ep1); | 
| 609 |  | syntax("')' expected"); | 
| 610 |  | scan(); | 
| 611 |  | curfunc = ep1; | 
| 612 | < | } else | 
| 458 | < | curfunc = NULL; | 
| 459 | < | #endif | 
| 612 | > | } | 
| 613 |  |  | 
| 614 |  | if (nextc != '=' && nextc != ':') | 
| 615 |  | syntax("'=' or ':' expected"); | 
| 618 |  | ep2->type = nextc; | 
| 619 |  | scan(); | 
| 620 |  | addekid(ep2, ep1); | 
| 468 | – | #ifdef  RCONST | 
| 469 | – | if ( | 
| 470 | – | #ifdef  FUNCTION | 
| 471 | – | ep1->type == SYM && | 
| 472 | – | #endif | 
| 473 | – | ep2->type == ':') | 
| 474 | – | addekid(ep2, rconst(getE1())); | 
| 475 | – | else | 
| 476 | – | #endif | 
| 621 |  | addekid(ep2, getE1()); | 
| 622 |  |  | 
| 623 | < | if ( | 
| 480 | < | #ifdef  FUNCTION | 
| 481 | < | ep1->type == SYM && | 
| 482 | < | #endif | 
| 483 | < | ep1->sibling->type != NUM) { | 
| 623 | > | if (ep1->type == SYM && ep1->sibling->type != NUM) { | 
| 624 |  | ep1 = newnode(); | 
| 625 |  | ep1->type = TICK; | 
| 626 | < | ep1->v.tick = -1; | 
| 626 | > | ep1->v.tick = 0; | 
| 627 |  | addekid(ep2, ep1); | 
| 628 |  | ep1 = newnode(); | 
| 629 |  | ep1->type = NUM; | 
| 630 |  | addekid(ep2, ep1); | 
| 631 |  | } | 
| 632 | + | curfunc = NULL; | 
| 633 |  |  | 
| 634 |  | return(ep2); | 
| 635 |  | } | 
| 636 |  |  | 
| 637 |  |  | 
| 497 | – | #ifdef  OUTCHAN | 
| 638 |  | EPNODE * | 
| 639 |  | getchan()                       /* A -> $N = E1 */ | 
| 640 |  | { | 
| 659 |  |  | 
| 660 |  | return(ep2); | 
| 661 |  | } | 
| 522 | – | #endif | 
| 662 |  |  | 
| 663 |  |  | 
| 664 |  |  | 
| 670 |  | static double | 
| 671 |  | dvalue(name, d)                 /* evaluate a variable */ | 
| 672 |  | char  *name; | 
| 673 | < | EPNODE  *d; | 
| 673 | > | EPNODE  *d; | 
| 674 |  | { | 
| 675 |  | register EPNODE  *ep1, *ep2; | 
| 676 |  |  | 
| 683 |  | if (ep1->type == NUM) | 
| 684 |  | return(ep1->v.num);                     /* return if number */ | 
| 685 |  | ep2 = ep1->sibling;                         /* check time */ | 
| 686 | < | if (ep2->v.tick < 0 || ep2->v.tick < eclock) { | 
| 687 | < | ep2->v.tick = d->type == ':' ? 1L<<30 : eclock; | 
| 686 | > | if (eclock >= MAXCLOCK) | 
| 687 | > | eclock = 1;                             /* wrap clock counter */ | 
| 688 | > | if (ep2->v.tick < MAXCLOCK && | 
| 689 | > | ep2->v.tick == 0 | ep2->v.tick != eclock) { | 
| 690 | > | ep2->v.tick = d->type == ':' ? MAXCLOCK : eclock; | 
| 691 |  | ep2 = ep2->sibling; | 
| 692 |  | ep2->v.num = evalue(ep1);               /* needs new value */ | 
| 693 |  | } else | 
| 694 |  | ep2 = ep2->sibling;                     /* else reuse old value */ | 
| 695 |  |  | 
| 696 |  | return(ep2->v.num); | 
| 555 | – | } | 
| 556 | – |  | 
| 557 | – |  | 
| 558 | – | static int | 
| 559 | – | hash(s)                         /* hash a string */ | 
| 560 | – | register char  *s; | 
| 561 | – | { | 
| 562 | – | register int  rval = 0; | 
| 563 | – |  | 
| 564 | – | while (*s) | 
| 565 | – | rval += *s++; | 
| 566 | – |  | 
| 567 | – | return(rval % NHASH); | 
| 697 |  | } |