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