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