Pexpr check_cond(Pexpr e, TOK b, Ptable tbl)
{
//error('d',"check_cond(%k %k) tbl %d",e->base,b,tbl);
Pname cn;
if (cn = e->tp->is_cl_obj()) {
Pclass cl = (Pclass)cn->tp;
int i = 0;
Pname found = 0;
for (Pname on = cl->conv; on; on=on->n_list) {
Pfct f = (Pfct)on->tp;
Ptype t = f->returns;
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case CHAR:
case SHORT:
case INT:
case LONG:
case EOBJ:
case FLOAT:
case DOUBLE:
case PTR:
i++;
found = on;
}
}
switch (i) {
case 0:
error("%nO in%kE",cn,b);
return e;
case 1:
{
//error('d',"cond%t<-%t:%n",Pfct(found->tp)->returns,e->tp,found);
Pclass cl = (Pclass)cn->tp;
Pref r = new ref(DOT,e,found);
r->tp = found->tp;
Pexpr c = new expr(G_CALL,r,0);
c->fct_name = found;
// c->tp = Pfct(found->tp)->returns;
return c->typ(tbl);
}
default:
error("%d possible conversions for%nO in%kE",i,cn,b);
return e;
}
}
e->tp->num_ptr(b);
return e;
}
void enumdef.dcl(Pname, Ptable tbl)
{
#define FIRST_ENUM 0
int nmem = mem->no_of_names();
Pname p;
Pname ns = 0;
Pname nl;
int enum_old = enum_count;
no_of_enumerators = nmem;
enum_count = FIRST_ENUM;
if (this == 0) error('i',"0->enumdef.dcl(%d)",tbl);
for(p=mem, mem=0; p; p=p->n_list) {
Pname nn;
if (p->n_initializer) {
Pexpr i = p->n_initializer->typ(tbl);
Neval = 0;
enum_count = i->eval();
if (Neval) error("%s",Neval);
DEL(i);
p->n_initializer = 0;
}
p->n_evaluated = 1;
p->n_val = enum_count++;
nn = tbl->insert(p,0); /* ??? */
if (Nold) {
if (nn->n_stclass == ENUM)
error( (p->n_val!=nn->n_val)?0:'w',"enumerator%n declared twice",nn);
else
error("incompatibleDs of%n",nn);
}
else {
nn->n_stclass = ENUM; // no store will be allocated
if (ns)
nl->n_list = nn;
else
ns = nn;
nl = nn;
}
delete p;
}
mem = ns;
enum_count = enum_old;
defined |= DEFINED;
}
void stmt.dcl()
/*
typecheck statement "this" in scope "curr_block->tbl"
*/
{
Pstmt ss;
Pname n;
Pname nn;
Pstmt ostmt = Cstmt;
for (ss=this; ss; ss=ss->s_list) {
Pstmt old_loop, old_switch;
Cstmt = ss;
Ptable tbl = curr_block->memtbl;
/*error('d',"ss %d%k tbl %d e %d%k s %d%k sl %d%k", ss, ss->base, tbl, ss->e, (ss->e)?ss->e->base:0, ss->s, (ss->s)?ss->s->base:0, ss->s_list, (ss->s_list)?ss->s_list->base:0);*/
switch (ss->base) {
case BREAK:
if (curr_loop==0 && curr_switch==0)
error("%k not in loop or switch",BREAK);
ss->reached();
break;
case CONTINUE:
if (curr_loop == 0) error("%k not in loop",CONTINUE);
ss->reached();
break;
case DEFAULT:
if (curr_switch == 0) {
error("default not in switch");
break;
}
if (curr_switch->has_default) error("two defaults in switch");
curr_switch->has_default = ss;
ss->s->s_list = ss->s_list;
ss->s_list = 0;
ss->s->dcl();
break;
case SM:
switch (ss->e->base) {
case DUMMY:
ss->e = 0;
break;
// check for unused results
// don't check operators that are likely
// to be overloaded to represent "actions":
// ! ~ < <= > >= << >>
case EQ:
case NE:
case PLUS:
case MINUS:
case REF:
case DOT:
case MUL:
case DIV:
case ADDROF:
case AND:
case OR:
case ER:
case DEREF:
case ANDAND:
case OROR:
case NAME:
if (ss->e->tp) break; // avoid looking at generated code
ss->e = ss->e->typ(tbl);
if (ss->e->tp->base != VOID) error('w',"result of%kE not used",ss->e->base);
break;
default:
ss->e = ss->e->typ(tbl);
}
// ss->e = (ss->e != dummy) ? ss->e->typ(tbl) : 0;
break;
case RETURN:
{ Pname fn = cc->nof;
Ptype rt = Pfct(fn->tp)->returns;
Pexpr v = ss->e;
if (v != dummy) {
if (rt->base == VOID) {
error('w',"unX return value");
/*refuse to return the value:*/
ss->e = dummy;
}
else {
v = v->typ(tbl);
lx:
//error('d',"return %t",rt);
switch (rt->base) {
case TYPE:
rt = Pbase(rt)->b_name->tp;
goto lx;
case RPTR:
ss->e = ref_init(Pptr(rt),v,tbl);
if (v->lval(0)==0
&& v->tp->tconst()==0)
error('w',"reference to non-lvalue returned");
else if (v->base==NAME
&& Pname(v)->n_scope==FCT)
error('w',"reference to local variable returned");
break;
case COBJ:
{ Pname rv = tbl->look("_result",0);
ss->e = class_init(rv,rt,v,tbl);
//error('d',"ss->e %t %d",ss->e->tp,ss->e->base);
break;
}
case ANY:
break;
case INT:
case CHAR:
case LONG:
case SHORT:
if (Pbase(rt)->b_unsigned
&& v->base==UMINUS
&& v->e2->base==ICON)
error('w',"negative retured fromF returning unsigned");
default:
{ Pname cn;
int i;
if ((cn=v->tp->is_cl_obj())
&& (i=can_coerce(rt,v->tp))
&& Ncoerce) {
if (1 < i) error("%d possible conversions for return value",i);
Pclass cl = (Pclass)cn->tp;
Pref r = new ref(DOT,v,Ncoerce);
Pexpr c = new expr(G_CALL,r,0);
c->fct_name = Ncoerce;
c->tp = rt;
ss->e = c;
break;
}
}
ss->e = v;
if (rt->check(v->tp,ASSIGN))
error("bad return valueT for%n:%t (%tX)",fn,v->tp,rt);
}
}
}
else {
if (rt->base != VOID) error('w',"return valueX");
}
ss->reached();
break;
}
case DO: /* in DO the stmt is before the test */ inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
if (ss->s->base == DCL) error('s',"D as onlyS in do-loop");
ss->s->dcl();
/* tbl = curr_block->memtbl;*/
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,DO,tbl);
curr_loop = old_loop;
break;
case WHILE:
inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
ss->e = ss->e->typ(tbl);
/*ss->e->tp->num_ptr(ss->base);*/
ss->e = check_cond(ss->e,WHILE,tbl);
if (ss->s->base == DCL) error('s',"D as onlyS in while-loop");
ss->s->dcl();
curr_loop = old_loop;
break;
case SWITCH:
{ int ne = 0;
inline_restr |= 4;
old_switch = curr_switch;
curr_switch = ss;
ss->e = ss->e->typ(tbl);
/* ss->e->tp->num_ptr(SWITCH);*/
ss->e = check_cond(ss->e,SWITCH,tbl);
{ Ptype tt = ss->e->tp;
sii:
switch (tt->base) {
case TYPE:
tt = ((Pbase)tt)->b_name->tp; goto sii;
case EOBJ:
ne = Penum(Pbase(tt)->b_name->tp)->no_of_enumerators;
case ZTYPE:
case ANY:
case CHAR:
case SHORT:
case INT:
case LONG:
case FIELD:
break;
default:
error('s',"%t switchE",ss->e->tp);
}
}
ss->s->dcl();
if (ne) { /* see if the number of cases is "close to"
but not equal to the number of enumerators
*/
int i = 0;
Pstmt cs;
for (cs=ss->case_list; cs; cs=cs->case_list) i++;
if (i && i!=ne) {
if (ne < i) {
ee: error('w',"switch (%t) with %d cases (%d enumerators)",ss->e->tp,i,ne);
}
else {
switch (ne-i) {
case 1: if (3<ne) goto ee;
case 2: if (7<ne) goto ee;
case 3: if (23<ne) goto ee;
case 4: if (60<ne) goto ee;
case 5: if (99<ne) goto ee;
}
}
}
}
curr_switch = old_switch;
break;
}
case CASE:
if (curr_switch == 0) {
error("case not in switch");
break;
}
ss->e = ss->e->typ(tbl);
ss->e->tp->num_ptr(CASE);
{ Ptype tt = ss->e->tp;
iii:
switch (tt->base) {
case TYPE:
tt = Pbase(tt)->b_name->tp; goto iii;
case ZTYPE:
case ANY:
case CHAR:
case SHORT:
case INT:
case LONG:
break;
default:
error('s',"%t caseE",ss->e->tp);
}
}
if (1) {
Neval = 0;
int i = ss->e->eval();
if (Neval == 0) {
Pstmt cs;
for (cs=curr_switch->case_list; cs; cs=cs->case_list) {
if (cs->case_value == i) error("case %d used twice in switch",i);
}
ss->case_value = i;
ss->case_list = curr_switch->case_list;
curr_switch->case_list = ss;
}
else
error("bad case label: %s",Neval);
}
if (ss->s->s_list) error('i',"case%k",ss->s->s_list->base);
ss->s->s_list = ss->s_list;
ss->s_list = 0;
ss->s->dcl();
break;
case GOTO:
inline_restr |= 2;
ss->reached();
case LABEL:
/* Insert label in function mem table;
labels have function scope.
*/
n = ss->d;
nn = cc->ftbl->insert(n,LABEL);
/* Set a ptr to the mem table corresponding to the scope
in which the label actually occurred. This allows the
processing of goto's in the presence of ctors and dtors
*/
if(ss->base == LABEL) {
nn->n_realscope = curr_block->memtbl;
inline_restr |= 1;
}
if (Nold) {
if (ss->base == LABEL) {
if (nn->n_initializer) error("twoDs of label%n",n);
nn->n_initializer = (Pexpr)1;
}
if (n != nn) ss->d = nn;
}
else {
if (ss->base == LABEL) nn->n_initializer = (Pexpr)1;
nn->where = ss->where;
}
if (ss->base == GOTO)
nn->use();
else {
if (ss->s->s_list) error('i',"label%k",ss->s->s_list->base);
ss->s->s_list = ss->s_list;
ss->s_list = 0;
nn->assign();
}
if (ss->s) ss->s->dcl();
break;
case IF:
{ Pexpr ee = ss->e->typ(tbl);
if (ee->base == ASSIGN) {
Neval = 0;
(void)ee->e2->eval();
if (Neval == 0)
error('w',"constant assignment in condition");
}
ss->e = ee = check_cond(ee,IF,tbl);
//error('d',"if (%t)",ee->tp);
switch (ee->tp->base) {
case INT:
case ZTYPE:
{ int i;
Neval = 0;
i = ee->eval();
//error('d',"if (int:%k) => (i %s)",ss->e->base,i,Neval?Neval:"0");
if (Neval == 0) {
Pstmt sl = ss->s_list;
if (i) {
DEL(ss->else_stmt);
ss->s->dcl();
*ss = *ss->s;
}
else {
DEL(ss->s);
if (ss->else_stmt) {
ss->else_stmt->dcl();
*ss = *ss->else_stmt;
}
else {
ss->base = SM;
ss->e = dummy;
ss->s = 0;
}
}
ss->s_list = sl;
continue;
}
}
}
ss->s->dcl();
if (ss->else_stmt) ss->else_stmt->dcl();
break;
}
case FOR:
inline_restr |= 8;
old_loop = curr_loop;
curr_loop = ss;
if (ss->for_init) {
Pstmt fi = ss->for_init;
switch (fi->base) {
case SM:
if (fi->e == dummy) {
ss->for_init = 0;
break;
}
default:
fi->dcl();
break;
case DCL:
fi->dcl();
//error('d',"dcl=>%k %d",fi->base,fi->base);
switch (fi->base) {
case BLOCK:
{
/* { ... for( { a } b ; c) d ; e }
=>
{ ... { a for ( ; b ; c) d ; e }}
*/
Pstmt tmp = new stmt (SM,curloc,0);
*tmp = *ss; /* tmp = for */
tmp->for_init = 0;
*ss = *fi; /* ss = { } */
if (ss->s)
ss->s->s_list = tmp;
else
ss->s = tmp;
curr_block = (Pblock)ss;
tbl = curr_block->memtbl;
ss = tmp; /* rest of for and s_list */
break;
}
}
}
}
if (ss->e == dummy)
ss->e = 0;
else {
ss->e = ss->e->typ(tbl);
ss->e = check_cond(ss->e,FOR,tbl);
}
if (ss->s->base == DCL) error('s',"D as onlyS in for-loop");
ss->s->dcl();
ss->e2 = (ss->e2 == dummy) ? 0 : ss->e2->typ(tbl);
curr_loop = old_loop;
break;
case DCL: /* declaration after statement */
{
/* collect all the contiguous DCL nodes from the
head of the s_list. find the next statement
*/
int non_trivial = 0;
int count = 0;
Pname tail = ss->d;
for (Pname nn=tail; nn; nn=nn->n_list) {
// find tail;
// detect non-trivial declarations
count++;
//error('d',"dcl:%n list %d stc %d in %d",nn,nn->n_list,nn->n_sto,nn->n_initializer);
if (nn->n_list) tail = nn->n_list;
Pname n = tbl->look(nn->string,0);
if (n && n->n_table==tbl) non_trivial = 2;
if (non_trivial == 2) continue;
if (nn->n_sto==STATIC || nn->tp->is_ref()) {
non_trivial = 2;
continue;
}
Pexpr in = nn->n_initializer;
if (in)
switch (in->base) {
case ILIST:
case STRING:
non_trivial = 2;
continue;
default:
non_trivial = 1;
}
Pname cln = nn->tp->is_cl_obj();
if (cln == 0) cln = cl_obj_vec;
if (cln == 0) continue;
if (Pclass(cln->tp)->has_dtor()) non_trivial = 2;
if (Pclass(cln->tp)->has_ctor()) non_trivial = 2;
}
//error('d',"non_trivial %d",non_trivial);
while( ss->s_list && ss->s_list->base==DCL ) {
Pstmt sx = ss->s_list;
tail = tail->n_list = sx->d; // add to tail
for (nn=sx->d; nn; nn=nn->n_list) {
// find tail;
// detect non-trivial declarations
count++;
if (nn->n_list) tail = nn->n_list;
Pname n = tbl->look(nn->string,0);
if (n && n->n_table==tbl) non_trivial = 2;
if (non_trivial == 2) continue;
if (nn->n_sto==STATIC || nn->tp->is_ref()) {
non_trivial = 2;
continue;
}
Pexpr in = nn->n_initializer;
if (in)
switch (in->base) {
case ILIST:
case STRING:
non_trivial = 2;
continue;
}
non_trivial = 1;
Pname cln = nn->tp->is_cl_obj();
if (cln == 0) cln = cl_obj_vec;
if (cln == 0) continue;
if (Pclass(cln->tp)->has_ctor()) non_trivial = 2;
if (Pclass(cln->tp)->has_dtor()) non_trivial = 2;
}
ss->s_list = sx->s_list;
/* delete sx; */
}
Pstmt next_st = ss->s_list;
//error('d',"non_trivial %d curr_block->own_tbl %d inline_restr %d",non_trivial,curr_block->own_tbl,inline_restr);
if (non_trivial==2 /* must */
|| (non_trivial==1 /* might */
&& ( curr_block->own_tbl==0 /* just as well */
|| inline_restr&3 /* label seen */)
)
) {
/* Create a new block,
put all the declarations at the head,
and the remainder of the slist as the
statement list of the block.
*/
ss->base = BLOCK;
/* check that there are no redefinitions since the last
"real" (user-written, non-generated) block
*/
for( nn=ss->d; nn; nn=nn->n_list ) {
Pname n;
if( curr_block->own_tbl
&& (n=curr_block->memtbl->look(nn->string,0))
&& n->n_table->real_block==curr_block->memtbl->real_block)
error("twoDs of%n",n);
}
/* attach the remainder of the s_list
as the statement part of the block.
*/
ss->s = next_st;
ss->s_list = 0;
/* create the table in advance, in order to set the
real_block ptr to that of the enclosing table
*/
ss->memtbl = new table(count+4,tbl,0);
ss->memtbl->real_block = curr_block->memtbl->real_block;
Pblock(ss)->dcl(ss->memtbl);
}
else { /* to reduce the number of symbol tables,
do not make a new block,
instead insert names in enclosing block,
and make the initializers into expression
statements.
*/
Pstmt sss = ss;
for( nn=ss->d; nn; nn=nn->n_list ) {
Pname n = nn->dcl(tbl,FCT);
//error('d',"%n->dcl(%d) -> %d init %d sss=%d ss=%d",nn,tbl,n,n->n_initializer,sss,ss);
if (n == 0) continue;
Pexpr in = n->n_initializer;
n->n_initializer = 0;
if (ss) {
sss->base = SM;
ss = 0;
}
else
sss = sss->s_list = new estmt(SM,sss->where,0,0);
if (in) {
switch (in->base) {
case G_CALL: /* constructor? */
{
Pname fn = in->fct_name;
if (fn && fn->n_oper==CTOR) break;
}
default:
in = new expr(ASSIGN,n,in);
}
sss->e = in->typ(tbl);
}
else
sss->e = dummy;
}
ss = sss;
ss->s_list = next_st;
}
break;
}
case BLOCK:
Pblock(ss)->dcl(tbl);
break;
case ASM:
/* save string */
break;
default:
error('i',"badS(%d %d)",ss,ss->base);
}
}
Cstmt = ostmt;
}
void type::dcl(Ptable tbl)
/*
go through the type (list) and
(1) evaluate vector dimensions
(2) evaluate field sizes
(3) lookup struct tags, etc.
(4) handle implicit tag declarations
*/
{
Ptype t = this;
// processing_sizeof suppresses errors for refs to names in the arg
// to sizeof. Turn errors back on for exprs within type specs
// (such as array subscripts)
int os = processing_sizeof;
processing_sizeof = 0;
if (this == 0)
error('i',"T::dcl(this==0)");
if (tbl->base != TABLE)
error('i',"T::dcl(%d)",tbl->base);
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case PTR:
case RPTR:
{
Pptr p = Pptr(t);
if(p->memof == 0 && p->ptname) { // T::*, where T is a template formal
Ptype tp = p->ptname->tp->skiptypedefs();
switch (tp->base) {
case COBJ:
{
p->memof = tp->classtype();
if (p->typ)
{
Ptype t = p->typ->skiptypedefs();
if (t && t->base==FCT)
{
Pfct(t)->memof = p->memof;
}
}
break;
}
case CLASS:
{
p->memof = Pclass(tp);
Ptype t = p->typ->skiptypedefs();
Pfct f = Pfct(t); // safe???
f->memof = p->memof;
break;
}
default:
error("illegalZizedP toM %t::*",tp);
break;
}
}
t = p->typ;
if (t->base == TYPE) {
Ptype tt = Pbase(t)->b_name->tp;
if (tt->base == FCT)
p->typ = tt;
goto done;
}
goto xx;
}
case VEC:
{
Pvec v = Pvec(t);
Pexpr e = v->dim;
if (e) {
Ptype et;
v->dim = e = e->typ(tbl);
if (e->tp->skiptypedefs()->base == COBJ) {
e = check_cond(e,DEREF,tbl);
v->dim = e;
}
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in array dimension");
}
else {
long long i;
Neval = 0;
i = e->eval();
if (Neval == 0) {
if (largest_int<i)
error("array dimension too large");
v->size = int(i);
DEL(v->dim);
v->dim = 0;
}
if (new_type) {
if (Neval)
;
else if (i == 0)
v->dim = zero;
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
else {
if (Neval)
error("%s",Neval);
else if (i == 0) {
error("array dimension == 0");
v->dim=e;
}
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
}
}
t = v->typ;
llx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto llx;
case FCT:
v->typ = t;
break;
case VEC:
if (Pvec(t)->dim==0 && Pvec(t)->size==0)
error("null dimension (something like [][] seen)");
}
goto xx;
}
case FCT:
{
Pfct f = Pfct(t);
void dargs(Pname, Pfct, Ptable);
if (f->argtype)
dargs(0,f,tbl);
for (Pname n=f->argtype; n; n = n->n_list) {
Ptype t = n->tp;
n->tp->dcl(tbl);
while(t->base==TYPE)
t = Pbase(t)->b_name->tp;
if(t->base==VEC)
n->tp = new ptr(PTR,Pvec(t)->typ);
}
Pname cn = f->returns->is_cl_obj();
if (cn && Pclass(cn->tp)->has_itor())
make_res(f);
else if (f->f_this == 0)
f->f_args = f->argtype;
t = f->returns;
goto xx;
}
case FIELD:
{
Pbase f = Pbase(t);
Pexpr e = Pexpr(f->b_name);
long long i;
Ptype et;
e = e->typ(tbl);
f->b_name = Pname(e);
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in field size");
i = 1;
}
else {
Neval = 0;
i = e->eval();
if (Neval)
error("%s",Neval);
else if (i < 0) {
error("negative field size");
i = 1;
}
else if (f->b_fieldtype->tsizeof()*BI_IN_BYTE < i)
error("field size > sizeof(%t)",f->b_fieldtype);
DEL(e);
}
f->b_bits = int(i);
f->b_name = 0;
break;
}
}
done:
processing_sizeof = os;
return;
}
