X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/e10e78a7d6b66bda1404a5470ef3bd9e0f0e8f58..453fc342adf94edb47bb9e20aebfc9665cc835b0:/usr/src/old/dbx/symbols.c diff --git a/usr/src/old/dbx/symbols.c b/usr/src/old/dbx/symbols.c index 2196706c85..3060f55dd4 100644 --- a/usr/src/old/dbx/symbols.c +++ b/usr/src/old/dbx/symbols.c @@ -1,6 +1,14 @@ -/* Copyright (c) 1982 Regents of the University of California */ +/* + * Copyright (c) 1983 Regents of the University of California. + * All rights reserved. The Berkeley software License Agreement + * specifies the terms and conditions for redistribution. + */ + +#ifndef lint +static char sccsid[] = "@(#)symbols.c 5.4 (Berkeley) %G%"; +#endif not lint -static char sccsid[] = "@(#)symbols.c 1.11 %G%"; +static char rcsid[] = "$Header: symbols.c,v 1.3 87/03/26 23:17:35 donn Exp $"; /* * Symbol management. @@ -26,31 +34,42 @@ typedef struct Symbol *Symbol; #include "machine.h" #include "names.h" #include "languages.h" +#include "tree.h" /* * Symbol classes */ typedef enum { - BADUSE, CONST, TYPE, VAR, ARRAY, PTRFILE, RECORD, FIELD, + BADUSE, CONST, TYPE, VAR, ARRAY, OPENARRAY, DYNARRAY, SUBARRAY, + PTRFILE, RECORD, FIELD, PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT, - FPROC, FFUNC, MODULE, TAG, COMMON, TYPEREF + FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF } Symclass; typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; +#define INREG 0 +#define STK 1 +#define EXT 2 + +typedef unsigned integer Storage; + struct Symbol { Name name; Language language; Symclass class : 8; - Integer level : 8; + Storage storage : 2; + unsigned int level : 6; /* for variables stored on stack only */ Symbol type; Symbol chain; union { + Node constval; /* value of constant symbol */ int offset; /* variable address */ long iconval; /* integer constant value */ double fconval; /* floating constant value */ + int ndims; /* no. of dimensions for dynamic/sub-arrays */ struct { /* field offset and size (both in bits) */ int offset; int length; @@ -67,8 +86,10 @@ struct Symbol { } rangev; struct { int offset : 16; /* offset for of function value */ - Boolean src : 8; /* true if there is source line info */ - Boolean inline : 8; /* true if no separate act. rec. */ + Boolean src : 1; /* true if there is source line info */ + Boolean inline : 1; /* true if no separate act. rec. */ + Boolean intern : 1; /* internal calling sequence */ + int unused : 13; Address beginaddr; /* address of function code */ } funcv; struct { /* variant record info */ @@ -76,6 +97,8 @@ struct Symbol { Symbol vtorec; Symbol vtag; } varnt; + String typeref; /* type defined by ":" */ + Symbol extref; /* indirect symbol for external reference */ } symvalue; Symbol block; /* symbol containing this symbol */ Symbol next_sym; /* hash chain */ @@ -90,20 +113,28 @@ Symbol t_char; Symbol t_int; Symbol t_real; Symbol t_nil; +Symbol t_addr; Symbol program; Symbol curfunc; +boolean showaggrs; + #define symname(s) ident(s->name) #define codeloc(f) ((f)->symvalue.funcv.beginaddr) #define isblock(s) (Boolean) ( \ s->class == FUNC or s->class == PROC or \ s->class == MODULE or s->class == PROG \ ) +#define isroutine(s) (Boolean) ( \ + s->class == FUNC or s->class == PROC \ +) #define nosource(f) (not (f)->symvalue.funcv.src) #define isinline(f) ((f)->symvalue.funcv.inline) +#define isreg(s) (s->storage == INREG) + #include "tree.h" /* @@ -126,19 +157,21 @@ Symbol curfunc; /* * Symbol table structure currently does not support deletions. + * Hash table size is a power of two to make hashing faster. + * Using a non-prime is ok since we aren't doing rehashing. */ -#define HASHTABLESIZE 2003 +#define HASHTABLESIZE 8192 private Symbol hashtab[HASHTABLESIZE]; -#define hash(name) ((((unsigned) name) >> 2) mod HASHTABLESIZE) +#define hash(name) ((((unsigned) name) >> 2) & (HASHTABLESIZE - 1)) /* * Allocate a new symbol. */ -#define SYMBLOCKSIZE 100 +#define SYMBLOCKSIZE 1000 typedef struct Sympool { struct Symbol sym[SYMBLOCKSIZE]; @@ -154,7 +187,7 @@ public Symbol symbol_alloc() if (nleft <= 0) { newpool = new(Sympool); - bzero(newpool, sizeof(newpool)); + bzero(newpool, sizeof(*newpool)); newpool->prevpool = sympool; sympool = newpool; nleft = SYMBLOCKSIZE; @@ -163,15 +196,14 @@ public Symbol symbol_alloc() return &(sympool->sym[nleft]); } - -public symbol_dump(func) +public symbol_dump (func) Symbol func; { register Symbol s; - register Integer i; + register integer i; printf(" symbols in %s \n",symname(func)); - for (i = 0; i< HASHTABLESIZE; i++) { + for (i = 0; i < HASHTABLESIZE; i++) { for (s = hashtab[i]; s != nil; s = s->next_sym) { if (s->block == func) { psym(s); @@ -217,6 +249,8 @@ Symbol chain; s = symbol_alloc(); s->name = name; + s->language = primlang; + s->storage = EXT; s->level = blevel; s->class = class; s->type = type; @@ -260,9 +294,36 @@ Name name; return s; } +/* + * Delete a symbol from the symbol table. + */ + +public delete (s) +Symbol s; +{ + register Symbol t; + register unsigned int h; + + h = hash(s->name); + t = hashtab[h]; + if (t == nil) { + panic("delete of non-symbol '%s'", symname(s)); + } else if (t == s) { + hashtab[h] = s->next_sym; + } else { + while (t->next_sym != s) { + t = t->next_sym; + if (t == nil) { + panic("delete of non-symbol '%s'", symname(s)); + } + } + t->next_sym = s->next_sym; + } +} + /* * Dump out all the variables associated with the given - * procedure, function, or program at the given recursive level. + * procedure, function, or program associated with the given stack frame. * * This is quite inefficient. We traverse the entire symbol table * each time we're called. The assumption is that this routine @@ -290,33 +351,30 @@ Frame frame; } } -/* - * Create base types. - */ - -public symbols_init() -{ - t_boolean = maketype("$boolean", 0L, 1L); - t_int = maketype("$integer", 0x80000000L, 0x7fffffffL); - t_char = maketype("$char", 0L, 127L); - t_real = maketype("$real", 8L, 0L); - t_nil = maketype("$nil", 0L, 0L); -} - /* * Create a builtin type. * Builtin types are circular in that btype->type->type = btype. */ -public Symbol maketype(name, lower, upper) +private Symbol maketype(name, lower, upper) String name; long lower; long upper; { register Symbol s; + Name n; - s = newSymbol(identname(name, true), 0, TYPE, nil, nil); - s->language = findlanguage(".c"); + if (name == nil) { + n = nil; + } else { + n = identname(name, true); + } + s = insert(n); + s->language = primlang; + s->level = 0; + s->class = TYPE; + s->type = nil; + s->chain = nil; s->type = newSymbol(nil, 0, RANGE, s, nil); s->type->symvalue.rangev.lower = lower; s->type->symvalue.rangev.upper = upper; @@ -324,27 +382,34 @@ long upper; } /* - * These functions are now compiled inline. - * - * public String symname(s) -Symbol s; -{ - checkref(s); - return ident(s->name); -} + * Create the builtin symbols. + */ - * - * public Address codeloc(f) -Symbol f; +public symbols_init () { - checkref(f); - if (not isblock(f)) { - panic("codeloc: \"%s\" is not a block", ident(f->name)); - } - return f->symvalue.funcv.beginaddr; + Symbol s; + + t_boolean = maketype("$boolean", 0L, 1L); + t_int = maketype("$integer", 0x80000000L, 0x7fffffffL); + t_char = maketype("$char", 0L, 255L); + t_real = maketype("$real", 8L, 0L); + t_nil = maketype("$nil", 0L, 0L); + t_addr = insert(identname("$address", true)); + t_addr->language = primlang; + t_addr->level = 0; + t_addr->class = TYPE; + t_addr->type = newSymbol(nil, 1, PTR, t_int, nil); + s = insert(identname("true", true)); + s->class = CONST; + s->type = t_boolean; + s->symvalue.constval = build(O_LCON, 1L); + s->symvalue.constval->nodetype = t_boolean; + s = insert(identname("false", true)); + s->class = CONST; + s->type = t_boolean; + s->symvalue.constval = build(O_LCON, 0L); + s->symvalue.constval->nodetype = t_boolean; } - * - */ /* * Reduce type to avoid worrying about type names. @@ -357,21 +422,114 @@ Symbol type; t = type; if (t != nil) { - if (t->class == VAR or t->class == FIELD or t->class == REF ) { + if (t->class == VAR or t->class == CONST or + t->class == FIELD or t->class == REF + ) { t = t->type; } + if (t->class == TYPEREF) { + resolveRef(t); + } while (t->class == TYPE or t->class == TAG) { t = t->type; + if (t->class == TYPEREF) { + resolveRef(t); + } } } return t; } -public Integer level(s) +/* + * Find the end of a module name. Return nil if there is none + * in the given string. + */ + +private String findModuleMark (s) +String s; +{ + register char *p, *r; + register boolean done; + + p = s; + done = false; + do { + if (*p == ':') { + done = true; + r = p; + } else if (*p == '\0') { + done = true; + r = nil; + } else { + ++p; + } + } while (not done); + return r; +} + +/* + * Resolve a type reference by modifying to be the appropriate type. + * + * If the reference has a name, then it refers to an opaque type and + * the actual type is directly accessible. Otherwise, we must use + * the type reference string, which is of the form "module:{module:}name". + */ + +public resolveRef (t) +Symbol t; +{ + register char *p; + char *start; + Symbol s, m, outer; + Name n; + + if (t->name != nil) { + s = t; + } else { + start = t->symvalue.typeref; + outer = program; + p = findModuleMark(start); + while (p != nil) { + *p = '\0'; + n = identname(start, true); + find(m, n) where m->block == outer endfind(m); + if (m == nil) { + p = nil; + outer = nil; + s = nil; + } else { + outer = m; + start = p + 1; + p = findModuleMark(start); + } + } + if (outer != nil) { + n = identname(start, true); + find(s, n) where s->block == outer endfind(s); + } + } + if (s != nil and s->type != nil) { + t->name = s->type->name; + t->class = s->type->class; + t->type = s->type->type; + t->chain = s->type->chain; + t->symvalue = s->type->symvalue; + t->block = s->type->block; + } +} + +public integer regnum (s) Symbol s; { + integer r; + checkref(s); - return s->level; + if (s->storage == INREG) { + r = s->symvalue.offset; + } else { + r = -1; + } + return r; } public Symbol container(s) @@ -381,6 +539,16 @@ Symbol s; return s->block; } +public Node constval(s) +Symbol s; +{ + checkref(s); + if (s->class != CONST) { + error("[internal error: constval(non-CONST)]"); + } + return s->symvalue.constval; +} + /* * Return the object address of the given symbol. * @@ -392,12 +560,11 @@ Symbol s; * register - offset is register number */ -#define isglobal(s) (s->level == 1 or s->level == 2) -#define islocaloff(s) (s->level >= 3 and s->symvalue.offset < 0) -#define isparamoff(s) (s->level >= 3 and s->symvalue.offset >= 0) -#define isreg(s) (s->level < 0) +#define isglobal(s) (s->storage == EXT) +#define islocaloff(s) (s->storage == STK and s->symvalue.offset < 0) +#define isparamoff(s) (s->storage == STK and s->symvalue.offset >= 0) -public Address address(s, frame) +public Address address (s, frame) Symbol s; Frame frame; { @@ -418,11 +585,14 @@ Frame frame; cur = cur->block; } if (cur == nil) { - cur = whatblock(pc); - } - frp = findframe(cur); - if (frp == nil) { - panic("unexpected nil frame for \"%s\"", symname(s)); + frp = nil; + } else { + frp = findframe(cur); + if (frp == nil) { + error("[internal error: unexpected nil frame for \"%s\"]", + symname(s) + ); + } } } if (islocaloff(s)) { @@ -442,20 +612,18 @@ Frame frame; * Define a symbol used to access register values. */ -public defregname(n, r) +public defregname (n, r) Name n; -Integer r; +integer r; { - register Symbol s, t; + Symbol s; s = insert(n); - t = newSymbol(nil, 0, PTR, t_int, nil); - t->language = findlanguage(".s"); - s->language = t->language; + s->language = t_addr->language; s->class = VAR; - s->level = -3; - s->type = t; - s->block = program; + s->storage = INREG; + s->level = 3; + s->type = t_addr; s->symvalue.offset = r; } @@ -484,10 +652,17 @@ Symbol s; if (prev == nil) { error("couldn't find link to type reference"); } - find(t, prev->name) where - t->type != nil and t->class == prev->class and - t->type->class != BADUSE and t->block->class == MODULE - endfind(t); + t = lookup(prev->name); + while (t != nil and + not ( + t != prev and t->name == prev->name and + t->block->class == MODULE and t->class == prev->class and + t->type != nil and t->type->type != nil and + t->type->type->class != BADUSE + ) + ) { + t = t->next_sym; + } if (t == nil) { error("couldn't resolve reference"); } else { @@ -510,22 +685,63 @@ Symbol s; #define MINSHORT -32768 #define MAXSHORT 32767 -public Integer size(sym) +public findbounds (u, lower, upper) +Symbol u; +long *lower, *upper; +{ + Rangetype lbt, ubt; + long lb, ub; + + if (u->class == RANGE) { + lbt = u->symvalue.rangev.lowertype; + ubt = u->symvalue.rangev.uppertype; + lb = u->symvalue.rangev.lower; + ub = u->symvalue.rangev.upper; + if (lbt == R_ARG or lbt == R_TEMP) { + if (not getbound(u, lb, lbt, lower)) { + error("dynamic bounds not currently available"); + } + } else { + *lower = lb; + } + if (ubt == R_ARG or ubt == R_TEMP) { + if (not getbound(u, ub, ubt, upper)) { + error("dynamic bounds not currently available"); + } + } else { + *upper = ub; + } + } else if (u->class == SCAL) { + *lower = 0; + *upper = u->symvalue.iconval - 1; + } else { + error("[internal error: unexpected array bound type]"); + } +} + +public integer size(sym) Symbol sym; { - register Symbol s, t; - register int nel, elsize; + register Symbol s, t, u; + register integer nel, elsize; long lower, upper; - int r; + integer r, off, len; t = sym; checkref(t); + if (t->class == TYPEREF) { + resolveRef(t); + } switch (t->class) { case RANGE: lower = t->symvalue.rangev.lower; upper = t->symvalue.rangev.upper; - if (upper == 0 and lower > 0) { /* real */ + if (upper == 0 and lower > 0) { + /* real */ r = lower; + } else if (lower > upper) { + /* unsigned long */ + r = sizeof(long); } else if ( (lower >= MINCHAR and upper <= MAXCHAR) or (lower >= 0 and upper <= MAXUCHAR) @@ -545,32 +761,24 @@ Symbol sym; elsize = size(t->type); nel = 1; for (t = t->chain; t != nil; t = t->chain) { - if (t->symvalue.rangev.lowertype == R_ARG or - t->symvalue.rangev.lowertype == R_TEMP) { - if (not getbound(t, t->symvalue.rangev.lower, - t->symvalue.rangev.lowertype, &lower)) { - error("dynamic bounds not currently available"); - } - } else { - lower = t->symvalue.rangev.lower; - } - if (t->symvalue.rangev.uppertype == R_ARG or - t->symvalue.rangev.uppertype == R_TEMP) { - if (not getbound(t, t->symvalue.rangev.upper, - t->symvalue.rangev.uppertype, &upper)) { - error("dynamic bounds nor currently available"); - } - } else { - upper = t->symvalue.rangev.upper; - } + u = rtype(t); + findbounds(u, &lower, &upper); nel *= (upper-lower+1); } r = nel*elsize; break; + case OPENARRAY: + case DYNARRAY: + r = (t->symvalue.ndims + 1) * sizeof(Word); + break; + + case SUBARRAY: + r = (2 * t->symvalue.ndims + 1) * sizeof(Word); + break; + case REF: case VAR: - case FVAR: r = size(t->type); /* * @@ -580,23 +788,30 @@ Symbol sym; */ break; + case FVAR: case CONST: + case TAG: r = size(t->type); break; case TYPE: + /* + * This causes problems on the IRIS because of the compiler bug + * with stab offsets for parameters. Not sure it's really + * necessary anyway. + */ +# ifndef IRIS if (t->type->class == PTR and t->type->type->class == BADUSE) { findtype(t); } - r = size(t->type); - break; - - case TAG: +# endif r = size(t->type); break; case FIELD: - r = (t->symvalue.field.length + 7) div 8; + off = t->symvalue.field.offset; + len = t->symvalue.field.length; + r = (off + len + 7) div 8 - (off div 8); break; case RECORD: @@ -608,6 +823,7 @@ Symbol sym; break; case PTR: + case TYPEREF: case FILET: r = sizeof(Word); break; @@ -637,13 +853,67 @@ Symbol sym; r = sizeof(Symbol); break; + case SET: + u = rtype(t->type); + switch (u->class) { + case RANGE: + r = u->symvalue.rangev.upper - u->symvalue.rangev.lower + 1; + break; + + case SCAL: + r = u->symvalue.iconval; + break; + + default: + error("expected range for set base type"); + break; + } + r = (r + BITSPERBYTE - 1) div BITSPERBYTE; + break; + + /* + * These can happen in C (unfortunately) for unresolved type references + * Assume they are pointers. + */ + case BADUSE: + r = sizeof(Address); + break; + default: if (ord(t->class) > ord(TYPEREF)) { panic("size: bad class (%d)", ord(t->class)); } else { - error("improper operation on a %s", classname(t)); + fprintf(stderr, "can't compute size of a %s\n", classname(t)); } - /* NOTREACHED */ + r = 0; + break; + } + return r; +} + +/* + * Return the size associated with a symbol that takes into account + * reference parameters. This might be better as the normal size function, but + * too many places already depend on it working the way it does. + */ + +public integer psize (s) +Symbol s; +{ + integer r; + Symbol t; + + if (s->class == REF) { + t = rtype(s->type); + if (t->class == OPENARRAY) { + r = (t->symvalue.ndims + 1) * sizeof(Word); + } else if (t->class == SUBARRAY) { + r = (2 * t->symvalue.ndims + 1) * sizeof(Word); + } else { + r = sizeof(Word); + } + } else { + r = size(s); } return r; } @@ -665,6 +935,19 @@ Symbol s; return (Boolean) (t != nil); } +/* + * Test if a type is an open array parameter type. + */ + +public boolean isopenarray (type) +Symbol type; +{ + Symbol t; + + t = rtype(type); + return (boolean) (t->class == OPENARRAY); +} + /* * Test if a symbol is a var parameter, i.e. has class REF. */ @@ -681,27 +964,20 @@ Symbol s; */ public Boolean isvariable(s) -register Symbol s; +Symbol s; { return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF); } /* - * Test if a symbol is a block, e.g. function, procedure, or the - * main program. - * - * This function is now expanded inline for efficiency. - * - * public Boolean isblock(s) -register Symbol s; + * Test if a symbol is a constant. + */ + +public Boolean isconst(s) +Symbol s; { - return (Boolean) ( - s->class == FUNC or s->class == PROC or - s->class == MODULE or s->class == PROG - ); + return (Boolean) (s->class == CONST); } - * - */ /* * Test if a symbol is a module. @@ -714,14 +990,64 @@ register Symbol s; } /* - * Test if a symbol is builtin, that is, a predefined type or - * reserved word. + * Mark a procedure or function as internal, meaning that it is called + * with a different calling sequence. */ -public Boolean isbuiltin(s) +public markInternal (s) +Symbol s; +{ + s->symvalue.funcv.intern = true; +} + +public boolean isinternal (s) +Symbol s; +{ + return s->symvalue.funcv.intern; +} + +/* + * Decide if a field begins or ends on a bit rather than byte boundary. + */ + +public Boolean isbitfield(s) register Symbol s; { - return (Boolean) (s->level == 0 and s->class != PROG and s->class != VAR); + boolean b; + register integer off, len; + register Symbol t; + + off = s->symvalue.field.offset; + len = s->symvalue.field.length; + if ((off mod BITSPERBYTE) != 0 or (len mod BITSPERBYTE) != 0) { + b = true; + } else { + t = rtype(s->type); + b = (Boolean) ( + (t->class == SCAL and len != (sizeof(int)*BITSPERBYTE)) or + len != (size(t)*BITSPERBYTE) + ); + } + return b; +} + +private boolean primlang_typematch (t1, t2) +Symbol t1, t2; +{ + return (boolean) ( + (t1 == t2) or + ( + t1->class == RANGE and t2->class == RANGE and + t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and + t1->symvalue.rangev.upper == t2->symvalue.rangev.upper + ) or ( + t1->class == PTR and t2->class == RANGE and + t2->symvalue.rangev.upper >= t2->symvalue.rangev.lower + ) or ( + t2->class == PTR and t1->class == RANGE and + t1->symvalue.rangev.upper >= t1->symvalue.rangev.lower + ) + ); } /* @@ -735,6 +1061,7 @@ public Boolean compatible(t1, t2) register Symbol t1, t2; { Boolean b; + Symbol rt1, rt2; if (t1 == t2) { b = true; @@ -745,14 +1072,21 @@ register Symbol t1, t2; } else if (t2 == procsym) { b = isblock(t1); } else if (t1->language == nil) { - b = (Boolean) (t2->language == nil or - (*language_op(t2->language, L_TYPEMATCH))(t1, t2)); - } else if (t2->language == nil) { - b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); - } else if ( isbuiltin(t1) or isbuiltin(t1->type) ) { - b = (Boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); + if (t2->language == nil) { + b = false; + } else if (t2->language == primlang) { + b = (boolean) primlang_typematch(rtype(t1), rtype(t2)); + } else { + b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); + } + } else if (t1->language == primlang) { + if (t2->language == primlang or t2->language == nil) { + b = primlang_typematch(rtype(t1), rtype(t2)); + } else { + b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2); + } } else { - b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); + b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2); } return b; } @@ -765,14 +1099,40 @@ public Boolean istypename(type, name) Symbol type; String name; { - Symbol t; + register Symbol t; Boolean b; t = type; - checkref(t); - b = (Boolean) ( - t->class == TYPE and t->name == identname(name, true) - ); + if (t == nil) { + b = false; + } else { + b = (Boolean) ( + t->class == TYPE and streq(ident(t->name), name) + ); + } + return b; +} + +/* + * Determine if a (value) parameter should actually be passed by address. + */ + +public boolean passaddr (p, exprtype) +Symbol p, exprtype; +{ + boolean b; + Language def; + + if (p == nil) { + def = findlanguage(".c"); + b = (boolean) (*language_op(def, L_PASSADDR))(p, exprtype); + } else if (p->language == nil or p->language == primlang) { + b = false; + } else if (isopenarray(p->type)) { + b = true; + } else { + b = (boolean) (*language_op(p->language, L_PASSADDR))(p, exprtype); + } return b; } @@ -794,15 +1154,15 @@ typedef char *Arglist; #define nextarg(type) ((type *) (ap += sizeof(type)))[-1] private Symbol mkstring(); -private Symbol namenode(); /* * Determine the type of a parse tree. + * * Also make some symbol-dependent changes to the tree such as - * changing removing RVAL nodes for constant symbols. + * removing indirection for constant or register symbols. */ -public assigntypes(p) +public assigntypes (p) register Node p; { register Node p1; @@ -810,30 +1170,35 @@ register Node p; switch (p->op) { case O_SYM: - p->nodetype = namenode(p); + p->nodetype = p->value.sym; break; case O_LCON: p->nodetype = t_int; break; + case O_CCON: + p->nodetype = t_char; + break; + case O_FCON: p->nodetype = t_real; break; case O_SCON: - p->value.scon = strdup(p->value.scon); - s = mkstring(p->value.scon); - if (s == t_char) { - p->op = O_LCON; - p->value.lcon = p->value.scon[0]; - } - p->nodetype = s; + p->nodetype = mkstring(p->value.scon); break; case O_INDIR: p1 = p->value.arg[0]; - chkclass(p1, PTR); + s = rtype(p1->nodetype); + if (s->class != PTR) { + beginerrmsg(); + fprintf(stderr, "\""); + prtree(stderr, p1); + fprintf(stderr, "\" is not a pointer"); + enderrmsg(); + } p->nodetype = rtype(p1->nodetype)->type; break; @@ -845,21 +1210,16 @@ register Node p; p1 = p->value.arg[0]; p->nodetype = p1->nodetype; if (p1->op == O_SYM) { - if (p1->nodetype->class == FUNC) { - p->op = O_CALL; - p->value.arg[1] = nil; + if (p1->nodetype->class == PROC or p->nodetype->class == FUNC) { + p->op = p1->op; + p->value.sym = p1->value.sym; + p->nodetype = p1->nodetype; + dispose(p1); } else if (p1->value.sym->class == CONST) { - if (compatible(p1->value.sym->type, t_real)) { - p->op = O_FCON; - p->value.fcon = p1->value.sym->symvalue.fconval; - p->nodetype = t_real; - dispose(p1); - } else { - p->op = O_LCON; - p->value.lcon = p1->value.sym->symvalue.iconval; - p->nodetype = p1->value.sym->type; - dispose(p1); - } + p->op = p1->op; + p->value = p1->value; + p->nodetype = p1->nodetype; + dispose(p1); } else if (isreg(p1->value.sym)) { p->op = O_SYM; p->value.sym = p1->value.sym; @@ -876,6 +1236,11 @@ register Node p; } break; + case O_COMMA: + p->nodetype = p->value.arg[0]->nodetype; + break; + + case O_CALLPROC: case O_CALL: p1 = p->value.arg[0]; p->nodetype = rtype(p1->nodetype)->type; @@ -894,8 +1259,9 @@ register Node p; if (not compatible(s, t_int)) { if (not compatible(s, t_real)) { beginerrmsg(); + fprintf(stderr, "\""); prtree(stderr, p->value.arg[0]); - fprintf(stderr, "is improper type"); + fprintf(stderr, "\" is improper type"); enderrmsg(); } else { p->op = O_NEGF; @@ -907,46 +1273,17 @@ register Node p; case O_ADD: case O_SUB: case O_MUL: + binaryop(p, nil); + break; + case O_LT: case O_LE: case O_GT: case O_GE: case O_EQ: case O_NE: - { - Boolean t1real, t2real; - Symbol t1, t2; - - t1 = rtype(p->value.arg[0]->nodetype); - t2 = rtype(p->value.arg[1]->nodetype); - t1real = compatible(t1, t_real); - t2real = compatible(t2, t_real); - if (t1real or t2real) { - p->op = (Operator) (ord(p->op) + 1); - if (not t1real) { - p->value.arg[0] = build(O_ITOF, p->value.arg[0]); - } else if (not t2real) { - p->value.arg[1] = build(O_ITOF, p->value.arg[1]); - } - } else { - if (t1real) { - convert(&(p->value.arg[0]), t_int, O_NOP); - } - if (t2real) { - convert(&(p->value.arg[1]), t_int, O_NOP); - } - } - if (ord(p->op) >= ord(O_LT)) { - p->nodetype = t_boolean; - } else { - if (t1real or t2real) { - p->nodetype = t_real; - } else { - p->nodetype = t_int; - } - } + binaryop(p, t_boolean); break; - } case O_DIVF: convert(&(p->value.arg[0]), t_real, O_ITOF); @@ -979,37 +1316,51 @@ register Node p; } /* - * Create a node for a name. The symbol for the name has already - * been chosen, either implicitly with "which" or explicitly from - * the dot routine. + * Process a binary arithmetic or relational operator. + * Convert from integer to real if necessary. */ -private Symbol namenode(p) +private binaryop (p, t) Node p; +Symbol t; { - register Symbol r, s; - register Node np; - - s = p->value.sym; - if (s->class == REF) { - np = new(Node); - np->op = p->op; - np->nodetype = s; - np->value.sym = s; - p->op = O_INDIR; - p->value.arg[0] = np; - } -/* - * Old way - * - if (s->class == CONST or s->class == VAR or s->class == FVAR) { - r = s->type; + Node p1, p2; + Boolean t1real, t2real; + Symbol t1, t2; + + p1 = p->value.arg[0]; + p2 = p->value.arg[1]; + t1 = rtype(p1->nodetype); + t2 = rtype(p2->nodetype); + t1real = compatible(t1, t_real); + t2real = compatible(t2, t_real); + if (t1real or t2real) { + p->op = (Operator) (ord(p->op) + 1); + if (not t1real) { + p->value.arg[0] = build(O_ITOF, p1); + } else if (not t2real) { + p->value.arg[1] = build(O_ITOF, p2); + } + p->nodetype = t_real; } else { - r = s; + if (size(p1->nodetype) > sizeof(integer)) { + beginerrmsg(); + fprintf(stderr, "operation not defined on \""); + prtree(stderr, p1); + fprintf(stderr, "\""); + enderrmsg(); + } else if (size(p2->nodetype) > sizeof(integer)) { + beginerrmsg(); + fprintf(stderr, "operation not defined on \""); + prtree(stderr, p2); + fprintf(stderr, "\""); + enderrmsg(); + } + p->nodetype = t_int; + } + if (t != nil) { + p->nodetype = t; } - * - */ - return s; } /* @@ -1024,24 +1375,24 @@ Node *tp; Symbol typeto; Operator op; { -#define tree (*tp) - - Symbol s; + Node tree; + Symbol s, t; + tree = *tp; s = rtype(tree->nodetype); - typeto = rtype(typeto); - if (compatible(typeto, t_real) and compatible(s, t_int)) { + t = rtype(typeto); + if (compatible(t, t_real) and compatible(s, t_int)) { tree = build(op, tree); - } else if (not compatible(s, typeto)) { + } else if (not compatible(s, t)) { beginerrmsg(); - prtree(stderr, s); - fprintf(stderr, " is improper type"); + fprintf(stderr, "expected integer or real, found \""); + prtree(stderr, tree); + fprintf(stderr, "\""); enderrmsg(); - } else if (op != O_NOP and s != typeto) { + } else if (op != O_NOP and s != t) { tree = build(op, tree); } - -#undef tree + *tp = tree; } /* @@ -1057,26 +1408,27 @@ public Node dot(record, fieldname) Node record; Name fieldname; { - register Node p; + register Node rec, p; register Symbol s, t; - if (isblock(record->nodetype)) { + rec = record; + if (isblock(rec->nodetype)) { find(s, fieldname) where - s->block == record->nodetype and - s->class != FIELD and s->class != TAG + s->block == rec->nodetype and + s->class != FIELD endfind(s); if (s == nil) { beginerrmsg(); fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname)); - printname(stderr, record->nodetype); + printname(stderr, rec->nodetype); enderrmsg(); } p = new(Node); p->op = O_SYM; p->value.sym = s; - p->nodetype = namenode(p); + p->nodetype = s; } else { - p = record; + p = rec; t = rtype(p->nodetype); if (t->class == PTR) { s = findfield(fieldname, t->type); @@ -1086,15 +1438,16 @@ Name fieldname; if (s == nil) { beginerrmsg(); fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname)); - prtree(stderr, record); + prtree(stderr, rec); enderrmsg(); } - if (t->class == PTR and not isreg(record->nodetype)) { - p = build(O_INDIR, record); + if (t->class != PTR or isreg(rec->nodetype)) { + p = unrval(p); } + p->nodetype = t_addr; p = build(O_DOT, p, build(O_SYM, s)); } - return p; + return build(O_RVAL, p); } /* @@ -1105,38 +1458,37 @@ Name fieldname; public Node subscript(a, slist) Node a, slist; { -Symbol t; + Symbol t; + Node p; - t = rtype(a->nodetype); - if(t->language == nil) { - error("unknown language"); - } - else { - return ( (Node) - (*language_op(t->language, L_BUILDAREF)) (a,slist) - ); - } + t = rtype(a->nodetype); + if (t->language == nil or t->language == primlang) { + p = (Node) (*language_op(findlanguage(".s"), L_BUILDAREF))(a, slist); + } else { + p = (Node) (*language_op(t->language, L_BUILDAREF))(a, slist); + } + return build(O_RVAL, p); } /* * Evaluate a subscript index. */ -public int evalindex(s, i) +public int evalindex(s, base, i) Symbol s; +Address base; long i; { -Symbol t; + Symbol t; + int r; - t = rtype(s); - if(t->language == nil) { - error("unknown language"); - } - else { - return ( - (*language_op(t->language, L_EVALAREF)) (s,i) - ); - } + t = rtype(s); + if (t->language == nil or t->language == primlang) { + r = ((*language_op(findlanguage(".s"), L_EVALAREF)) (s, base, i)); + } else { + r = ((*language_op(t->language, L_EVALAREF)) (s, base, i)); + } + return r; } /* @@ -1156,53 +1508,19 @@ register Node p; } /* - * Check to make sure the given tree has a type of the given class. - */ - -private chkclass(p, class) -Node p; -Symclass class; -{ - struct Symbol tmpsym; - - tmpsym.class = class; - if (rtype(p->nodetype)->class != class) { - beginerrmsg(); - fprintf(stderr, "\""); - prtree(stderr, p); - fprintf(stderr, "\" is not a %s", classname(&tmpsym)); - enderrmsg(); - } -} - -/* - * Construct a node for the type of a string. While we're at it, - * scan the string for '' that collapse to ', and chop off the ends. + * Construct a node for the type of a string. */ private Symbol mkstring(str) String str; { - register char *p, *q; register Symbol s; - p = str; - q = str; - while (*p != '\0') { - if (*p == '\\') { - ++p; - } - *q = *p; - ++p; - ++q; - } - *q = '\0'; s = newSymbol(nil, 0, ARRAY, t_char, nil); - s->language = findlanguage(".s"); s->chain = newSymbol(nil, 0, RANGE, t_int, nil); s->chain->language = s->language; s->chain->symvalue.rangev.lower = 1; - s->chain->symvalue.rangev.upper = p - str + 1; + s->chain->symvalue.rangev.upper = strlen(str) + 1; return s; } @@ -1217,59 +1535,121 @@ Symbol s; } /* - * Figure out the "current" variable or function being referred to, - * this is either the active one or the most visible from the - * current scope. + * Figure out the "current" variable or function being referred to + * by the name n. */ -public Symbol which(n) +private boolean stwhich(), dynwhich(); + +public Symbol which (n) Name n; { - register Symbol s, p, t, f; + Symbol s; - find(s, n) where s->class != FIELD and s->class != TAG endfind(s); - if (s == nil) { - s = lookup(n); - } + s = lookup(n); if (s == nil) { error("\"%s\" is not defined", ident(n)); - } else if (s == program or isbuiltin(s)) { - t = s; - } else { - /* - * Old way - * - if (not isactive(program)) { - f = program; - } else { - f = whatblock(pc); - if (f == nil) { - panic("no block for addr 0x%x", pc); + } else if (not stwhich(&s) and isambiguous(s) and not dynwhich(&s)) { + printf("[using "); + printname(stdout, s); + printf("]\n"); + } + return s; +} + +/* + * Static search. + */ + +private boolean stwhich (var_s) +Symbol *var_s; +{ + Name n; /* name of desired symbol */ + Symbol s; /* iteration variable for symbols with name n */ + Symbol f; /* iteration variable for blocks containing s */ + integer count; /* number of levels from s->block to curfunc */ + Symbol t; /* current best answer for stwhich(n) */ + integer mincount; /* relative level for current best answer (t) */ + boolean b; /* return value, true if symbol found */ + + s = *var_s; + n = s->name; + t = s; + mincount = 10000; /* force first match to set mincount */ + do { + if (s->name == n and s->class != FIELD and s->class != TAG) { + f = curfunc; + count = 0; + while (f != nil and f != s->block) { + ++count; + f = f->block; + } + if (f != nil and count < mincount) { + t = s; + mincount = count; + b = true; } } - * - * Now start with curfunc. - */ - p = curfunc; - do { - find(t, n) where - t->block == p and t->class != FIELD and t->class != TAG - endfind(t); - p = p->block; - } while (t == nil and p != nil); - if (t == nil) { - t = s; + s = s->next_sym; + } while (s != nil); + if (mincount != 10000) { + *var_s = t; + b = true; + } else { + b = false; + } + return b; +} + +/* + * Dynamic search. + */ + +private boolean dynwhich (var_s) +Symbol *var_s; +{ + Name n; /* name of desired symbol */ + Symbol s; /* iteration variable for possible symbols */ + Symbol f; /* iteration variable for active functions */ + Frame frp; /* frame associated with stack walk */ + boolean b; /* return value */ + + f = curfunc; + frp = curfuncframe(); + n = (*var_s)->name; + b = false; + if (frp != nil) { + frp = nextfunc(frp, &f); + while (frp != nil) { + s = *var_s; + while (s != nil and + ( + s->name != n or s->block != f or + s->class == FIELD or s->class == TAG + ) + ) { + s = s->next_sym; + } + if (s != nil) { + *var_s = s; + b = true; + break; + } + if (f == program) { + break; + } + frp = nextfunc(frp, &f); } } - return t; + return b; } /* - * Find the symbol which is has the same name and scope as the + * Find the symbol that has the same name and scope as the * given symbol but is of the given field. Return nil if there is none. */ -public Symbol findfield(fieldname, record) +public Symbol findfield (fieldname, record) Name fieldname; Symbol record; {