1 /* 2 * Copyright (c) 1983 Regents of the University of California. 3 * All rights reserved. The Berkeley software License Agreement 4 * specifies the terms and conditions for redistribution. 5 */ 6 7 #ifndef lint 8 static char sccsid[] = "@(#)symbols.c 5.5 (Berkeley) 05/11/88"; 9 #endif not lint 10 11 static char rcsid[] = "$Header: symbols.c,v 1.4 88/04/02 01:29:03 donn Exp $"; 12 13 /* 14 * Symbol management. 15 */ 16 17 #include "defs.h" 18 #include "symbols.h" 19 #include "languages.h" 20 #include "printsym.h" 21 #include "tree.h" 22 #include "operators.h" 23 #include "eval.h" 24 #include "mappings.h" 25 #include "events.h" 26 #include "process.h" 27 #include "runtime.h" 28 #include "machine.h" 29 #include "names.h" 30 31 #ifndef public 32 typedef struct Symbol *Symbol; 33 34 #include "machine.h" 35 #include "names.h" 36 #include "languages.h" 37 #include "tree.h" 38 39 /* 40 * Symbol classes 41 */ 42 43 typedef enum { 44 BADUSE, CONST, TYPE, VAR, ARRAY, OPENARRAY, DYNARRAY, SUBARRAY, 45 PTRFILE, RECORD, FIELD, 46 PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 47 LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT, 48 FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF 49 } Symclass; 50 51 typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; 52 53 #define INREG 0 54 #define STK 1 55 #define EXT 2 56 57 typedef unsigned integer Storage; 58 59 struct Symbol { 60 Name name; 61 Language language; 62 Symclass class : 8; 63 Storage storage : 2; 64 unsigned int level : 6; /* for variables stored on stack only */ 65 Symbol type; 66 Symbol chain; 67 union { 68 Node constval; /* value of constant symbol */ 69 int offset; /* variable address */ 70 long iconval; /* integer constant value */ 71 double fconval; /* floating constant value */ 72 int ndims; /* no. of dimensions for dynamic/sub-arrays */ 73 struct { /* field offset and size (both in bits) */ 74 int offset; 75 int length; 76 } field; 77 struct { /* common offset and chain; used to relocate */ 78 int offset; /* vars in global BSS */ 79 Symbol chain; 80 } common; 81 struct { /* range bounds */ 82 Rangetype lowertype : 16; 83 Rangetype uppertype : 16; 84 long lower; 85 long upper; 86 } rangev; 87 struct { 88 int offset : 16; /* offset for of function value */ 89 Boolean src : 1; /* true if there is source line info */ 90 Boolean inline : 1; /* true if no separate act. rec. */ 91 Boolean intern : 1; /* internal calling sequence */ 92 int unused : 13; 93 Address beginaddr; /* address of function code */ 94 } funcv; 95 struct { /* variant record info */ 96 int size; 97 Symbol vtorec; 98 Symbol vtag; 99 } varnt; 100 String typeref; /* type defined by "<module>:<type>" */ 101 Symbol extref; /* indirect symbol for external reference */ 102 } symvalue; 103 Symbol block; /* symbol containing this symbol */ 104 Symbol next_sym; /* hash chain */ 105 }; 106 107 /* 108 * Basic types. 109 */ 110 111 Symbol t_boolean; 112 Symbol t_char; 113 Symbol t_int; 114 Symbol t_real; 115 Symbol t_nil; 116 Symbol t_addr; 117 118 Symbol program; 119 Symbol curfunc; 120 121 boolean showaggrs; 122 123 #define symname(s) ident(s->name) 124 #define codeloc(f) ((f)->symvalue.funcv.beginaddr) 125 #define isblock(s) (Boolean) ( \ 126 s->class == FUNC or s->class == PROC or \ 127 s->class == MODULE or s->class == PROG \ 128 ) 129 #define isroutine(s) (Boolean) ( \ 130 s->class == FUNC or s->class == PROC \ 131 ) 132 133 #define nosource(f) (not (f)->symvalue.funcv.src) 134 #define isinline(f) ((f)->symvalue.funcv.inline) 135 136 #define isreg(s) (s->storage == INREG) 137 138 #include "tree.h" 139 140 /* 141 * Some macros to make finding a symbol with certain attributes. 142 */ 143 144 #define find(s, withname) \ 145 { \ 146 s = lookup(withname); \ 147 while (s != nil and not (s->name == (withname) and 148 149 #define where /* qualification */ 150 151 #define endfind(s) )) { \ 152 s = s->next_sym; \ 153 } \ 154 } 155 156 #endif 157 158 /* 159 * Symbol table structure currently does not support deletions. 160 * Hash table size is a power of two to make hashing faster. 161 * Using a non-prime is ok since we aren't doing rehashing. 162 */ 163 164 #define HASHTABLESIZE 8192 165 166 private Symbol hashtab[HASHTABLESIZE]; 167 168 #define hash(name) ((((unsigned) name) >> 2) & (HASHTABLESIZE - 1)) 169 170 /* 171 * Allocate a new symbol. 172 */ 173 174 #define SYMBLOCKSIZE 1000 175 176 typedef struct Sympool { 177 struct Symbol sym[SYMBLOCKSIZE]; 178 struct Sympool *prevpool; 179 } *Sympool; 180 181 private Sympool sympool = nil; 182 private Integer nleft = 0; 183 184 public Symbol symbol_alloc() 185 { 186 register Sympool newpool; 187 188 if (nleft <= 0) { 189 newpool = new(Sympool); 190 bzero(newpool, sizeof(*newpool)); 191 newpool->prevpool = sympool; 192 sympool = newpool; 193 nleft = SYMBLOCKSIZE; 194 } 195 --nleft; 196 return &(sympool->sym[nleft]); 197 } 198 199 public symbol_dump (func) 200 Symbol func; 201 { 202 register Symbol s; 203 register integer i; 204 205 printf(" symbols in %s \n",symname(func)); 206 for (i = 0; i < HASHTABLESIZE; i++) { 207 for (s = hashtab[i]; s != nil; s = s->next_sym) { 208 if (s->block == func) { 209 psym(s); 210 } 211 } 212 } 213 } 214 215 /* 216 * Free all the symbols currently allocated. 217 */ 218 219 public symbol_free() 220 { 221 Sympool s, t; 222 register Integer i; 223 224 s = sympool; 225 while (s != nil) { 226 t = s->prevpool; 227 dispose(s); 228 s = t; 229 } 230 for (i = 0; i < HASHTABLESIZE; i++) { 231 hashtab[i] = nil; 232 } 233 sympool = nil; 234 nleft = 0; 235 } 236 237 /* 238 * Create a new symbol with the given attributes. 239 */ 240 241 public Symbol newSymbol(name, blevel, class, type, chain) 242 Name name; 243 Integer blevel; 244 Symclass class; 245 Symbol type; 246 Symbol chain; 247 { 248 register Symbol s; 249 250 s = symbol_alloc(); 251 s->name = name; 252 s->language = primlang; 253 s->storage = EXT; 254 s->level = blevel; 255 s->class = class; 256 s->type = type; 257 s->chain = chain; 258 return s; 259 } 260 261 /* 262 * Insert a symbol into the hash table. 263 */ 264 265 public Symbol insert(name) 266 Name name; 267 { 268 register Symbol s; 269 register unsigned int h; 270 271 h = hash(name); 272 s = symbol_alloc(); 273 s->name = name; 274 s->next_sym = hashtab[h]; 275 hashtab[h] = s; 276 return s; 277 } 278 279 /* 280 * Symbol lookup. 281 */ 282 283 public Symbol lookup(name) 284 Name name; 285 { 286 register Symbol s; 287 register unsigned int h; 288 289 h = hash(name); 290 s = hashtab[h]; 291 while (s != nil and s->name != name) { 292 s = s->next_sym; 293 } 294 return s; 295 } 296 297 /* 298 * Delete a symbol from the symbol table. 299 */ 300 301 public delete (s) 302 Symbol s; 303 { 304 register Symbol t; 305 register unsigned int h; 306 307 h = hash(s->name); 308 t = hashtab[h]; 309 if (t == nil) { 310 panic("delete of non-symbol '%s'", symname(s)); 311 } else if (t == s) { 312 hashtab[h] = s->next_sym; 313 } else { 314 while (t->next_sym != s) { 315 t = t->next_sym; 316 if (t == nil) { 317 panic("delete of non-symbol '%s'", symname(s)); 318 } 319 } 320 t->next_sym = s->next_sym; 321 } 322 } 323 324 /* 325 * Dump out all the variables associated with the given 326 * procedure, function, or program associated with the given stack frame. 327 * 328 * This is quite inefficient. We traverse the entire symbol table 329 * each time we're called. The assumption is that this routine 330 * won't be called frequently enough to merit improved performance. 331 */ 332 333 public dumpvars(f, frame) 334 Symbol f; 335 Frame frame; 336 { 337 register Integer i; 338 register Symbol s; 339 340 for (i = 0; i < HASHTABLESIZE; i++) { 341 for (s = hashtab[i]; s != nil; s = s->next_sym) { 342 if (container(s) == f) { 343 if (should_print(s)) { 344 printv(s, frame); 345 putchar('\n'); 346 } else if (s->class == MODULE) { 347 dumpvars(s, frame); 348 } 349 } 350 } 351 } 352 } 353 354 /* 355 * Create a builtin type. 356 * Builtin types are circular in that btype->type->type = btype. 357 */ 358 359 private Symbol maketype(name, lower, upper) 360 String name; 361 long lower; 362 long upper; 363 { 364 register Symbol s; 365 Name n; 366 367 if (name == nil) { 368 n = nil; 369 } else { 370 n = identname(name, true); 371 } 372 s = insert(n); 373 s->language = primlang; 374 s->level = 0; 375 s->class = TYPE; 376 s->type = nil; 377 s->chain = nil; 378 s->type = newSymbol(nil, 0, RANGE, s, nil); 379 s->type->symvalue.rangev.lower = lower; 380 s->type->symvalue.rangev.upper = upper; 381 return s; 382 } 383 384 /* 385 * Create the builtin symbols. 386 */ 387 388 public symbols_init () 389 { 390 Symbol s; 391 392 t_boolean = maketype("$boolean", 0L, 1L); 393 t_int = maketype("$integer", 0x80000000L, 0x7fffffffL); 394 t_char = maketype("$char", 0L, 255L); 395 t_real = maketype("$real", 8L, 0L); 396 t_nil = maketype("$nil", 0L, 0L); 397 t_addr = insert(identname("$address", true)); 398 t_addr->language = primlang; 399 t_addr->level = 0; 400 t_addr->class = TYPE; 401 t_addr->type = newSymbol(nil, 1, PTR, t_int, nil); 402 s = insert(identname("true", true)); 403 s->class = CONST; 404 s->type = t_boolean; 405 s->symvalue.constval = build(O_LCON, 1L); 406 s->symvalue.constval->nodetype = t_boolean; 407 s = insert(identname("false", true)); 408 s->class = CONST; 409 s->type = t_boolean; 410 s->symvalue.constval = build(O_LCON, 0L); 411 s->symvalue.constval->nodetype = t_boolean; 412 } 413 414 /* 415 * Reduce type to avoid worrying about type names. 416 */ 417 418 public Symbol rtype(type) 419 Symbol type; 420 { 421 register Symbol t; 422 423 t = type; 424 if (t != nil) { 425 if (t->class == VAR or t->class == CONST or 426 t->class == FIELD or t->class == REF 427 ) { 428 t = t->type; 429 } 430 if (t->class == TYPEREF) { 431 resolveRef(t); 432 } 433 while (t->class == TYPE or t->class == TAG) { 434 t = t->type; 435 if (t->class == TYPEREF) { 436 resolveRef(t); 437 } 438 } 439 } 440 return t; 441 } 442 443 /* 444 * Find the end of a module name. Return nil if there is none 445 * in the given string. 446 */ 447 448 private String findModuleMark (s) 449 String s; 450 { 451 register char *p, *r; 452 register boolean done; 453 454 p = s; 455 done = false; 456 do { 457 if (*p == ':') { 458 done = true; 459 r = p; 460 } else if (*p == '\0') { 461 done = true; 462 r = nil; 463 } else { 464 ++p; 465 } 466 } while (not done); 467 return r; 468 } 469 470 /* 471 * Resolve a type reference by modifying to be the appropriate type. 472 * 473 * If the reference has a name, then it refers to an opaque type and 474 * the actual type is directly accessible. Otherwise, we must use 475 * the type reference string, which is of the form "module:{module:}name". 476 */ 477 478 public resolveRef (t) 479 Symbol t; 480 { 481 register char *p; 482 char *start; 483 Symbol s, m, outer; 484 Name n; 485 486 if (t->name != nil) { 487 s = t; 488 } else { 489 start = t->symvalue.typeref; 490 outer = program; 491 p = findModuleMark(start); 492 while (p != nil) { 493 *p = '\0'; 494 n = identname(start, true); 495 find(m, n) where m->block == outer endfind(m); 496 if (m == nil) { 497 p = nil; 498 outer = nil; 499 s = nil; 500 } else { 501 outer = m; 502 start = p + 1; 503 p = findModuleMark(start); 504 } 505 } 506 if (outer != nil) { 507 n = identname(start, true); 508 find(s, n) where s->block == outer endfind(s); 509 } 510 } 511 if (s != nil and s->type != nil) { 512 t->name = s->type->name; 513 t->class = s->type->class; 514 t->type = s->type->type; 515 t->chain = s->type->chain; 516 t->symvalue = s->type->symvalue; 517 t->block = s->type->block; 518 } 519 } 520 521 public integer regnum (s) 522 Symbol s; 523 { 524 integer r; 525 526 checkref(s); 527 if (s->storage == INREG) { 528 r = s->symvalue.offset; 529 } else { 530 r = -1; 531 } 532 return r; 533 } 534 535 public Symbol container(s) 536 Symbol s; 537 { 538 checkref(s); 539 return s->block; 540 } 541 542 public Node constval(s) 543 Symbol s; 544 { 545 checkref(s); 546 if (s->class != CONST) { 547 error("[internal error: constval(non-CONST)]"); 548 } 549 return s->symvalue.constval; 550 } 551 552 /* 553 * Return the object address of the given symbol. 554 * 555 * There are the following possibilities: 556 * 557 * globals - just take offset 558 * locals - take offset from locals base 559 * arguments - take offset from argument base 560 * register - offset is register number 561 */ 562 563 #define isglobal(s) (s->storage == EXT) 564 #define islocaloff(s) (s->storage == STK and s->symvalue.offset < 0) 565 #define isparamoff(s) (s->storage == STK and s->symvalue.offset >= 0) 566 567 public Address address (s, frame) 568 Symbol s; 569 Frame frame; 570 { 571 register Frame frp; 572 register Address addr; 573 register Symbol cur; 574 575 checkref(s); 576 if (not isactive(s->block)) { 577 error("\"%s\" is not currently defined", symname(s)); 578 } else if (isglobal(s)) { 579 addr = s->symvalue.offset; 580 } else { 581 frp = frame; 582 if (frp == nil) { 583 cur = s->block; 584 while (cur != nil and cur->class == MODULE) { 585 cur = cur->block; 586 } 587 if (cur == nil) { 588 frp = nil; 589 } else { 590 frp = findframe(cur); 591 if (frp == nil) { 592 error("[internal error: unexpected nil frame for \"%s\"]", 593 symname(s) 594 ); 595 } 596 } 597 } 598 if (islocaloff(s)) { 599 addr = locals_base(frp) + s->symvalue.offset; 600 } else if (isparamoff(s)) { 601 addr = args_base(frp) + s->symvalue.offset; 602 } else if (isreg(s)) { 603 addr = savereg(s->symvalue.offset, frp); 604 } else { 605 panic("address: bad symbol \"%s\"", symname(s)); 606 } 607 } 608 return addr; 609 } 610 611 /* 612 * Define a symbol used to access register values. 613 */ 614 615 public defregname (n, r) 616 Name n; 617 integer r; 618 { 619 Symbol s; 620 621 s = insert(n); 622 s->language = t_addr->language; 623 s->class = VAR; 624 s->storage = INREG; 625 s->level = 3; 626 s->type = t_addr; 627 s->symvalue.offset = r; 628 } 629 630 /* 631 * Resolve an "abstract" type reference. 632 * 633 * It is possible in C to define a pointer to a type, but never define 634 * the type in a particular source file. Here we try to resolve 635 * the type definition. This is problematic, it is possible to 636 * have multiple, different definitions for the same name type. 637 */ 638 639 public findtype(s) 640 Symbol s; 641 { 642 register Symbol t, u, prev; 643 644 u = s; 645 prev = nil; 646 while (u != nil and u->class != BADUSE) { 647 if (u->name != nil) { 648 prev = u; 649 } 650 u = u->type; 651 } 652 if (prev == nil) { 653 error("couldn't find link to type reference"); 654 } 655 t = lookup(prev->name); 656 while (t != nil and 657 not ( 658 t != prev and t->name == prev->name and 659 t->block->class == MODULE and t->class == prev->class and 660 t->type != nil and t->type->type != nil and 661 t->type->type->class != BADUSE 662 ) 663 ) { 664 t = t->next_sym; 665 } 666 if (t == nil) { 667 error("couldn't resolve reference"); 668 } else { 669 prev->type = t->type; 670 } 671 } 672 673 /* 674 * Find the size in bytes of the given type. 675 * 676 * This is probably the WRONG thing to do. The size should be kept 677 * as an attribute in the symbol information as is done for structures 678 * and fields. I haven't gotten around to cleaning this up yet. 679 */ 680 681 #define MAXUCHAR 255 682 #define MAXUSHORT 65535L 683 #define MINCHAR -128 684 #define MAXCHAR 127 685 #define MINSHORT -32768 686 #define MAXSHORT 32767 687 688 public findbounds (u, lower, upper) 689 Symbol u; 690 long *lower, *upper; 691 { 692 Rangetype lbt, ubt; 693 long lb, ub; 694 695 if (u->class == RANGE) { 696 lbt = u->symvalue.rangev.lowertype; 697 ubt = u->symvalue.rangev.uppertype; 698 lb = u->symvalue.rangev.lower; 699 ub = u->symvalue.rangev.upper; 700 if (lbt == R_ARG or lbt == R_TEMP) { 701 if (not getbound(u, lb, lbt, lower)) { 702 error("dynamic bounds not currently available"); 703 } 704 } else { 705 *lower = lb; 706 } 707 if (ubt == R_ARG or ubt == R_TEMP) { 708 if (not getbound(u, ub, ubt, upper)) { 709 error("dynamic bounds not currently available"); 710 } 711 } else { 712 *upper = ub; 713 } 714 } else if (u->class == SCAL) { 715 *lower = 0; 716 *upper = u->symvalue.iconval - 1; 717 } else { 718 error("[internal error: unexpected array bound type]"); 719 } 720 } 721 722 public integer size(sym) 723 Symbol sym; 724 { 725 register Symbol s, t, u; 726 register integer nel, elsize; 727 long lower, upper; 728 integer r, off, len; 729 730 t = sym; 731 checkref(t); 732 if (t->class == TYPEREF) { 733 resolveRef(t); 734 } 735 switch (t->class) { 736 case RANGE: 737 lower = t->symvalue.rangev.lower; 738 upper = t->symvalue.rangev.upper; 739 if (upper == 0 and lower > 0) { 740 /* real */ 741 r = lower; 742 } else if (lower > upper) { 743 /* unsigned long */ 744 r = sizeof(long); 745 } else if ( 746 (lower >= MINCHAR and upper <= MAXCHAR) or 747 (lower >= 0 and upper <= MAXUCHAR) 748 ) { 749 r = sizeof(char); 750 } else if ( 751 (lower >= MINSHORT and upper <= MAXSHORT) or 752 (lower >= 0 and upper <= MAXUSHORT) 753 ) { 754 r = sizeof(short); 755 } else { 756 r = sizeof(long); 757 } 758 break; 759 760 case ARRAY: 761 elsize = size(t->type); 762 nel = 1; 763 for (t = t->chain; t != nil; t = t->chain) { 764 u = rtype(t); 765 findbounds(u, &lower, &upper); 766 nel *= (upper-lower+1); 767 } 768 r = nel*elsize; 769 break; 770 771 case OPENARRAY: 772 case DYNARRAY: 773 r = (t->symvalue.ndims + 1) * sizeof(Word); 774 break; 775 776 case SUBARRAY: 777 r = (2 * t->symvalue.ndims + 1) * sizeof(Word); 778 break; 779 780 case REF: 781 case VAR: 782 r = size(t->type); 783 /* 784 * 785 if (r < sizeof(Word) and isparam(t)) { 786 r = sizeof(Word); 787 } 788 */ 789 break; 790 791 case FVAR: 792 case CONST: 793 case TAG: 794 r = size(t->type); 795 break; 796 797 case TYPE: 798 /* 799 * This causes problems on the IRIS because of the compiler bug 800 * with stab offsets for parameters. Not sure it's really 801 * necessary anyway. 802 */ 803 # ifndef IRIS 804 if (t->type->class == PTR and t->type->type->class == BADUSE) { 805 findtype(t); 806 } 807 # endif 808 r = size(t->type); 809 break; 810 811 case FIELD: 812 off = t->symvalue.field.offset; 813 len = t->symvalue.field.length; 814 r = (off + len + 7) div 8 - (off div 8); 815 break; 816 817 case RECORD: 818 case VARNT: 819 r = t->symvalue.offset; 820 if (r == 0 and t->chain != nil) { 821 panic("missing size information for record"); 822 } 823 break; 824 825 case PTR: 826 case TYPEREF: 827 case FILET: 828 r = sizeof(Word); 829 break; 830 831 case SCAL: 832 r = sizeof(Word); 833 /* 834 * 835 if (t->symvalue.iconval > 255) { 836 r = sizeof(short); 837 } else { 838 r = sizeof(char); 839 } 840 * 841 */ 842 break; 843 844 case FPROC: 845 case FFUNC: 846 r = sizeof(Word); 847 break; 848 849 case PROC: 850 case FUNC: 851 case MODULE: 852 case PROG: 853 r = sizeof(Symbol); 854 break; 855 856 case SET: 857 u = rtype(t->type); 858 switch (u->class) { 859 case RANGE: 860 r = u->symvalue.rangev.upper - u->symvalue.rangev.lower + 1; 861 break; 862 863 case SCAL: 864 r = u->symvalue.iconval; 865 break; 866 867 default: 868 error("expected range for set base type"); 869 break; 870 } 871 r = (r + BITSPERBYTE - 1) div BITSPERBYTE; 872 break; 873 874 /* 875 * These can happen in C (unfortunately) for unresolved type references 876 * Assume they are pointers. 877 */ 878 case BADUSE: 879 r = sizeof(Address); 880 break; 881 882 default: 883 if (ord(t->class) > ord(TYPEREF)) { 884 panic("size: bad class (%d)", ord(t->class)); 885 } else { 886 fprintf(stderr, "can't compute size of a %s\n", classname(t)); 887 } 888 r = 0; 889 break; 890 } 891 return r; 892 } 893 894 /* 895 * Return the size associated with a symbol that takes into account 896 * reference parameters. This might be better as the normal size function, but 897 * too many places already depend on it working the way it does. 898 */ 899 900 public integer psize (s) 901 Symbol s; 902 { 903 integer r; 904 Symbol t; 905 906 if (s->class == REF) { 907 t = rtype(s->type); 908 if (t->class == OPENARRAY) { 909 r = (t->symvalue.ndims + 1) * sizeof(Word); 910 } else if (t->class == SUBARRAY) { 911 r = (2 * t->symvalue.ndims + 1) * sizeof(Word); 912 } else { 913 r = sizeof(Word); 914 } 915 } else { 916 r = size(s); 917 } 918 return r; 919 } 920 921 /* 922 * Test if a symbol is a parameter. This is true if there 923 * is a cycle from s->block to s via chain pointers. 924 */ 925 926 public Boolean isparam(s) 927 Symbol s; 928 { 929 register Symbol t; 930 931 t = s->block; 932 while (t != nil and t != s) { 933 t = t->chain; 934 } 935 return (Boolean) (t != nil); 936 } 937 938 /* 939 * Test if a type is an open array parameter type. 940 */ 941 942 public boolean isopenarray (type) 943 Symbol type; 944 { 945 Symbol t; 946 947 t = rtype(type); 948 return (boolean) (t->class == OPENARRAY); 949 } 950 951 /* 952 * Test if a symbol is a var parameter, i.e. has class REF. 953 */ 954 955 public Boolean isvarparam(s) 956 Symbol s; 957 { 958 return (Boolean) (s->class == REF); 959 } 960 961 /* 962 * Test if a symbol is a variable (actually any addressible quantity 963 * with do). 964 */ 965 966 public Boolean isvariable(s) 967 Symbol s; 968 { 969 return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF); 970 } 971 972 /* 973 * Test if a symbol is a constant. 974 */ 975 976 public Boolean isconst(s) 977 Symbol s; 978 { 979 return (Boolean) (s->class == CONST); 980 } 981 982 /* 983 * Test if a symbol is a module. 984 */ 985 986 public Boolean ismodule(s) 987 register Symbol s; 988 { 989 return (Boolean) (s->class == MODULE); 990 } 991 992 /* 993 * Mark a procedure or function as internal, meaning that it is called 994 * with a different calling sequence. 995 */ 996 997 public markInternal (s) 998 Symbol s; 999 { 1000 s->symvalue.funcv.intern = true; 1001 } 1002 1003 public boolean isinternal (s) 1004 Symbol s; 1005 { 1006 return s->symvalue.funcv.intern; 1007 } 1008 1009 /* 1010 * Decide if a field begins or ends on a bit rather than byte boundary. 1011 */ 1012 1013 public Boolean isbitfield(s) 1014 register Symbol s; 1015 { 1016 boolean b; 1017 register integer off, len; 1018 register Symbol t; 1019 1020 off = s->symvalue.field.offset; 1021 len = s->symvalue.field.length; 1022 if ((off mod BITSPERBYTE) != 0 or (len mod BITSPERBYTE) != 0) { 1023 b = true; 1024 } else { 1025 t = rtype(s->type); 1026 b = (Boolean) ( 1027 (t->class == SCAL and len != (sizeof(int)*BITSPERBYTE)) or 1028 len != (size(t)*BITSPERBYTE) 1029 ); 1030 } 1031 return b; 1032 } 1033 1034 private boolean primlang_typematch (t1, t2) 1035 Symbol t1, t2; 1036 { 1037 return (boolean) ( 1038 (t1 == t2) or 1039 ( 1040 t1->class == RANGE and t2->class == RANGE and 1041 t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and 1042 t1->symvalue.rangev.upper == t2->symvalue.rangev.upper 1043 ) or ( 1044 t1->class == PTR and t2->class == RANGE and 1045 t2->symvalue.rangev.upper >= t2->symvalue.rangev.lower 1046 ) or ( 1047 t2->class == PTR and t1->class == RANGE and 1048 t1->symvalue.rangev.upper >= t1->symvalue.rangev.lower 1049 ) 1050 ); 1051 } 1052 1053 /* 1054 * Test if two types match. 1055 * Equivalent names implies a match in any language. 1056 * 1057 * Special symbols must be handled with care. 1058 */ 1059 1060 public Boolean compatible(t1, t2) 1061 register Symbol t1, t2; 1062 { 1063 Boolean b; 1064 Symbol rt1, rt2; 1065 1066 if (t1 == t2) { 1067 b = true; 1068 } else if (t1 == nil or t2 == nil) { 1069 b = false; 1070 } else if (t1 == procsym) { 1071 b = isblock(t2); 1072 } else if (t2 == procsym) { 1073 b = isblock(t1); 1074 } else if (t1->language == nil) { 1075 if (t2->language == nil) { 1076 b = false; 1077 } else if (t2->language == primlang) { 1078 b = (boolean) primlang_typematch(rtype(t1), rtype(t2)); 1079 } else { 1080 b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); 1081 } 1082 } else if (t1->language == primlang) { 1083 if (t2->language == primlang or t2->language == nil) { 1084 b = primlang_typematch(rtype(t1), rtype(t2)); 1085 } else { 1086 b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); 1087 } 1088 } else { 1089 b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); 1090 } 1091 return b; 1092 } 1093 1094 /* 1095 * Check for a type of the given name. 1096 */ 1097 1098 public Boolean istypename(type, name) 1099 Symbol type; 1100 String name; 1101 { 1102 register Symbol t; 1103 Boolean b; 1104 1105 t = type; 1106 if (t == nil) { 1107 b = false; 1108 } else { 1109 b = (Boolean) ( 1110 t->class == TYPE and streq(ident(t->name), name) 1111 ); 1112 } 1113 return b; 1114 } 1115 1116 /* 1117 * Determine if a (value) parameter should actually be passed by address. 1118 */ 1119 1120 public boolean passaddr (p, exprtype) 1121 Symbol p, exprtype; 1122 { 1123 boolean b; 1124 Language def; 1125 1126 if (p == nil) { 1127 def = findlanguage(".c"); 1128 b = (boolean) (*language_op(def, L_PASSADDR))(p, exprtype); 1129 } else if (p->language == nil or p->language == primlang) { 1130 b = false; 1131 } else if (isopenarray(p->type)) { 1132 b = true; 1133 } else { 1134 b = (boolean) (*language_op(p->language, L_PASSADDR))(p, exprtype); 1135 } 1136 return b; 1137 } 1138 1139 /* 1140 * Test if the name of a symbol is uniquely defined or not. 1141 */ 1142 1143 public Boolean isambiguous(s) 1144 register Symbol s; 1145 { 1146 register Symbol t; 1147 1148 find(t, s->name) where t != s endfind(t); 1149 return (Boolean) (t != nil); 1150 } 1151 1152 typedef char *Arglist; 1153 1154 #define nextarg(type) ((type *) (ap += sizeof(type)))[-1] 1155 1156 private Symbol mkstring(); 1157 1158 /* 1159 * Determine the type of a parse tree. 1160 * 1161 * Also make some symbol-dependent changes to the tree such as 1162 * removing indirection for constant or register symbols. 1163 */ 1164 1165 public assigntypes (p) 1166 register Node p; 1167 { 1168 register Node p1; 1169 register Symbol s; 1170 1171 switch (p->op) { 1172 case O_SYM: 1173 p->nodetype = p->value.sym; 1174 break; 1175 1176 case O_LCON: 1177 p->nodetype = t_int; 1178 break; 1179 1180 case O_CCON: 1181 p->nodetype = t_char; 1182 break; 1183 1184 case O_FCON: 1185 p->nodetype = t_real; 1186 break; 1187 1188 case O_SCON: 1189 p->nodetype = mkstring(p->value.scon); 1190 break; 1191 1192 case O_INDIR: 1193 p1 = p->value.arg[0]; 1194 s = rtype(p1->nodetype); 1195 if (s->class != PTR) { 1196 beginerrmsg(); 1197 fprintf(stderr, "\""); 1198 prtree(stderr, p1); 1199 fprintf(stderr, "\" is not a pointer"); 1200 enderrmsg(); 1201 } 1202 p->nodetype = rtype(p1->nodetype)->type; 1203 break; 1204 1205 case O_DOT: 1206 p->nodetype = p->value.arg[1]->value.sym; 1207 break; 1208 1209 case O_RVAL: 1210 p1 = p->value.arg[0]; 1211 p->nodetype = p1->nodetype; 1212 if (p1->op == O_SYM) { 1213 if (p1->nodetype->class == PROC or p->nodetype->class == FUNC) { 1214 p->op = p1->op; 1215 p->value.sym = p1->value.sym; 1216 p->nodetype = p1->nodetype; 1217 dispose(p1); 1218 } else if (p1->value.sym->class == CONST) { 1219 p->op = p1->op; 1220 p->value = p1->value; 1221 p->nodetype = p1->nodetype; 1222 dispose(p1); 1223 } else if (isreg(p1->value.sym)) { 1224 p->op = O_SYM; 1225 p->value.sym = p1->value.sym; 1226 dispose(p1); 1227 } 1228 } else if (p1->op == O_INDIR and p1->value.arg[0]->op == O_SYM) { 1229 s = p1->value.arg[0]->value.sym; 1230 if (isreg(s)) { 1231 p1->op = O_SYM; 1232 dispose(p1->value.arg[0]); 1233 p1->value.sym = s; 1234 p1->nodetype = s; 1235 } 1236 } 1237 break; 1238 1239 case O_COMMA: 1240 p->nodetype = p->value.arg[0]->nodetype; 1241 break; 1242 1243 case O_CALLPROC: 1244 case O_CALL: 1245 p1 = p->value.arg[0]; 1246 p->nodetype = rtype(p1->nodetype)->type; 1247 break; 1248 1249 case O_TYPERENAME: 1250 p->nodetype = p->value.arg[1]->nodetype; 1251 break; 1252 1253 case O_ITOF: 1254 p->nodetype = t_real; 1255 break; 1256 1257 case O_NEG: 1258 s = p->value.arg[0]->nodetype; 1259 if (not compatible(s, t_int)) { 1260 if (not compatible(s, t_real)) { 1261 beginerrmsg(); 1262 fprintf(stderr, "\""); 1263 prtree(stderr, p->value.arg[0]); 1264 fprintf(stderr, "\" is improper type"); 1265 enderrmsg(); 1266 } else { 1267 p->op = O_NEGF; 1268 } 1269 } 1270 p->nodetype = s; 1271 break; 1272 1273 case O_ADD: 1274 case O_SUB: 1275 case O_MUL: 1276 binaryop(p, nil); 1277 break; 1278 1279 case O_LT: 1280 case O_LE: 1281 case O_GT: 1282 case O_GE: 1283 case O_EQ: 1284 case O_NE: 1285 binaryop(p, t_boolean); 1286 break; 1287 1288 case O_DIVF: 1289 convert(&(p->value.arg[0]), t_real, O_ITOF); 1290 convert(&(p->value.arg[1]), t_real, O_ITOF); 1291 p->nodetype = t_real; 1292 break; 1293 1294 case O_DIV: 1295 case O_MOD: 1296 convert(&(p->value.arg[0]), t_int, O_NOP); 1297 convert(&(p->value.arg[1]), t_int, O_NOP); 1298 p->nodetype = t_int; 1299 break; 1300 1301 case O_AND: 1302 case O_OR: 1303 chkboolean(p->value.arg[0]); 1304 chkboolean(p->value.arg[1]); 1305 p->nodetype = t_boolean; 1306 break; 1307 1308 case O_QLINE: 1309 p->nodetype = t_int; 1310 break; 1311 1312 default: 1313 p->nodetype = nil; 1314 break; 1315 } 1316 } 1317 1318 /* 1319 * Process a binary arithmetic or relational operator. 1320 * Convert from integer to real if necessary. 1321 */ 1322 1323 private binaryop (p, t) 1324 Node p; 1325 Symbol t; 1326 { 1327 Node p1, p2; 1328 Boolean t1real, t2real; 1329 Symbol t1, t2; 1330 1331 p1 = p->value.arg[0]; 1332 p2 = p->value.arg[1]; 1333 t1 = rtype(p1->nodetype); 1334 t2 = rtype(p2->nodetype); 1335 t1real = compatible(t1, t_real); 1336 t2real = compatible(t2, t_real); 1337 if (t1real or t2real) { 1338 p->op = (Operator) (ord(p->op) + 1); 1339 if (not t1real) { 1340 p->value.arg[0] = build(O_ITOF, p1); 1341 } else if (not t2real) { 1342 p->value.arg[1] = build(O_ITOF, p2); 1343 } 1344 p->nodetype = t_real; 1345 } else { 1346 if (size(p1->nodetype) > sizeof(integer)) { 1347 beginerrmsg(); 1348 fprintf(stderr, "operation not defined on \""); 1349 prtree(stderr, p1); 1350 fprintf(stderr, "\""); 1351 enderrmsg(); 1352 } else if (size(p2->nodetype) > sizeof(integer)) { 1353 beginerrmsg(); 1354 fprintf(stderr, "operation not defined on \""); 1355 prtree(stderr, p2); 1356 fprintf(stderr, "\""); 1357 enderrmsg(); 1358 } 1359 p->nodetype = t_int; 1360 } 1361 if (t != nil) { 1362 p->nodetype = t; 1363 } 1364 } 1365 1366 /* 1367 * Convert a tree to a type via a conversion operator; 1368 * if this isn't possible generate an error. 1369 */ 1370 1371 private convert(tp, typeto, op) 1372 Node *tp; 1373 Symbol typeto; 1374 Operator op; 1375 { 1376 Node tree; 1377 Symbol s, t; 1378 1379 tree = *tp; 1380 s = rtype(tree->nodetype); 1381 t = rtype(typeto); 1382 if (compatible(t, t_real) and compatible(s, t_int)) { 1383 /* we can convert int => floating but not the reverse */ 1384 tree = build(op, tree); 1385 } else if (not compatible(s, t)) { 1386 beginerrmsg(); 1387 prtree(stderr, tree); 1388 fprintf(stderr, ": illegal type in operation"); 1389 enderrmsg(); 1390 } 1391 *tp = tree; 1392 } 1393 1394 /* 1395 * Construct a node for the dot operator. 1396 * 1397 * If the left operand is not a record, but rather a procedure 1398 * or function, then we interpret the "." as referencing an 1399 * "invisible" variable; i.e. a variable within a dynamically 1400 * active block but not within the static scope of the current procedure. 1401 */ 1402 1403 public Node dot(record, fieldname) 1404 Node record; 1405 Name fieldname; 1406 { 1407 register Node rec, p; 1408 register Symbol s, t; 1409 1410 rec = record; 1411 if (isblock(rec->nodetype)) { 1412 find(s, fieldname) where 1413 s->block == rec->nodetype and 1414 s->class != FIELD 1415 endfind(s); 1416 if (s == nil) { 1417 beginerrmsg(); 1418 fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname)); 1419 printname(stderr, rec->nodetype); 1420 enderrmsg(); 1421 } 1422 p = new(Node); 1423 p->op = O_SYM; 1424 p->value.sym = s; 1425 p->nodetype = s; 1426 } else { 1427 p = rec; 1428 t = rtype(p->nodetype); 1429 if (t->class == PTR) { 1430 s = findfield(fieldname, t->type); 1431 } else { 1432 s = findfield(fieldname, t); 1433 } 1434 if (s == nil) { 1435 beginerrmsg(); 1436 fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname)); 1437 prtree(stderr, rec); 1438 enderrmsg(); 1439 } 1440 if (t->class != PTR or isreg(rec->nodetype)) { 1441 p = unrval(p); 1442 } 1443 p->nodetype = t_addr; 1444 p = build(O_DOT, p, build(O_SYM, s)); 1445 } 1446 return build(O_RVAL, p); 1447 } 1448 1449 /* 1450 * Return a tree corresponding to an array reference and do the 1451 * error checking. 1452 */ 1453 1454 public Node subscript(a, slist) 1455 Node a, slist; 1456 { 1457 Symbol t; 1458 Node p; 1459 1460 t = rtype(a->nodetype); 1461 if (t->language == nil or t->language == primlang) { 1462 p = (Node) (*language_op(findlanguage(".s"), L_BUILDAREF))(a, slist); 1463 } else { 1464 p = (Node) (*language_op(t->language, L_BUILDAREF))(a, slist); 1465 } 1466 return build(O_RVAL, p); 1467 } 1468 1469 /* 1470 * Evaluate a subscript index. 1471 */ 1472 1473 public int evalindex(s, base, i) 1474 Symbol s; 1475 Address base; 1476 long i; 1477 { 1478 Symbol t; 1479 int r; 1480 1481 t = rtype(s); 1482 if (t->language == nil or t->language == primlang) { 1483 r = ((*language_op(findlanguage(".s"), L_EVALAREF)) (s, base, i)); 1484 } else { 1485 r = ((*language_op(t->language, L_EVALAREF)) (s, base, i)); 1486 } 1487 return r; 1488 } 1489 1490 /* 1491 * Check to see if a tree is boolean-valued, if not it's an error. 1492 */ 1493 1494 public chkboolean(p) 1495 register Node p; 1496 { 1497 if (p->nodetype != t_boolean) { 1498 beginerrmsg(); 1499 fprintf(stderr, "found "); 1500 prtree(stderr, p); 1501 fprintf(stderr, ", expected boolean expression"); 1502 enderrmsg(); 1503 } 1504 } 1505 1506 /* 1507 * Construct a node for the type of a string. 1508 */ 1509 1510 private Symbol mkstring(str) 1511 String str; 1512 { 1513 register Symbol s; 1514 1515 s = newSymbol(nil, 0, ARRAY, t_char, nil); 1516 s->chain = newSymbol(nil, 0, RANGE, t_int, nil); 1517 s->chain->language = s->language; 1518 s->chain->symvalue.rangev.lower = 1; 1519 s->chain->symvalue.rangev.upper = strlen(str) + 1; 1520 return s; 1521 } 1522 1523 /* 1524 * Free up the space allocated for a string type. 1525 */ 1526 1527 public unmkstring(s) 1528 Symbol s; 1529 { 1530 dispose(s->chain); 1531 } 1532 1533 /* 1534 * Figure out the "current" variable or function being referred to 1535 * by the name n. 1536 */ 1537 1538 private boolean stwhich(), dynwhich(); 1539 1540 public Symbol which (n) 1541 Name n; 1542 { 1543 Symbol s; 1544 1545 s = lookup(n); 1546 if (s == nil) { 1547 error("\"%s\" is not defined", ident(n)); 1548 } else if (not stwhich(&s) and isambiguous(s) and not dynwhich(&s)) { 1549 printf("[using "); 1550 printname(stdout, s); 1551 printf("]\n"); 1552 } 1553 return s; 1554 } 1555 1556 /* 1557 * Static search. 1558 */ 1559 1560 private boolean stwhich (var_s) 1561 Symbol *var_s; 1562 { 1563 Name n; /* name of desired symbol */ 1564 Symbol s; /* iteration variable for symbols with name n */ 1565 Symbol f; /* iteration variable for blocks containing s */ 1566 integer count; /* number of levels from s->block to curfunc */ 1567 Symbol t; /* current best answer for stwhich(n) */ 1568 integer mincount; /* relative level for current best answer (t) */ 1569 boolean b; /* return value, true if symbol found */ 1570 1571 s = *var_s; 1572 n = s->name; 1573 t = s; 1574 mincount = 10000; /* force first match to set mincount */ 1575 do { 1576 if (s->name == n and s->class != FIELD and s->class != TAG) { 1577 f = curfunc; 1578 count = 0; 1579 while (f != nil and f != s->block) { 1580 ++count; 1581 f = f->block; 1582 } 1583 if (f != nil and count < mincount) { 1584 t = s; 1585 mincount = count; 1586 b = true; 1587 } 1588 } 1589 s = s->next_sym; 1590 } while (s != nil); 1591 if (mincount != 10000) { 1592 *var_s = t; 1593 b = true; 1594 } else { 1595 b = false; 1596 } 1597 return b; 1598 } 1599 1600 /* 1601 * Dynamic search. 1602 */ 1603 1604 private boolean dynwhich (var_s) 1605 Symbol *var_s; 1606 { 1607 Name n; /* name of desired symbol */ 1608 Symbol s; /* iteration variable for possible symbols */ 1609 Symbol f; /* iteration variable for active functions */ 1610 Frame frp; /* frame associated with stack walk */ 1611 boolean b; /* return value */ 1612 1613 f = curfunc; 1614 frp = curfuncframe(); 1615 n = (*var_s)->name; 1616 b = false; 1617 if (frp != nil) { 1618 frp = nextfunc(frp, &f); 1619 while (frp != nil) { 1620 s = *var_s; 1621 while (s != nil and 1622 ( 1623 s->name != n or s->block != f or 1624 s->class == FIELD or s->class == TAG 1625 ) 1626 ) { 1627 s = s->next_sym; 1628 } 1629 if (s != nil) { 1630 *var_s = s; 1631 b = true; 1632 break; 1633 } 1634 if (f == program) { 1635 break; 1636 } 1637 frp = nextfunc(frp, &f); 1638 } 1639 } 1640 return b; 1641 } 1642 1643 /* 1644 * Find the symbol that has the same name and scope as the 1645 * given symbol but is of the given field. Return nil if there is none. 1646 */ 1647 1648 public Symbol findfield (fieldname, record) 1649 Name fieldname; 1650 Symbol record; 1651 { 1652 register Symbol t; 1653 1654 t = rtype(record)->chain; 1655 while (t != nil and t->name != fieldname) { 1656 t = t->chain; 1657 } 1658 return t; 1659 } 1660 1661 public Boolean getbound(s,off,type,valp) 1662 Symbol s; 1663 int off; 1664 Rangetype type; 1665 int *valp; 1666 { 1667 Frame frp; 1668 Address addr; 1669 Symbol cur; 1670 1671 if (not isactive(s->block)) { 1672 return(false); 1673 } 1674 cur = s->block; 1675 while (cur != nil and cur->class == MODULE) { /* WHY*/ 1676 cur = cur->block; 1677 } 1678 if(cur == nil) { 1679 cur = whatblock(pc); 1680 } 1681 frp = findframe(cur); 1682 if (frp == nil) { 1683 return(false); 1684 } 1685 if(type == R_TEMP) addr = locals_base(frp) + off; 1686 else if (type == R_ARG) addr = args_base(frp) + off; 1687 else return(false); 1688 dread(valp,addr,sizeof(long)); 1689 return(true); 1690 } 1691