4.3BSD - /usr/src/ucb/dbx/symbols.c

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

Defined functions

Defined variables

Defined struct's

Defined typedef's

Defined macros