node totype(node e){
/* e is a type expression, return a unique TYPE */
node f=NULL;
if (e == NULL) return NULL;
if (e->tag == type_tag) return typeforward(e);
if (e->tag == position_tag) e = e->body.position.contents;
if (issym(e)) {
node t = type(e);
if (t == NULL) return NULL;
assert(t == type__T);
return typeforward(e->body.symbol.value);
}
ExpandType(e,&f);
totypesRec(f);
return typeforward(car(f));
/* a bit expensive */
/* later, write a simple search through */
/* existing types (the definition here is */
/* not recursive) */
}
node ExpandType(node t, node *f) {
/* t should be a type expression that might need expanding. Its expanded
form gets returned, and also put on the top of the list f
unless it's already a type or basic type */
switch(t->tag) {
case position_tag: return ExpandType(t->body.position.contents,f);
case type_tag: return t;
case symbol_tag: {
if (t->body.symbol.type == type__T) {
assert(istype(t->body.symbol.value));
return t->body.symbol.value;
}
if (t == bad__K) return bad_or_undefined_T;
assert(FALSE); return NULL;
}
case cons_tag: {
node fun = CAR(t);
if (ispos(fun)) fun = fun->body.position.contents;
t = CDR(t);
if (fun == or_K) {
/* here we should sort! */
/* we should also merge sub-or's in, and eliminate
duplicates */
/* we really only handle (or null (object)) now! */
node newN = NULL;
node mems = NULL;
while (t != NULL) {
node u = ExpandType(CAR(t),f);
push(mems,u);
t = CDR(t);
}
apply(reverse,mems);
newN = newtype(cons(fun,mems),NULL,FALSE);
push(*f,newN);
return newN;
}
else if (fun == object__K || fun == tagged_object_K /* ? */ ) {
node newN = NULL;
while (t != NULL) {
node name = CAAR(t);
node u = CADAR(t);
push(newN, list(2, unpos(name), ExpandType(u,f)));
t = CDR(t);
}
apply(reverse,newN);
newN = newtype(cons(fun,newN),NULL,FALSE);
push(*f,newN);
return newN;
}
else if (fun == array_K || fun == tarray_K) {
node newN;
newN = cons(fun,cons(ExpandType(car(t),f),cdr(t)));
newN = newtype(newN,NULL,FALSE);
*f = cons(newN,*f);
return newN;
}
else if (fun == function_S) {
node argtypes = car(t);
node rettype = cadr(t);
node newargtypes = NULL;
node newN;
while (argtypes != NULL) {
newargtypes = cons(
ExpandType(car(argtypes),f), newargtypes);
argtypes = cdr(argtypes);
}
newargtypes = reverse(newargtypes);
rettype = ExpandType(rettype,f);
newN = list(3,fun,newargtypes,rettype);
newN = newtype(newN,NULL,FALSE);
*f = cons(newN,*f);
return newN;
}
else assert(FALSE); return NULL;
}
default: assert(FALSE); return NULL;
}
}
/*
* initialise global object
*/
int initials(char *sname,
int type, int ident, int dim, int more,
TAG_SYMBOL * tag, char zfar)
{
int size, desize = 0;
int olddim = dim;
if (cmatch('=')) {
/* initialiser present */
defstatic = 1; /* So no 2nd redefine djm */
gltptr = 0;
glblab = getlabel();
if (dim == 0)
dim = -1;
switch (type) {
case CCHAR:
size = 1;
break;
case LONG:
size = 4;
break;
case CINT:
default:
size = 2;
}
output_section("data_compiler"); // output_section("text");
prefix();
outname(sname, YES);
col();
nl();
if (cmatch('{')) {
/* aggregate initialiser */
if ((ident == POINTER || ident == VARIABLE) && type == STRUCT) {
/* aggregate is structure or pointer to structure */
dim = 0; olddim = 1;
if (ident == POINTER)
point();
str_init(tag);
} else {
/* aggregate is not struct or struct pointer */
agg_init(size, type, ident, &dim, more, tag);
}
needchar('}');
} else {
/* single initialiser */
init(size, ident, &dim, more, 0, 0);
}
/* dump literal queue and fill tail of array with zeros */
if ((ident == ARRAY && more == CCHAR) || type == STRUCT) {
if (type == STRUCT) {
dumpzero(tag->size, dim);
desize = dim < 0 ? abs(dim+1)*tag->size : olddim * tag->size;
} else { /* Handles unsized arrays of chars */
dumpzero(size, dim);
dim = dim < 0 ? abs(dim+1) : olddim;
cscale(type,tag,&dim);
desize = dim;
}
dumplits(0, YES, gltptr, glblab, glbq);
} else {
if (!(ident == POINTER && type == CCHAR)) {
dumplits(((size == 1) ? 0 : size), NO, gltptr, glblab,glbq);
if ( type != CCHAR ) /* Already dumped by init? */
desize = dumpzero(size, dim);
dim = dim < 0 ? abs(dim+1) : olddim;
cscale(type,tag,&dim);
desize = dim;
}
}
output_section("code_compiler"); // output_section("code");
} else {
char *dosign, *typ;
dosign = "";
if (ident == ARRAY && (dim == 0)) {
typ = ExpandType(more, &dosign, (tag - tagtab));
warning(W_NULLARRAY, dosign, typ);
}
/* no initialiser present, let loader insert zero */
if (ident == POINTER)
type = (zfar ? CPTR : CINT);
cscale(type, tag, &dim);
desize = dim;
}
return (desize);
}
