Return to symbols.c CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / dbx

Annotation of 43BSD/ucb/dbx/symbols.c, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.