* Copyright (c) 1980 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
static char sccsid
[] = "@(#)tree.c 5.1 (Berkeley) %G%";
* This module contains the interface between the SYM routines and
* the parse tree routines. It would be nice if such a crude
* interface were not necessary, but some parts of tree building are
* language and hence SYM-representation dependent. It's probably
* better to have tree-representation dependent code here than vice versa.
#define nextarg(arglist, type) ((type *) (arglist += sizeof(type)))[-1]
* Determine the type of a parse tree. While we're at, check
p
->nameval
= nextarg(ap
, SYM
*);
p
->nameval
= which(p
->nameval
);
cpy
= strdup(p
->sconval
);
s
= mkstring(p
->sconval
);
p
->lconval
= p
->sconval
[0];
p
->left
= nextarg(ap
, NODE
*);
return rtype(p
->left
->nodetype
)->type
;
p
->nodetype
= p1
->nodetype
;
if (p1
->nodetype
->class == FUNC
) {
} else if (p1
->nameval
->class == CONST
) {
if (p1
->nameval
->type
== t_real
->type
) {
p
->fconval
= p1
->nameval
->symvalue
.fconval
;
p
->lconval
= p1
->nameval
->symvalue
.iconval
;
p
->nodetype
= p1
->nameval
->type
;
p
->left
= nextarg(ap
, NODE
*);
p
->right
= nextarg(ap
, NODE
*);
if (isblock(s
) && isbuiltin(s
)) {
p
->op
= (OP
) s
->symvalue
.token
.tokval
;
p
->left
= nextarg(ap
, NODE
*);
if (!compatible(s
, t_int
)) {
if (!compatible(s
, t_real
)) {
trerror("%t is improper type", p
->left
);
p
->left
= nextarg(ap
, NODE
*);
p
->right
= nextarg(ap
, NODE
*);
t1
= rtype(p
->left
->nodetype
);
t2
= rtype(p
->right
->nodetype
);
p
->left
= build(O_ITOF
, p
->left
);
p
->right
= build(O_ITOF
, p
->right
);
convert(&p
->left
, t_int
, O_NOP
);
convert(&p
->right
, t_int
, O_NOP
);
p
->left
= nextarg(ap
, NODE
*);
p
->right
= nextarg(ap
, NODE
*);
convert(&p
->left
, t_real
, O_ITOF
);
convert(&p
->right
, t_real
, O_ITOF
);
p
->left
= nextarg(ap
, NODE
*);
p
->right
= nextarg(ap
, NODE
*);
convert(&p
->left
, t_int
, O_NOP
);
convert(&p
->right
, t_int
, O_NOP
);
p
->left
= nextarg(ap
, NODE
*);
p
->right
= nextarg(ap
, NODE
*);
* Create a node for a name. The symbol for the name has already
* been chosen, either implicitly with "which" or explicitly from
LOCAL SYM
*namenode(p
, s
)
if (s
->class == CONST
|| s
->class == VAR
|| 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.
LOCAL
convert(tp
, typeto
, op
)
s
= rtype(tree
->nodetype
);
if (typeto
== t_real
&& compatible(s
, t_int
)) {
} else if (!compatible(s
, typeto
)) {
trerror("%t is improper type");
} else if (op
!= O_NOP
&& s
!= typeto
) {
* Construct a node for the Pascal 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.
if (isblock(record
->nodetype
)) {
s
= findsym(field
, record
->nodetype
);
error("\"%s\" is not defined in \"%s\"",
field
->symbol
, record
->nodetype
->symbol
);
p
->nodetype
= namenode(p
, s
);
s
= findclass(field
, FIELD
);
error("\"%s\" is not a field", field
->symbol
);
p
->nodetype
= field
->type
;
p
->right
= build(O_LCON
, (long) field
->symvalue
.offset
);
* Return a tree corresponding to an array reference and do the
NODE
*subscript(a
, slist
)
SYM
*etype
, *atype
, *eltype
;
trerror("%t is not an array", a
);
for (; p
!= NIL
&& t
!= NIL
; p
= p
->right
, t
= t
->chain
) {
etype
= rtype(esub
->nodetype
);
if (!compatible(atype
, etype
)) {
trerror("subscript %t is the wrong type", esub
);
trerror("too many subscripts for %t", a
);
trerror("not enough subscripts for %t", a
);
* Evaluate a subscript (possibly more than one index).
long evalindex(arraytype
, subs
)
panic("unexpected class %d in evalindex", t
->class);
panic("unexpected end of subscript list in evalindex");
lb
= indextype
->symvalue
.rangev
.lower
;
ub
= indextype
->symvalue
.rangev
.upper
;
index
= popsmall(p
->left
->nodetype
);
if (index
< lb
|| index
> ub
) {
error("subscript value %d out of range %d..%d", index
, lb
, ub
);
i
= (ub
-lb
+1)*i
+ (index
-lb
);
* Check that a record.field usage is proper.
* Don't do this for compiled code.
for (s
= r
->nodetype
->chain
; s
!= NIL
; s
= s
->chain
) {
error("\"%s\" is not a field in specified record", f
->symbol
);
* Check to see if a tree is boolean-valued, if not it's an error.
if (p
->nodetype
!= t_boolean
) {
trerror("found %t, expected boolean expression");
* Check to make sure the given tree has a type of the given class.
if (p
->nodetype
->class != class) {
trerror("%t is not a %s", p
, 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.
if (q
[0] != '\'' || q
[1] != '\'') {
s
->chain
= alloc(1, SYM
);
t
->symvalue
.rangev
.lower
= 1;
t
->symvalue
.rangev
.upper
= p
- str
+ 1;
* Free up the space allocated for a string type.