Return to symbols.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / lib / old_compiler / dbx

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

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