/* Copyright (c) 1982 Regents of the University of California */
static char sccsid
[] = "@(#)symbols.c 1.2 %G%";
typedef struct Symbol
*Symbol
;
BADUSE
, CONST
, TYPE
, VAR
, ARRAY
, PTRFILE
, RECORD
, FIELD
,
PROC
, FUNC
, FVAR
, REF
, PTR
, FILET
, SET
, RANGE
,
LABEL
, WITHPTR
, SCAL
, STR
, PROG
, IMPROPER
, VARNT
,
FPROC
, FFUNC
, MODULE
, TYPEREF
, TAG
int offset
; /* variable address */
long iconval
; /* integer constant value */
double fconval
; /* floating constant value */
struct { /* field offset and size (both in bits) */
struct { /* range bounds */
struct { /* address of function value, code */
struct { /* variant record info */
Symbol block
; /* symbol containing this symbol */
Symbol next_sym
; /* hash chain */
#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 \
* Some macros to make finding a symbol with certain attributes.
#define find(s, withname) \
while (s != nil and not (s->name == (withname) and
#define where /* qualification */
#define endfind(s) )) { \
* Symbol table structure currently does not support deletions.
#define HASHTABLESIZE 2003
private Symbol hashtab
[HASHTABLESIZE
];
#define hash(name) ((((unsigned) name) >> 2) mod HASHTABLESIZE)
#define SYMBLOCKSIZE 1000
struct Symbol sym
[SYMBLOCKSIZE
];
struct Sympool
*prevpool
;
private Sympool sympool
= nil
;
private Integer nleft
= 0;
private struct Sympool zeropool
;
public Symbol
symbol_alloc()
register Sympool newpool
;
newpool
->prevpool
= sympool
;
return &(sympool
->sym
[nleft
]);
* Free all the symbols currently allocated.
for (i
= 0; i
< HASHTABLESIZE
; i
++) {
* Create a new symbol with the given attributes.
public Symbol
newSymbol(name
, blevel
, class, type
, chain
)
* Insert a symbol into the hash table.
public Symbol
insert(name
)
s
->next_sym
= hashtab
[h
];
public Symbol
lookup(name
)
while (s
!= nil
and s
->name
!= name
) {
* Dump out all the variables associated with the given
* procedure, function, or program at the given recursive level.
* This is quite inefficient. We traverse the entire symbol table
* each time we're called. The assumption is that this routine
* won't be called frequently enough to merit improved performance.
public dumpvars(f
, frame
)
for (i
= 0; i
< HASHTABLESIZE
; i
++) {
for (s
= hashtab
[i
]; s
!= nil
; s
= s
->next_sym
) {
} else if (s
->class == MODULE
) {
* Builtin types are circular in that btype->type->type = btype.
public Symbol
maketype(name
, lower
, upper
)
s
= newSymbol(identname(name
, true), 0, TYPE
, nil
, nil
);
s
->language
= findlanguage(".c");
s
->type
= newSymbol(nil
, 0, RANGE
, s
, nil
);
s
->type
->symvalue
.rangev
.lower
= lower
;
s
->type
->symvalue
.rangev
.upper
= upper
;
* These functions are now compiled inline.
* public String symname(s)
* public Address codeloc(f)
panic("codeloc: \"%s\" is not a block", ident(f->name));
return f->symvalue.funcv.beginaddr;
* Reduce type to avoid worrying about type names.
public Symbol
rtype(type
)
if (t
->class == VAR
or t
->class == FIELD
) {
while (t
->class == TYPE
or t
->class == TAG
) {
public Symbol
container(s
)
* Return the object address of the given symbol.
* There are the following possibilities:
* globals - just take offset
* locals - take offset from locals base
* arguments - take offset from argument base
* 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)
public Address
address(s
, frame
)
if (not isactive(s
->block
)) {
error("\"%s\" is not currently defined", symname(s
));
} else if (isglobal(s
)) {
addr
= s
->symvalue
.offset
;
while (cur
!= nil
and cur
->class == MODULE
) {
panic("unexpected nil frame for \"%s\"", symname(s
));
addr
= locals_base(frp
) + s
->symvalue
.offset
;
} else if (isparamoff(s
)) {
addr
= args_base(frp
) + s
->symvalue
.offset
;
addr
= savereg(s
->symvalue
.offset
, frp
);
panic("address: bad symbol \"%s\"", symname(s
));
* Define a symbol used to access register values.
t
= newSymbol(nil
, 0, PTR
, t_int
, nil
);
t
->language
= findlanguage(".s");
s
->language
= t
->language
;
* Resolve an "abstract" type reference.
* It is possible in C to define a pointer to a type, but never define
* the type in a particular source file. Here we try to resolve
* the type definition. This is problematic, it is possible to
* have multiple, different definitions for the same name type.
register Symbol t
, u
, prev
;
while (u
!= nil
and u
->class != BADUSE
) {
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
error("couldn't resolve reference");
* Find the size in bytes of the given type.
* This is probably the WRONG thing to do. The size should be kept
* as an attribute in the symbol information as is done for structures
* and fields. I haven't gotten around to cleaning this up yet.
register int nel
, elsize
;
lower
= t
->symvalue
.rangev
.lower
;
upper
= t
->symvalue
.rangev
.upper
;
if (upper
== 0 and lower
> 0) { /* real */
} else if (lower
>= MINCHAR
and upper
<= MAXCHAR
) {
} else if (lower
>= MINSHORT
and upper
<= MAXSHORT
) {
for (t
= t
->chain
; t
!= nil
; t
= t
->chain
) {
lower
= s
->symvalue
.rangev
.lower
;
upper
= s
->symvalue
.rangev
.upper
;
if (t
->type
->class == PTR
and t
->type
->type
->class == BADUSE
) {
r
= (t
->symvalue
.field
.length
+ 7) div
8;
if (r
== 0 and t
->chain
!= nil
) {
panic("missing size information for record");
if (t
->symvalue
.iconval
> 255) {
if (ord(t
->class) > ord(TYPEREF
)) {
panic("size: bad class (%d)", ord(t
->class));
error("improper operation on a %s", classname(t
));
if (r
< sizeof(Word
) and isparam(sym
)) {
* Test if a symbol is a parameter. This is true if there
* is a cycle from s->block to s via chain pointers.
public Boolean
isparam(s
)
while (t
!= nil
and t
!= s
) {
return (Boolean
) (t
!= nil
);
* Test if a symbol is a var parameter, i.e. has class REF.
public Boolean
isvarparam(s
)
return (Boolean
) (s
->class == REF
);
* Test if a symbol is a variable (actually any addressible quantity
public Boolean
isvariable(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
* This function is now expanded inline for efficiency.
* public Boolean isblock(s)
s->class == FUNC or s->class == PROC or
s->class == MODULE or s->class == PROG
* Test if a symbol is a module.
public Boolean
ismodule(s
)
return (Boolean
) (s
->class == MODULE
);
* Test if a symbol is builtin, that is, a predefined type or
public Boolean
isbuiltin(s
)
return (Boolean
) (s
->level
== 0 and s
->class != PROG
and s
->class != VAR
);
* Test if two types match.
* Equivalent names implies a match in any language.
* Special symbols must be handled with care.
public Boolean
compatible(t1
, t2
)
} else if (t1
== nil
or t2
== nil
) {
} else if (t1
== procsym
) {
} else if (t2
== procsym
) {
} else if (t1
->language
== nil
) {
b
= (Boolean
) (t2
->language
== nil
or
(*language_op(t2
->language
, L_TYPEMATCH
))(t1
, t2
));
b
= (Boolean
) (*language_op(t1
->language
, L_TYPEMATCH
))(t1
, t2
);
* Check for a type of the given name.
public Boolean
istypename(type
, name
)
t
->class == TYPE
and t
->name
== identname(name
, true)
* Test if the name of a symbol is uniquely defined or not.
public Boolean
isambiguous(s
)
find(t
, s
->name
) where t
!= s
endfind(t
);
return (Boolean
) (t
!= nil
);
#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.
p
->nodetype
= namenode(p
);
p
->value
.scon
= strdup(p
->value
.scon
);
s
= mkstring(p
->value
.scon
);
p
->value
.lcon
= p
->value
.scon
[0];
p
->nodetype
= rtype(p1
->nodetype
)->type
;
p
->nodetype
= p
->value
.arg
[1]->value
.sym
;
p
->nodetype
= p1
->nodetype
;
if (p1
->nodetype
->class == FUNC
) {
} else if (p1
->value
.sym
->class == CONST
) {
if (compatible(p1
->value
.sym
->type
, t_real
)) {
p
->value
.fcon
= p1
->value
.sym
->symvalue
.fconval
;
p
->value
.lcon
= p1
->value
.sym
->symvalue
.iconval
;
p
->nodetype
= p1
->value
.sym
->type
;
} else if (isreg(p1
->value
.sym
)) {
p
->value
.sym
= p1
->value
.sym
;
} else if (p1
->op
== O_INDIR
and p1
->value
.arg
[0]->op
== O_SYM
) {
s
= p1
->value
.arg
[0]->value
.sym
;
dispose(p1
->value
.arg
[0]);
* Perform a cast if the call is of the form "type(expr)".
(p1
->value
.sym
->class == TYPE
or p1
->value
.sym
->class == TAG
)) {
assert(p1
->op
== O_COMMA
);
if (p1
->value
.arg
[1] != nil
) {
error("unexpected comma within type conversion");
p
->value
.arg
[0] = p1
->value
.arg
[0];
p
->value
.arg
[0]->nodetype
= s
;
p
->nodetype
= rtype(p1
->nodetype
)->type
;
s
= p
->value
.arg
[0]->nodetype
;
if (not compatible(s
, t_int
)) {
if (not compatible(s
, t_real
)) {
prtree(stderr
, p
->value
.arg
[0]);
fprintf(stderr
, "is improper type");
t1
= rtype(p
->value
.arg
[0]->nodetype
);
t2
= rtype(p
->value
.arg
[1]->nodetype
);
t1real
= compatible(t1
, t_real
);
t2real
= compatible(t2
, t_real
);
p
->op
= (Operator
) (ord(p
->op
) + 1);
p
->value
.arg
[0] = build(O_ITOF
, p
->value
.arg
[0]);
p
->value
.arg
[1] = build(O_ITOF
, p
->value
.arg
[1]);
convert(&(p
->value
.arg
[0]), t_int
, O_NOP
);
convert(&(p
->value
.arg
[1]), t_int
, O_NOP
);
if (ord(p
->op
) >= ord(O_LT
)) {
convert(&(p
->value
.arg
[0]), t_real
, O_ITOF
);
convert(&(p
->value
.arg
[1]), t_real
, O_ITOF
);
convert(&(p
->value
.arg
[0]), t_int
, O_NOP
);
convert(&(p
->value
.arg
[1]), t_int
, O_NOP
);
chkboolean(p
->value
.arg
[0]);
chkboolean(p
->value
.arg
[1]);
* Create a node for a name. The symbol for the name has already
* been chosen, either implicitly with "which" or explicitly from
private Symbol
namenode(p
)
if (s->class == CONST or s->class == VAR or s->class == FVAR) {
* Convert a tree to a type via a conversion operator;
* if this isn't possible generate an error.
* Note the tree is call by address, hence the #define below.
private convert(tp
, typeto
, op
)
s
= rtype(tree
->nodetype
);
if (compatible(typeto
, t_real
) and compatible(s
, t_int
)) {
} else if (not compatible(s
, typeto
)) {
fprintf(stderr
, " is improper type");
} else if (op
!= O_NOP
and s
!= typeto
) {
* Construct a node for the dot operator.
* If the left operand is not a record, but rather a procedure
* or function, then we interpret the "." as referencing an
* "invisible" variable; i.e. a variable within a dynamically
* active block but not within the static scope of the current procedure.
public Node
dot(record
, fieldname
)
if (isblock(record
->nodetype
)) {
s
->block
== record
->nodetype
and
s
->class != FIELD
and s
->class != TAG
fprintf(stderr
, "\"%s\" is not defined in ", ident(fieldname
));
printname(stderr
, record
->nodetype
);
p
->nodetype
= namenode(p
);
s
= findfield(fieldname
, t
->type
);
s
= findfield(fieldname
, t
);
fprintf(stderr
, "\"%s\" is not a field in ", ident(fieldname
));
if (t
->class == PTR
and not isreg(record
->nodetype
)) {
p
= build(O_INDIR
, record
);
p
= build(O_DOT
, p
, build(O_SYM
, s
));
* Return a tree corresponding to an array reference and do the
public Node
subscript(a
, slist
)
Symbol etype
, atype
, eltype
;
fprintf(stderr
, " is not an array");
for (; p
!= nil
and t
!= nil
; p
= p
->value
.arg
[1], t
= t
->chain
) {
etype
= rtype(esub
->nodetype
);
if (not compatible(atype
, etype
)) {
fprintf(stderr
, "subscript ");
fprintf(stderr
, " is the wrong type");
a
= build(O_INDEX
, a
, esub
);
if (p
!= nil
or t
!= nil
) {
fprintf(stderr
, "too many subscripts for ");
fprintf(stderr
, "not enough subscripts for ");
* Evaluate a subscript index.
public int evalindex(s
, i
)
lb
= s
->symvalue
.rangev
.lower
;
ub
= s
->symvalue
.rangev
.upper
;
error("subscript out of range");
* Check to see if a tree is boolean-valued, if not it's an error.
if (p
->nodetype
!= t_boolean
) {
fprintf(stderr
, "found ");
fprintf(stderr
, ", expected boolean expression");
* Check to make sure the given tree has a type of the given class.
private chkclass(p
, class)
if (rtype(p
->nodetype
)->class != class) {
fprintf(stderr
, "\" is not a %s", classname(&tmpsym
));
* 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.
private Symbol
mkstring(str
)
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;
* Free up the space allocated for a string type.
* Figure out the "current" variable or function being referred to,
* this is either the active one or the most visible from the
register Symbol s
, p
, t
, f
;
find(s
, n
) where s
->class != FIELD
and s
->class != TAG
endfind(s
);
error("\"%s\" is not defined", ident(n
));
} else if (s
== program
or isbuiltin(s
)) {
if (not isactive(program)) {
panic("no block for addr 0x%x", pc);
* Now start with curfunc.
t
->block
== p
and t
->class != FIELD
and t
->class != TAG
} while (t
== nil
and p
!= nil
);
* Find the symbol which is 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
)
t
= rtype(record
)->chain
;
while (t
!= nil
and t
->name
!= fieldname
) {