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