Return to symbols.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / dbx

Annotation of 43BSDReno/pgrm/dbx/symbols.c, revision 1.1

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

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