1 /* Copyright (c) 1982 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)symbols.c 1.7 04/29/83"; 4 5 /* 6 * Symbol management. 7 */ 8 9 #include "defs.h" 10 #include "symbols.h" 11 #include "languages.h" 12 #include "printsym.h" 13 #include "tree.h" 14 #include "operators.h" 15 #include "eval.h" 16 #include "mappings.h" 17 #include "events.h" 18 #include "process.h" 19 #include "runtime.h" 20 #include "machine.h" 21 #include "names.h" 22 23 #ifndef public 24 typedef struct Symbol *Symbol; 25 26 #include "machine.h" 27 #include "names.h" 28 #include "languages.h" 29 30 /* 31 * Symbol classes 32 */ 33 34 typedef enum { 35 BADUSE, CONST, TYPE, VAR, ARRAY, PTRFILE, RECORD, FIELD, 36 PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 37 LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT, 38 FPROC, FFUNC, MODULE, TYPEREF, TAG 39 } Symclass; 40 41 struct Symbol { 42 Name name; 43 Language language; 44 Symclass class : 8; 45 Integer level : 8; 46 Symbol type; 47 Symbol chain; 48 union { 49 int offset; /* variable address */ 50 long iconval; /* integer constant value */ 51 double fconval; /* floating constant value */ 52 struct { /* field offset and size (both in bits) */ 53 int offset; 54 int length; 55 } field; 56 struct { /* range bounds */ 57 long lower; 58 long upper; 59 } rangev; 60 struct { 61 int offset : 16; /* offset for of function value */ 62 Boolean src : 16; /* true if there is source line info */ 63 Address beginaddr; /* address of function code */ 64 } funcv; 65 struct { /* variant record info */ 66 int size; 67 Symbol vtorec; 68 Symbol vtag; 69 } varnt; 70 } symvalue; 71 Symbol block; /* symbol containing this symbol */ 72 Symbol next_sym; /* hash chain */ 73 }; 74 75 /* 76 * Basic types. 77 */ 78 79 Symbol t_boolean; 80 Symbol t_char; 81 Symbol t_int; 82 Symbol t_real; 83 Symbol t_nil; 84 85 Symbol program; 86 Symbol curfunc; 87 88 #define symname(s) ident(s->name) 89 #define codeloc(f) ((f)->symvalue.funcv.beginaddr) 90 #define isblock(s) (Boolean) ( \ 91 s->class == FUNC or s->class == PROC or \ 92 s->class == MODULE or s->class == PROG \ 93 ) 94 95 #define nosource(f) (not (f)->symvalue.funcv.src) 96 97 #include "tree.h" 98 99 /* 100 * Some macros to make finding a symbol with certain attributes. 101 */ 102 103 #define find(s, withname) \ 104 { \ 105 s = lookup(withname); \ 106 while (s != nil and not (s->name == (withname) and 107 108 #define where /* qualification */ 109 110 #define endfind(s) )) { \ 111 s = s->next_sym; \ 112 } \ 113 } 114 115 #endif 116 117 /* 118 * Symbol table structure currently does not support deletions. 119 */ 120 121 #define HASHTABLESIZE 2003 122 123 private Symbol hashtab[HASHTABLESIZE]; 124 125 #define hash(name) ((((unsigned) name) >> 2) mod HASHTABLESIZE) 126 127 /* 128 * Allocate a new symbol. 129 */ 130 131 #define SYMBLOCKSIZE 100 132 133 typedef struct Sympool { 134 struct Symbol sym[SYMBLOCKSIZE]; 135 struct Sympool *prevpool; 136 } *Sympool; 137 138 private Sympool sympool = nil; 139 private Integer nleft = 0; 140 141 public Symbol symbol_alloc() 142 { 143 register Sympool newpool; 144 145 if (nleft <= 0) { 146 newpool = new(Sympool); 147 bzero(newpool, sizeof(newpool)); 148 newpool->prevpool = sympool; 149 sympool = newpool; 150 nleft = SYMBLOCKSIZE; 151 } 152 --nleft; 153 return &(sympool->sym[nleft]); 154 } 155 156 /* 157 * Free all the symbols currently allocated. 158 */ 159 160 public symbol_free() 161 { 162 Sympool s, t; 163 register Integer i; 164 165 s = sympool; 166 while (s != nil) { 167 t = s->prevpool; 168 dispose(s); 169 s = t; 170 } 171 for (i = 0; i < HASHTABLESIZE; i++) { 172 hashtab[i] = nil; 173 } 174 sympool = nil; 175 nleft = 0; 176 } 177 178 /* 179 * Create a new symbol with the given attributes. 180 */ 181 182 public Symbol newSymbol(name, blevel, class, type, chain) 183 Name name; 184 Integer blevel; 185 Symclass class; 186 Symbol type; 187 Symbol chain; 188 { 189 register Symbol s; 190 191 s = symbol_alloc(); 192 s->name = name; 193 s->level = blevel; 194 s->class = class; 195 s->type = type; 196 s->chain = chain; 197 return s; 198 } 199 200 /* 201 * Insert a symbol into the hash table. 202 */ 203 204 public Symbol insert(name) 205 Name name; 206 { 207 register Symbol s; 208 register unsigned int h; 209 210 h = hash(name); 211 s = symbol_alloc(); 212 s->name = name; 213 s->next_sym = hashtab[h]; 214 hashtab[h] = s; 215 return s; 216 } 217 218 /* 219 * Symbol lookup. 220 */ 221 222 public Symbol lookup(name) 223 Name name; 224 { 225 register Symbol s; 226 register unsigned int h; 227 228 h = hash(name); 229 s = hashtab[h]; 230 while (s != nil and s->name != name) { 231 s = s->next_sym; 232 } 233 return s; 234 } 235 236 /* 237 * Dump out all the variables associated with the given 238 * procedure, function, or program at the given recursive level. 239 * 240 * This is quite inefficient. We traverse the entire symbol table 241 * each time we're called. The assumption is that this routine 242 * won't be called frequently enough to merit improved performance. 243 */ 244 245 public dumpvars(f, frame) 246 Symbol f; 247 Frame frame; 248 { 249 register Integer i; 250 register Symbol s; 251 252 for (i = 0; i < HASHTABLESIZE; i++) { 253 for (s = hashtab[i]; s != nil; s = s->next_sym) { 254 if (container(s) == f) { 255 if (should_print(s)) { 256 printv(s, frame); 257 putchar('\n'); 258 } else if (s->class == MODULE) { 259 dumpvars(s, frame); 260 } 261 } 262 } 263 } 264 } 265 266 /* 267 * Create a builtin type. 268 * Builtin types are circular in that btype->type->type = btype. 269 */ 270 271 public Symbol maketype(name, lower, upper) 272 String name; 273 long lower; 274 long upper; 275 { 276 register Symbol s; 277 278 s = newSymbol(identname(name, true), 0, TYPE, nil, nil); 279 s->language = findlanguage(".c"); 280 s->type = newSymbol(nil, 0, RANGE, s, nil); 281 s->type->symvalue.rangev.lower = lower; 282 s->type->symvalue.rangev.upper = upper; 283 return s; 284 } 285 286 /* 287 * These functions are now compiled inline. 288 * 289 * public String symname(s) 290 Symbol s; 291 { 292 checkref(s); 293 return ident(s->name); 294 } 295 296 * 297 * public Address codeloc(f) 298 Symbol f; 299 { 300 checkref(f); 301 if (not isblock(f)) { 302 panic("codeloc: \"%s\" is not a block", ident(f->name)); 303 } 304 return f->symvalue.funcv.beginaddr; 305 } 306 * 307 */ 308 309 /* 310 * Reduce type to avoid worrying about type names. 311 */ 312 313 public Symbol rtype(type) 314 Symbol type; 315 { 316 register Symbol t; 317 318 t = type; 319 if (t != nil) { 320 if (t->class == VAR or t->class == FIELD) { 321 t = t->type; 322 } 323 while (t->class == TYPE or t->class == TAG) { 324 t = t->type; 325 } 326 } 327 return t; 328 } 329 330 public Integer level(s) 331 Symbol s; 332 { 333 checkref(s); 334 return s->level; 335 } 336 337 public Symbol container(s) 338 Symbol s; 339 { 340 checkref(s); 341 return s->block; 342 } 343 344 /* 345 * Return the object address of the given symbol. 346 * 347 * There are the following possibilities: 348 * 349 * globals - just take offset 350 * locals - take offset from locals base 351 * arguments - take offset from argument base 352 * register - offset is register number 353 */ 354 355 #define isglobal(s) (s->level == 1 or s->level == 2) 356 #define islocaloff(s) (s->level >= 3 and s->symvalue.offset < 0) 357 #define isparamoff(s) (s->level >= 3 and s->symvalue.offset >= 0) 358 #define isreg(s) (s->level < 0) 359 360 public Address address(s, frame) 361 Symbol s; 362 Frame frame; 363 { 364 register Frame frp; 365 register Address addr; 366 register Symbol cur; 367 368 checkref(s); 369 if (not isactive(s->block)) { 370 error("\"%s\" is not currently defined", symname(s)); 371 } else if (isglobal(s)) { 372 addr = s->symvalue.offset; 373 } else { 374 frp = frame; 375 if (frp == nil) { 376 cur = s->block; 377 while (cur != nil and cur->class == MODULE) { 378 cur = cur->block; 379 } 380 if (cur == nil) { 381 cur = whatblock(pc); 382 } 383 frp = findframe(cur); 384 if (frp == nil) { 385 panic("unexpected nil frame for \"%s\"", symname(s)); 386 } 387 } 388 if (islocaloff(s)) { 389 addr = locals_base(frp) + s->symvalue.offset; 390 } else if (isparamoff(s)) { 391 addr = args_base(frp) + s->symvalue.offset; 392 } else if (isreg(s)) { 393 addr = savereg(s->symvalue.offset, frp); 394 } else { 395 panic("address: bad symbol \"%s\"", symname(s)); 396 } 397 } 398 return addr; 399 } 400 401 /* 402 * Define a symbol used to access register values. 403 */ 404 405 public defregname(n, r) 406 Name n; 407 Integer r; 408 { 409 register Symbol s, t; 410 411 s = insert(n); 412 t = newSymbol(nil, 0, PTR, t_int, nil); 413 t->language = findlanguage(".s"); 414 s->language = t->language; 415 s->class = VAR; 416 s->level = -3; 417 s->type = t; 418 s->block = program; 419 s->symvalue.offset = r; 420 } 421 422 /* 423 * Resolve an "abstract" type reference. 424 * 425 * It is possible in C to define a pointer to a type, but never define 426 * the type in a particular source file. Here we try to resolve 427 * the type definition. This is problematic, it is possible to 428 * have multiple, different definitions for the same name type. 429 */ 430 431 public findtype(s) 432 Symbol s; 433 { 434 register Symbol t, u, prev; 435 436 u = s; 437 prev = nil; 438 while (u != nil and u->class != BADUSE) { 439 if (u->name != nil) { 440 prev = u; 441 } 442 u = u->type; 443 } 444 if (prev == nil) { 445 error("couldn't find link to type reference"); 446 } 447 find(t, prev->name) where 448 t->type != nil and t->class == prev->class and 449 t->type->class != BADUSE and t->block->class == MODULE 450 endfind(t); 451 if (t == nil) { 452 error("couldn't resolve reference"); 453 } else { 454 prev->type = t->type; 455 } 456 } 457 458 /* 459 * Find the size in bytes of the given type. 460 * 461 * This is probably the WRONG thing to do. The size should be kept 462 * as an attribute in the symbol information as is done for structures 463 * and fields. I haven't gotten around to cleaning this up yet. 464 */ 465 466 #define MINCHAR -128 467 #define MAXCHAR 127 468 #define MAXUCHAR 255 469 #define MINSHORT -32768 470 #define MAXSHORT 32767 471 #define MAXUSHORT 65535L 472 473 public Integer size(sym) 474 Symbol sym; 475 { 476 register Symbol s, t; 477 register int nel, elsize; 478 long lower, upper; 479 int r; 480 481 t = sym; 482 checkref(t); 483 switch (t->class) { 484 case RANGE: 485 lower = t->symvalue.rangev.lower; 486 upper = t->symvalue.rangev.upper; 487 if (upper == 0 and lower > 0) { /* real */ 488 r = lower; 489 } else if ( 490 (lower >= MINCHAR and upper <= MAXCHAR) or 491 (lower >= 0 and upper <= MAXUCHAR) 492 ) { 493 r = sizeof(char); 494 } else if ( 495 (lower >= MINSHORT and upper <= MAXSHORT) or 496 (lower >= 0 and upper <= MAXUSHORT) 497 ) { 498 r = sizeof(short); 499 } else { 500 r = sizeof(long); 501 } 502 break; 503 504 case ARRAY: 505 elsize = size(t->type); 506 nel = 1; 507 for (t = t->chain; t != nil; t = t->chain) { 508 s = rtype(t); 509 lower = s->symvalue.rangev.lower; 510 upper = s->symvalue.rangev.upper; 511 nel *= (upper-lower+1); 512 } 513 r = nel*elsize; 514 break; 515 516 case VAR: 517 case FVAR: 518 r = size(t->type); 519 /* 520 * 521 if (r < sizeof(Word) and isparam(t)) { 522 r = sizeof(Word); 523 } 524 */ 525 break; 526 527 case CONST: 528 r = size(t->type); 529 break; 530 531 case TYPE: 532 if (t->type->class == PTR and t->type->type->class == BADUSE) { 533 findtype(t); 534 } 535 r = size(t->type); 536 break; 537 538 case TAG: 539 r = size(t->type); 540 break; 541 542 case FIELD: 543 r = (t->symvalue.field.length + 7) div 8; 544 break; 545 546 case RECORD: 547 case VARNT: 548 r = t->symvalue.offset; 549 if (r == 0 and t->chain != nil) { 550 panic("missing size information for record"); 551 } 552 break; 553 554 case PTR: 555 case REF: 556 case FILET: 557 r = sizeof(Word); 558 break; 559 560 case SCAL: 561 if (t->symvalue.iconval > 255) { 562 r = sizeof(short); 563 } else { 564 r = sizeof(char); 565 } 566 break; 567 568 case FPROC: 569 case FFUNC: 570 r = sizeof(Word); 571 break; 572 573 case PROC: 574 case FUNC: 575 case MODULE: 576 case PROG: 577 r = sizeof(Symbol); 578 break; 579 580 default: 581 if (ord(t->class) > ord(TYPEREF)) { 582 panic("size: bad class (%d)", ord(t->class)); 583 } else { 584 error("improper operation on a %s", classname(t)); 585 } 586 /* NOTREACHED */ 587 } 588 return r; 589 } 590 591 /* 592 * Test if a symbol is a parameter. This is true if there 593 * is a cycle from s->block to s via chain pointers. 594 */ 595 596 public Boolean isparam(s) 597 Symbol s; 598 { 599 register Symbol t; 600 601 t = s->block; 602 while (t != nil and t != s) { 603 t = t->chain; 604 } 605 return (Boolean) (t != nil); 606 } 607 608 /* 609 * Test if a symbol is a var parameter, i.e. has class REF. 610 */ 611 612 public Boolean isvarparam(s) 613 Symbol s; 614 { 615 return (Boolean) (s->class == REF); 616 } 617 618 /* 619 * Test if a symbol is a variable (actually any addressible quantity 620 * with do). 621 */ 622 623 public Boolean isvariable(s) 624 register Symbol s; 625 { 626 return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF); 627 } 628 629 /* 630 * Test if a symbol is a block, e.g. function, procedure, or the 631 * main program. 632 * 633 * This function is now expanded inline for efficiency. 634 * 635 * public Boolean isblock(s) 636 register Symbol s; 637 { 638 return (Boolean) ( 639 s->class == FUNC or s->class == PROC or 640 s->class == MODULE or s->class == PROG 641 ); 642 } 643 * 644 */ 645 646 /* 647 * Test if a symbol is a module. 648 */ 649 650 public Boolean ismodule(s) 651 register Symbol s; 652 { 653 return (Boolean) (s->class == MODULE); 654 } 655 656 /* 657 * Test if a symbol is builtin, that is, a predefined type or 658 * reserved word. 659 */ 660 661 public Boolean isbuiltin(s) 662 register Symbol s; 663 { 664 return (Boolean) (s->level == 0 and s->class != PROG and s->class != VAR); 665 } 666 667 /* 668 * Test if two types match. 669 * Equivalent names implies a match in any language. 670 * 671 * Special symbols must be handled with care. 672 */ 673 674 public Boolean compatible(t1, t2) 675 register Symbol t1, t2; 676 { 677 Boolean b; 678 679 if (t1 == t2) { 680 b = true; 681 } else if (t1 == nil or t2 == nil) { 682 b = false; 683 } else if (t1 == procsym) { 684 b = isblock(t2); 685 } else if (t2 == procsym) { 686 b = isblock(t1); 687 } else if (t1->language == nil) { 688 b = (Boolean) (t2->language == nil or 689 (*language_op(t2->language, L_TYPEMATCH))(t1, t2)); 690 } else { 691 b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); 692 } 693 return b; 694 } 695 696 /* 697 * Check for a type of the given name. 698 */ 699 700 public Boolean istypename(type, name) 701 Symbol type; 702 String name; 703 { 704 Symbol t; 705 Boolean b; 706 707 t = type; 708 checkref(t); 709 b = (Boolean) ( 710 t->class == TYPE and t->name == identname(name, true) 711 ); 712 return b; 713 } 714 715 /* 716 * Test if the name of a symbol is uniquely defined or not. 717 */ 718 719 public Boolean isambiguous(s) 720 register Symbol s; 721 { 722 register Symbol t; 723 724 find(t, s->name) where t != s endfind(t); 725 return (Boolean) (t != nil); 726 } 727 728 typedef char *Arglist; 729 730 #define nextarg(type) ((type *) (ap += sizeof(type)))[-1] 731 732 private Symbol mkstring(); 733 private Symbol namenode(); 734 735 /* 736 * Determine the type of a parse tree. 737 * Also make some symbol-dependent changes to the tree such as 738 * changing removing RVAL nodes for constant symbols. 739 */ 740 741 public assigntypes(p) 742 register Node p; 743 { 744 register Node p1; 745 register Symbol s; 746 747 switch (p->op) { 748 case O_SYM: 749 p->nodetype = namenode(p); 750 break; 751 752 case O_LCON: 753 p->nodetype = t_int; 754 break; 755 756 case O_FCON: 757 p->nodetype = t_real; 758 break; 759 760 case O_SCON: 761 p->value.scon = strdup(p->value.scon); 762 s = mkstring(p->value.scon); 763 if (s == t_char) { 764 p->op = O_LCON; 765 p->value.lcon = p->value.scon[0]; 766 } 767 p->nodetype = s; 768 break; 769 770 case O_INDIR: 771 p1 = p->value.arg[0]; 772 chkclass(p1, PTR); 773 p->nodetype = rtype(p1->nodetype)->type; 774 break; 775 776 case O_DOT: 777 p->nodetype = p->value.arg[1]->value.sym; 778 break; 779 780 case O_RVAL: 781 p1 = p->value.arg[0]; 782 p->nodetype = p1->nodetype; 783 if (p1->op == O_SYM) { 784 if (p1->nodetype->class == FUNC) { 785 p->op = O_CALL; 786 p->value.arg[1] = nil; 787 } else if (p1->value.sym->class == CONST) { 788 if (compatible(p1->value.sym->type, t_real)) { 789 p->op = O_FCON; 790 p->value.fcon = p1->value.sym->symvalue.fconval; 791 p->nodetype = t_real; 792 dispose(p1); 793 } else { 794 p->op = O_LCON; 795 p->value.lcon = p1->value.sym->symvalue.iconval; 796 p->nodetype = p1->value.sym->type; 797 dispose(p1); 798 } 799 } else if (isreg(p1->value.sym)) { 800 p->op = O_SYM; 801 p->value.sym = p1->value.sym; 802 dispose(p1); 803 } 804 } else if (p1->op == O_INDIR and p1->value.arg[0]->op == O_SYM) { 805 s = p1->value.arg[0]->value.sym; 806 if (isreg(s)) { 807 p1->op = O_SYM; 808 dispose(p1->value.arg[0]); 809 p1->value.sym = s; 810 p1->nodetype = s; 811 } 812 } 813 break; 814 815 /* 816 * Perform a cast if the call is of the form "type(expr)". 817 */ 818 case O_CALL: 819 p1 = p->value.arg[0]; 820 p->nodetype = rtype(p1->nodetype)->type; 821 break; 822 823 case O_TYPERENAME: 824 p->nodetype = p->value.arg[1]->nodetype; 825 break; 826 827 case O_ITOF: 828 p->nodetype = t_real; 829 break; 830 831 case O_NEG: 832 s = p->value.arg[0]->nodetype; 833 if (not compatible(s, t_int)) { 834 if (not compatible(s, t_real)) { 835 beginerrmsg(); 836 prtree(stderr, p->value.arg[0]); 837 fprintf(stderr, "is improper type"); 838 enderrmsg(); 839 } else { 840 p->op = O_NEGF; 841 } 842 } 843 p->nodetype = s; 844 break; 845 846 case O_ADD: 847 case O_SUB: 848 case O_MUL: 849 case O_LT: 850 case O_LE: 851 case O_GT: 852 case O_GE: 853 case O_EQ: 854 case O_NE: 855 { 856 Boolean t1real, t2real; 857 Symbol t1, t2; 858 859 t1 = rtype(p->value.arg[0]->nodetype); 860 t2 = rtype(p->value.arg[1]->nodetype); 861 t1real = compatible(t1, t_real); 862 t2real = compatible(t2, t_real); 863 if (t1real or t2real) { 864 p->op = (Operator) (ord(p->op) + 1); 865 if (not t1real) { 866 p->value.arg[0] = build(O_ITOF, p->value.arg[0]); 867 } else if (not t2real) { 868 p->value.arg[1] = build(O_ITOF, p->value.arg[1]); 869 } 870 } else { 871 if (t1real) { 872 convert(&(p->value.arg[0]), t_int, O_NOP); 873 } 874 if (t2real) { 875 convert(&(p->value.arg[1]), t_int, O_NOP); 876 } 877 } 878 if (ord(p->op) >= ord(O_LT)) { 879 p->nodetype = t_boolean; 880 } else { 881 if (t1real or t2real) { 882 p->nodetype = t_real; 883 } else { 884 p->nodetype = t_int; 885 } 886 } 887 break; 888 } 889 890 case O_DIVF: 891 convert(&(p->value.arg[0]), t_real, O_ITOF); 892 convert(&(p->value.arg[1]), t_real, O_ITOF); 893 p->nodetype = t_real; 894 break; 895 896 case O_DIV: 897 case O_MOD: 898 convert(&(p->value.arg[0]), t_int, O_NOP); 899 convert(&(p->value.arg[1]), t_int, O_NOP); 900 p->nodetype = t_int; 901 break; 902 903 case O_AND: 904 case O_OR: 905 chkboolean(p->value.arg[0]); 906 chkboolean(p->value.arg[1]); 907 p->nodetype = t_boolean; 908 break; 909 910 case O_QLINE: 911 p->nodetype = t_int; 912 break; 913 914 default: 915 p->nodetype = nil; 916 break; 917 } 918 } 919 920 /* 921 * Create a node for a name. The symbol for the name has already 922 * been chosen, either implicitly with "which" or explicitly from 923 * the dot routine. 924 */ 925 926 private Symbol namenode(p) 927 Node p; 928 { 929 register Symbol r, s; 930 register Node np; 931 932 s = p->value.sym; 933 if (s->class == REF) { 934 np = new(Node); 935 np->op = p->op; 936 np->nodetype = s; 937 np->value.sym = s; 938 p->op = O_INDIR; 939 p->value.arg[0] = np; 940 } 941 /* 942 * Old way 943 * 944 if (s->class == CONST or s->class == VAR or s->class == FVAR) { 945 r = s->type; 946 } else { 947 r = s; 948 } 949 * 950 */ 951 return s; 952 } 953 954 /* 955 * Convert a tree to a type via a conversion operator; 956 * if this isn't possible generate an error. 957 * 958 * Note the tree is call by address, hence the #define below. 959 */ 960 961 private convert(tp, typeto, op) 962 Node *tp; 963 Symbol typeto; 964 Operator op; 965 { 966 #define tree (*tp) 967 968 Symbol s; 969 970 s = rtype(tree->nodetype); 971 typeto = rtype(typeto); 972 if (compatible(typeto, t_real) and compatible(s, t_int)) { 973 tree = build(op, tree); 974 } else if (not compatible(s, typeto)) { 975 beginerrmsg(); 976 prtree(stderr, s); 977 fprintf(stderr, " is improper type"); 978 enderrmsg(); 979 } else if (op != O_NOP and s != typeto) { 980 tree = build(op, tree); 981 } 982 983 #undef tree 984 } 985 986 /* 987 * Construct a node for the dot operator. 988 * 989 * If the left operand is not a record, but rather a procedure 990 * or function, then we interpret the "." as referencing an 991 * "invisible" variable; i.e. a variable within a dynamically 992 * active block but not within the static scope of the current procedure. 993 */ 994 995 public Node dot(record, fieldname) 996 Node record; 997 Name fieldname; 998 { 999 register Node p; 1000 register Symbol s, t; 1001 1002 if (isblock(record->nodetype)) { 1003 find(s, fieldname) where 1004 s->block == record->nodetype and 1005 s->class != FIELD and s->class != TAG 1006 endfind(s); 1007 if (s == nil) { 1008 beginerrmsg(); 1009 fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname)); 1010 printname(stderr, record->nodetype); 1011 enderrmsg(); 1012 } 1013 p = new(Node); 1014 p->op = O_SYM; 1015 p->value.sym = s; 1016 p->nodetype = namenode(p); 1017 } else { 1018 p = record; 1019 t = rtype(p->nodetype); 1020 if (t->class == PTR) { 1021 s = findfield(fieldname, t->type); 1022 } else { 1023 s = findfield(fieldname, t); 1024 } 1025 if (s == nil) { 1026 beginerrmsg(); 1027 fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname)); 1028 prtree(stderr, record); 1029 enderrmsg(); 1030 } 1031 if (t->class == PTR and not isreg(record->nodetype)) { 1032 p = build(O_INDIR, record); 1033 } 1034 p = build(O_DOT, p, build(O_SYM, s)); 1035 } 1036 return p; 1037 } 1038 1039 /* 1040 * Return a tree corresponding to an array reference and do the 1041 * error checking. 1042 */ 1043 1044 public Node subscript(a, slist) 1045 Node a, slist; 1046 { 1047 register Symbol t; 1048 register Node p; 1049 Symbol etype, atype, eltype; 1050 Node esub, r; 1051 1052 r = a; 1053 t = rtype(a->nodetype); 1054 eltype = t->type; 1055 if (t->class == PTR) { 1056 p = slist->value.arg[0]; 1057 if (not compatible(p->nodetype, t_int)) { 1058 beginerrmsg(); 1059 fprintf(stderr, "bad type for subscript of "); 1060 prtree(stderr, a); 1061 enderrmsg(); 1062 } 1063 r = build(O_MUL, p, build(O_LCON, (long) size(eltype))); 1064 r = build(O_ADD, build(O_RVAL, a), r); 1065 r->nodetype = eltype; 1066 } else if (t->class != ARRAY) { 1067 beginerrmsg(); 1068 prtree(stderr, a); 1069 fprintf(stderr, " is not an array"); 1070 enderrmsg(); 1071 } else { 1072 p = slist; 1073 t = t->chain; 1074 for (; p != nil and t != nil; p = p->value.arg[1], t = t->chain) { 1075 esub = p->value.arg[0]; 1076 etype = rtype(esub->nodetype); 1077 atype = rtype(t); 1078 if (not compatible(atype, etype)) { 1079 beginerrmsg(); 1080 fprintf(stderr, "subscript "); 1081 prtree(stderr, esub); 1082 fprintf(stderr, " is the wrong type"); 1083 enderrmsg(); 1084 } 1085 r = build(O_INDEX, r, esub); 1086 r->nodetype = eltype; 1087 } 1088 if (p != nil or t != nil) { 1089 beginerrmsg(); 1090 if (p != nil) { 1091 fprintf(stderr, "too many subscripts for "); 1092 } else { 1093 fprintf(stderr, "not enough subscripts for "); 1094 } 1095 prtree(stderr, a); 1096 enderrmsg(); 1097 } 1098 } 1099 return r; 1100 } 1101 1102 /* 1103 * Evaluate a subscript index. 1104 */ 1105 1106 public int evalindex(s, i) 1107 Symbol s; 1108 long i; 1109 { 1110 long lb, ub; 1111 1112 s = rtype(s)->chain; 1113 lb = s->symvalue.rangev.lower; 1114 ub = s->symvalue.rangev.upper; 1115 if (i < lb or i > ub) { 1116 error("subscript out of range"); 1117 } 1118 return (i - lb); 1119 } 1120 1121 /* 1122 * Check to see if a tree is boolean-valued, if not it's an error. 1123 */ 1124 1125 public chkboolean(p) 1126 register Node p; 1127 { 1128 if (p->nodetype != t_boolean) { 1129 beginerrmsg(); 1130 fprintf(stderr, "found "); 1131 prtree(stderr, p); 1132 fprintf(stderr, ", expected boolean expression"); 1133 enderrmsg(); 1134 } 1135 } 1136 1137 /* 1138 * Check to make sure the given tree has a type of the given class. 1139 */ 1140 1141 private chkclass(p, class) 1142 Node p; 1143 Symclass class; 1144 { 1145 struct Symbol tmpsym; 1146 1147 tmpsym.class = class; 1148 if (rtype(p->nodetype)->class != class) { 1149 beginerrmsg(); 1150 fprintf(stderr, "\""); 1151 prtree(stderr, p); 1152 fprintf(stderr, "\" is not a %s", classname(&tmpsym)); 1153 enderrmsg(); 1154 } 1155 } 1156 1157 /* 1158 * Construct a node for the type of a string. While we're at it, 1159 * scan the string for '' that collapse to ', and chop off the ends. 1160 */ 1161 1162 private Symbol mkstring(str) 1163 String str; 1164 { 1165 register char *p, *q; 1166 register Symbol s; 1167 1168 p = str; 1169 q = str; 1170 while (*p != '\0') { 1171 if (*p == '\\') { 1172 ++p; 1173 } 1174 *q = *p; 1175 ++p; 1176 ++q; 1177 } 1178 *q = '\0'; 1179 s = newSymbol(nil, 0, ARRAY, t_char, nil); 1180 s->language = findlanguage(".s"); 1181 s->chain = newSymbol(nil, 0, RANGE, t_int, nil); 1182 s->chain->language = s->language; 1183 s->chain->symvalue.rangev.lower = 1; 1184 s->chain->symvalue.rangev.upper = p - str + 1; 1185 return s; 1186 } 1187 1188 /* 1189 * Free up the space allocated for a string type. 1190 */ 1191 1192 public unmkstring(s) 1193 Symbol s; 1194 { 1195 dispose(s->chain); 1196 } 1197 1198 /* 1199 * Figure out the "current" variable or function being referred to, 1200 * this is either the active one or the most visible from the 1201 * current scope. 1202 */ 1203 1204 public Symbol which(n) 1205 Name n; 1206 { 1207 register Symbol s, p, t, f; 1208 1209 find(s, n) where s->class != FIELD and s->class != TAG endfind(s); 1210 if (s == nil) { 1211 s = lookup(n); 1212 } 1213 if (s == nil) { 1214 error("\"%s\" is not defined", ident(n)); 1215 } else if (s == program or isbuiltin(s)) { 1216 t = s; 1217 } else { 1218 /* 1219 * Old way 1220 * 1221 if (not isactive(program)) { 1222 f = program; 1223 } else { 1224 f = whatblock(pc); 1225 if (f == nil) { 1226 panic("no block for addr 0x%x", pc); 1227 } 1228 } 1229 * 1230 * Now start with curfunc. 1231 */ 1232 p = curfunc; 1233 do { 1234 find(t, n) where 1235 t->block == p and t->class != FIELD and t->class != TAG 1236 endfind(t); 1237 p = p->block; 1238 } while (t == nil and p != nil); 1239 if (t == nil) { 1240 t = s; 1241 } 1242 } 1243 return t; 1244 } 1245 1246 /* 1247 * Find the symbol which is has the same name and scope as the 1248 * given symbol but is of the given field. Return nil if there is none. 1249 */ 1250 1251 public Symbol findfield(fieldname, record) 1252 Name fieldname; 1253 Symbol record; 1254 { 1255 register Symbol t; 1256 1257 t = rtype(record)->chain; 1258 while (t != nil and t->name != fieldname) { 1259 t = t->chain; 1260 } 1261 return t; 1262 } 1263