Pname gen.find(Pfct f)
{
Plist gl;
for (gl=fct_list; gl; gl=gl->l) {
Pname nx = gl->f;
Pfct fx = (Pfct)nx->tp;
Pname a, ax;
int vp = 0;
//error('d',"find %s",nx->string);
if (fx->nargs_known != f->nargs_known) {
if (fx->nargs && fx->nargs_known!=ELLIPSIS) continue;
}
for (ax=fx->argtype, a=f->argtype; a&&ax; ax=ax->n_list, a=a->n_list) {
//error('d',"ax %d %d a %d %d",ax->tp,ax->tp->base,a->tp,a->tp->base);
Ptype at = ax->tp;
if ( at->check(a->tp,0)) goto xx;
if ( vrp_equiv ) vp = 1;
switch (at->base) {
case CHAR:
case SHORT:
case INT:
case LONG:
if (Pbase(at)->b_unsigned ^ Pbase(a->tp)->b_unsigned) error('w',"the overloading mechanism cannot tell an unsigned%k from a%k",at->base,at->base);
}
}
if (ax) {
if (ax->n_initializer)
error("Ir makes overloaded %s() ambiguous",string);
continue;
}
if (a) {
if (a->n_initializer)
error("Ir makes overloaded %s() ambiguous",string);
continue;
}
if ( fx->returns->check(f->returns,0) )
error("two different return valueTs for overloaded %s: %t and %t", string, fx->returns, f->returns);
if (vp) error('w',"ATs differ (only): [] vs *");
return nx;
xx:;
}
return 0;
}
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 list_check(Pname nn, Ptype t, Pexpr il)
/*
see if the list "lll" can be assigned to something of type "t"
"nn" is the name of the variable for which the assignment is taking place.
"il" is the last list element returned by next_elem()
*/
{
Pexpr e;
bit lst = 0;
int i;
Pclass cl;
//error('d',"list_check%n: %t (%d)",nn,t,il);
switch ( (int)il ) {
case 0: break;
case 1: lst = 1; break;
default: list_put_back(il);
}
zzz:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto zzz;
case VEC:
{ Pvec v = (Pvec)t;
Ptype vt = v->typ;
if (v->size) { /* get at most v->size initializers */
if (v->typ->base == CHAR) {
e = next_elem();
if (e->base == STRING) { // v[size] = "..."
int isz = Pvec(e->tp)->size;
if (v->size < isz) error("Ir too long (%d characters) for%n[%d]",isz,nn,v->size);
break;
}
else
list_put_back(e);
}
for (i=0; i<v->size; i++) { // check next list element type
ee:
e = next_elem();
if (e == 0) goto xsw; // too few initializers are ok
vtz:
//error('d',"vtz: %d",vt->base);
switch (vt->base) {
case TYPE:
vt = Pbase(vt)->b_name->tp;
goto vtz;
case VEC:
case COBJ:
list_check(nn,vt,e);
break;
default:
if (e == (Pexpr)1) {
error("unXIrL");
goto ee;
}
if (vt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
}
}
if ( lst && (e=next_elem()) ) error("end ofIrLX after vector");
xsw:;
}
else { /* determine v->size */
i = 0;
xx:
while ( e=next_elem() ) { // get another initializer
i++;
vtzz:
//error('d',"vtzz: %d",vt->base);
switch (vt->base) {
case TYPE:
vt = Pbase(vt)->b_name->tp;
goto vtzz;
case VEC:
case COBJ:
list_check(nn,vt,e);
break;
default:
if (e == (Pexpr)1) {
error("unXIrL");
goto xx;
}
if (vt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
}
}
v->size = i;
}
break;
}
case CLASS:
cl = (Pclass)t;
goto ccc;
case COBJ: /* initialize members */
cl = Pclass(Pbase(t)->b_name->tp);
ccc:
{ Ptable tbl = cl->memtbl;
Pname m;
if (cl->clbase) list_check(nn,cl->clbase->tp,0);
for (m=tbl->get_mem(i=1); m; m=tbl->get_mem(++i)) {
Ptype mt = m->tp;
switch (mt->base) {
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
continue;
}
if (m->n_stclass == STATIC) continue;
/* check assignment to next member */
dd:
e = next_elem();
if (e == 0) return; //break;
mtz:
//error('d',"mtz%n: %d",m,mt->base);
switch (mt->base) {
case TYPE:
mt = Pbase(mt)->b_name->tp;
goto mtz;
case CLASS:
case ENUM:
break;
case VEC:
case COBJ:
list_check(nn,m->tp,e);
break;
default:
if (e == (Pexpr)1) {
error("unXIrL");
goto dd;
}
if (mt->check(e->tp,ASSIGN))
error("badIrT for%n:%t (%tX)",m,e->tp,m->tp);
}
}
if (lst && (e=next_elem()) ) error("end ofIrLX afterCO");
break;
}
default:
e = next_elem();
if (e == 0) {
error("noIr forO");
break;
}
if (e == (Pexpr)1) {
error("unXIrL");
break;
}
if (t->check(e->tp,ASSIGN)) error("badIrT for%n:%t (%tX)",nn,e->tp,t);
if (lst && (e=next_elem()) ) error("end ofIrLX afterO");
break;
}
}
bit type::check(Ptype t, TOK oper, bit level)
/*
check if "this" can be combined with "t" by the operator "oper"
used for check of
assignment types (oper==ASSIGN)
declaration compatability (oper==0)
decl. compatibility without "const"ness (oper=254)
(oper == IGNORE_CONST)
parameterized type formals (oper==255)
as for (oper==0) but
special checking for ANY types
argument types (oper==ARG)
return types (oper==RETURN)
overloaded function name match (oper==OVERLOAD)
overloaded function coercion (oper==COERCE)
virtual function match (oper==VIRTUAL)
NOT for arithmetic operators
return 1 if the check failed
*/
{
register Ptype t1 = this, t2 = t;
bit cnst1 = 0, cnst2 = 0;
TOK b1, b2;
bit vv=0, over=0, strict_any_check = 0;
TOK rec_oper; // value of oper for recursive calls to type::check
// oper, 255, or PT_OVERLOAD
TOK rec_oper0; // value of oper for recursive calls to type::check
// 0, 255, or PT_OVERLOAD
if (t1==0 || t2==0)
error('i',"check(%p,%p,%d)",t1,t2,oper);
if(t1==t2)
return 0;
switch(oper) {
case VIRTUAL:
vv = 1;
Vcheckerror = 0;
oper = 0;
break;
case OVERLOAD:
over = 1;
oper = 0;
break;
case PT_OVERLOAD:
over = 1;
// no break
case 255:
oper = 0;
strict_any_check=1;
break;
}
if(level==0) {
const_problem = 0;
return_error = 0;
pt_ptm = 0;
pt_over = over;
}
rec_oper = strict_any_check ? ( over ? PT_OVERLOAD : 255 ) : oper;
rec_oper0 = strict_any_check ? ( over ? PT_OVERLOAD : 255 ) : 0;
t1 = t1->skiptypedefs(cnst1);
/*
** GLOG: the following test on ANY must be done before unrolling
** t2, to accommodate templates (in a way I don't yet understand)
*/
if (t1->base == ANY || t2->base == ANY)
if (over==0 || strict_any_check==0)
return strict_any_check ? t1!=t2 : 0;
t2 = t2->skiptypedefs(cnst2);
if(t1==t2)
goto const_check;
b1 = t1->base;
b2 = t2->base;
if (b1 != b2) {
switch (b1) {
case PTR:
switch (b2) {
case VEC:
if (
level>0
||
(oper == 0 || oper == IGNORE_CONST)
&&
over==0
||
Pptr(t1)->memof
||
Pptr(t1)->ptname
||
Pptr(t1)->typ->check(Pvec(t2)->typ,rec_oper,level+1)
)
return 1;
goto const_check;
case FCT:
if (
level>0
||
Pptr(t1)->typ->check(t2,rec_oper,level+1)
)
return 1;
goto const_check;
}
break;
case FCT:
if( b2==PTR ) {
if (
level>0
||
t1->check(Pptr(t2)->typ,rec_oper,level+1)
)
return 1;
goto const_check;
}
break;
case VEC:
if (b2==PTR) {
if (
level>0
||
(oper==0 || oper == IGNORE_CONST)
&&
over==0
||
Pptr(t2)->memof
||
Pptr(t2)->ptname
||
Pvec(t1)->typ->check(Pptr(t2)->typ,rec_oper,level+1)
)
return 1;
goto const_check;
}
break;
}
if(level>0) {
if((oper != 0 && oper != IGNORE_CONST) && b1==VOID && level==1) {
if(b2==FCT) {
Pfct f = Pfct(t2);
if(f->memof && f->f_static==0)
return 1;
}
goto const_check;
}
return 1;
}
switch (oper) {
case 0:
case IGNORE_CONST:
if (
b2 == ZTYPE && b1==INT && Pbase(t1)->b_unsigned==0
||
b1 == ZTYPE && b2==INT && Pbase(t2)->b_unsigned==0
)
goto const_check;
return 1;
case ARG:
case ASSIGN:
case RETURN:
case COERCE:
switch (b1) {
case ZTYPE:
case CHAR:
case SHORT:
case INT:
case LONG:
case LLONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
case FIELD:
switch (b2) {
case LONG:
case LLONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
case EOBJ:
case ZTYPE:
case CHAR:
case SHORT:
case INT:
case FIELD:
if(oper==COERCE)
Nstd++;
goto const_check;
}
return 1;
case PTR:
case VEC:
if (b2==ZTYPE) {
if(oper==COERCE)
Nstd++;
goto const_check;
}
case RPTR:
case COBJ:
case FCT:
case EOBJ:
default:
return 1;
}
}
goto const_check;
}
switch (b1) {
case VEC:
if (
Pvec(t1)->size!=Pvec(t2)->size
&&
(
level>0
||
(oper==0 || oper==IGNORE_CONST)
&&
strict_any_check==0
&&
Pvec(t1)->size
&&
Pvec(t2)->size
)
)
return 1;
if(Pvec(t1)->typ->check(Pvec(t2)->typ,rec_oper,level+1))
return 1;
break;
case PTR:
case RPTR:
{
Pptr p1 = Pptr(t1);
Pptr p2 = Pptr(t2);
if ((p1->ptname && p2->ptname) && (!p1->memof || !p2->memof))
return 1;
if (!same_class(p1->memof,p2->memof)) {
// T::* requires we defer setting up memof
// until instantiation of the Template type T
// ptname holds the formal parameter T
// can't merge with other if because of memof usage
if(
p1->memof==0 && p1->ptname
||
p2->memof==0 && p2->ptname
)
pt_ptm = 1;
else
if(
p1->memof==0
||
p2->memof==0
||
(p1->memof->baseof(p2->memof)==0 &&
same_class(p1->memof,p2->memof,1)==0)
)
return 1;
if (pt_ptm == 0 && (oper==0 || oper==IGNORE_CONST) &&
same_class(p1->memof,p2->memof)==0)
return 1;
if(oper==COERCE)
Nstd++;
}
#if 0
if (!level && (oper == 0 || oper == ASSIGN || oper == COERCE ||
oper == ARG || oper == RETURN)) {
Ptype t11;
Ptype t22;
Ptype ta;
Ptype tb;
int i = 0;
int j = 0;
int k = 0;
ta = t1;
while ((ta->base == PTR || ta->base == RPTR) &&
(tb = ta->is_ptr_or_ref())) {
ta = Pptr(tb)->typ;
i++;
k += ta->tconst();
}
t11 = ta;
ta = t2;
while ((ta->base == PTR || ta->base == RPTR) &&
(tb = ta->is_ptr_or_ref())) {
ta = Pptr(tb)->typ;
j++;
}
t22 = ta;
if (i >= 2 && j == i && t11->tconst() &&
!t22->tconst() && k != i)
return const_problem = 1;
}
#endif
if(p1->typ->check(p2->typ,rec_oper,level+1))
return 1;
break;
}
case FCT:
{
Pfct f1 = Pfct(t1);
Pfct f2 = Pfct(t2);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
TOK k1 = f1->nargs_known;
TOK k2 = f2->nargs_known;
int n1 = f1->nargs;
int n2 = f2->nargs;
// if pt_ptm, want to check arguments and return type
// but template ptm has no memof until instantiation
if (!same_class(f1->memof,f2->memof) && pt_ptm == 0) {
if (f1->memof==0 && f2->f_static)
goto sss;
if (vv == 0) // match even if private base class
if (
f1->memof==0
||
f2->memof==0
||
(
level > 1
||
f1->memof->baseof(f2->memof)==0
)
&&
same_class(f1->memof,f2->memof)==0
)
return 1;
if(oper==COERCE)
Nstd++;
sss:; //SSS
}
if (k1 != k2)
return 1;
if (n1!=n2 && k1 && k2) {
goto aaa;
}
else if (a1 && a2) {
while (a1 && a2) {
if (a1->tp->check(a2->tp,rec_oper0,level+1))
return 1;
a1 = a1->n_list;
a2 = a2->n_list;
}
if (a1 || a2)
goto aaa;
}
else if (a1 || a2) {
aaa:
if (k1 == ELLIPSIS) {
switch (oper) {
case 0:
case IGNORE_CONST:
if (a2 && k2==0)
break;
return 1;
case ASSIGN:
if (a2 && k2==0)
break;
return 1;
case ARG:
if (a1)
return 1;
break;
case COERCE:
return 1;
}
}
else if (k2 == ELLIPSIS) {
return 1;
}
else if (k1 || k2) {
return 1;
}
}
cnst1 = f2->f_const;
cnst2 = f1->f_const;
if(f1->returns->check(f2->returns,rec_oper0,level+1)) {
if(vv && cnst1==cnst2) {
bit fail = 1;
Ptype t1 = f1->returns;
Ptype t2 = f2->returns;
if ((t1->is_ptr() && t2->is_ptr()) ||
(t1->is_ref() && t2->is_ref())) {
t1 = Pptr(t1->is_ptr_or_ref())->typ;
t2 = Pptr(t2->is_ptr_or_ref())->typ;
if (!t1->is_ptr_or_ref() &&
!t2->is_ptr_or_ref()) {
t1 = t1->skiptypedefs();
t2 = t2->skiptypedefs();
if (t1->base == COBJ &&
t2->base == COBJ) {
Pclass c1 = t1->classtype();
Pclass c2 = t2->classtype();
Nvis = 0;
if (c2->has_base(c1,0,1) && !Nvis)
fail = 0;
}
}
}
if (fail)
Vcheckerror = 1;
else
break;
}
if (rec_oper0 == PT_OVERLOAD && level == 0)
return_error = 1;
return 1;
}
break;
}
case FIELD:
switch (oper) {
case 0:
case IGNORE_CONST:
case ARG:
error('i',"check field?");
}
return 0;
case FLOAT:
case DOUBLE:
case LDOUBLE:
case CHAR:
case SHORT:
case INT:
case LONG:
case LLONG:
if (Pbase(t1)->b_unsigned != Pbase(t2)->b_unsigned) {
if (level>0 || (oper==0 || oper==IGNORE_CONST))
return 1;
if (oper==COERCE)
Nstd++;
}
goto const_check;
case EOBJ:
if (Pbase(t1)->b_name->tp != Pbase(t2)->b_name->tp)
return 1;
goto const_check;
case CLASS:
case COBJ:
{
Pname n1, n2;
if (b1 == COBJ) {
n1 = Pbase(t1)->b_name;
n2 = Pbase(t2)->b_name;
if (n1 == n2)
goto const_check;
}
// once again, a more comprehensive check for classes,
// since they may be parameterized.
// same_class: handles class templates: instantiated
// fm_same_class: handles matching uninstantiated templates
// used as formal arguments for template functions
// hack: see comment on classdef::same_class in template.c
extern int is_arg;
int access = template_hier || pt_over;
if (
same_class(Pclass(b1==COBJ?n1->tp:t1),Pclass(b1==COBJ?n2->tp:t2),access||is_arg)
||
rec_oper==PT_OVERLOAD
&&
fm_same_class(Pclass(b1==COBJ?n1->tp:t1),Pclass(b1==COBJ?n2->tp:t2))
)
goto const_check;
// permit a derived class to match public base class
if (template_hier != 0)
goto pt_hack;
switch (oper) {
case ARG:
case ASSIGN:
case RETURN:
case COERCE:
{
pt_hack:
ppbase = PUBLIC;
if (level<=1 && ((Pclass(b1==COBJ?n2->tp:t2))->is_base(b1==COBJ?n1->string:Pclass(t1)->string))) {
if (ppbase!=PUBLIC) {
const_problem = 0;
return 1; // private or protected base
}
if(oper==COERCE)
Nstd++;
goto const_check;
}
}
// no break
case 0:
case IGNORE_CONST:
const_problem = 0;
return 1;
}
goto const_check;
}
case ZTYPE:
case VOID:
goto const_check;
default:
error('i',"T::check(o=%d %d %d)",oper,b1,b2);
}
const_check:
if(cnst1==cnst2)
return 0;
switch(oper) {
case IGNORE_CONST:
return 0;//ignore "const"ness for oper=IGNORE_CONST
case 0:
const_problem=1;
return 1;
case ASSIGN:
case COERCE:
case ARG:
case RETURN:
if(level>0) {
if(cnst2)
const_problem=1;
return cnst2;
}
return 0;
default:
error('i',"oper = %k in type::check()",oper);
}
return 0;
}
Ptype np_promote(TOK oper, TOK r1, TOK r2, Ptype t1, Ptype t2, TOK p, bit perr)
/*
an arithmetic operator "oper" is applied to "t1" and "t2",
types t1 and t2 has been checked and belongs to catagories
"r1" and "r2", respectively:
A ANY
Z ZERO
I CHAR, SHORT, INT, LONG, LLONG, FIELD, or EOBJ
F FLOAT DOUBLE LDOUBLE
P PTR (to something) or VEC (of something)
test for compatability of the operands,
if (p) return the promoted result type
*/
{
if (r2 == 'A')
return t1;
switch (r1) {
case 'A':
return t2;
case 'Z':
switch (oper) {
case ASMOD:
case ASAND:
case ASOR:
case ASLS:
case ASRS:
case ASPLUS:
case ASMINUS:
return any_type;
}
switch (r2) {
case 'Z': return int_type;
case 'F':
switch (oper) {
case MOD:
case AND:
case ER:
case OR:
case LS:
case RS:
return any_type;
}
// no break
case 'I':
switch (oper) {
case DEREF:
return any_type;
case LS: // result type is that of promoted left op
case RS:
return int_type;
}
return (p)
?
Pbase(t2->skiptypedefs())->arit_conv(0)
:
0;
case 'P':
switch (oper) {
case MOD:
case AND:
case ER:
case OR:
case LS:
case RS:
case GE:
case GT:
case LE:
case LT:
return any_type;
case PLUS:
case ASPLUS:
if(t2!=Pvoid_type)
break;
case EQ:
case NE:
case QUEST:
break;
default:
return any_type;
}
return t2;
case FCT:
switch (oper) {
case QUEST:
return any_type;
case EQ:
case NE:
return t2;
}
if(perr) error("zero%kF",oper);
return any_type;
default:
error('i',"zero(%d)",r2);
}
case 'I':
switch (r2) {
case 'Z':
t2 = 0;
switch (oper) {
case DEREF:
return any_type;
}
return (p)
?
Pbase(t1->skiptypedefs())->arit_conv(Pbase(t2))
:
0;
case 'F':
switch (oper) {
case MOD:
case AND:
case ER:
case OR:
case LS:
case RS:
case ASMOD:
case ASAND:
case ASOR:
case ASLS:
case ASRS:
return any_type;
}
// no break;
case 'I':
switch (oper) {
case DEREF:
return any_type;
case LS: // result type is that of promoted left op
case RS:
return (p)
?
Pbase(t1->skiptypedefs())->arit_conv(Pbase(0))
:
0;
}
return (p)
?
Pbase(t1->skiptypedefs())->arit_conv(Pbase(t2))
:
0;
case 'P':
switch (oper) {
case DEREF:
break;
case PLUS:
case ASPLUS:
if(t2!=Pvoid_type)
break;
default:
if(perr) error("int%kP",oper);
return any_type;
}
return t2;
case FCT:
if(perr) error("int%kF",oper);
return any_type;
default:
error('i',"int(%d)",r2);
return any_type;
}
case 'F':
switch (oper) {
case MOD:
case ASMOD:
case AND:
case ER:
case OR:
case ASAND:
case ASOR:
case LS:
case RS:
case ASLS:
case ASRS:
return any_type;
}
switch (r2) {
case 'Z':
t2 = 0;
case 'I':
case 'F':
if(oper==DEREF)
return any_type;
return (p)
?
Pbase(t1->skiptypedefs())->arit_conv(Pbase(t2))
:
0;
case 'P':
if(perr) error("float%kP",oper);
return any_type;
case FCT:
if(perr) error("float%kF",oper);
return any_type;
default:
error('i',"float(%d)",r2);
return any_type;
}
case 'P':
switch(oper) {
case LS:
case RS:
case ASLS:
case ASRS:
case MOD:
case ASMOD:
case ER:
case OR:
case ASOR:
case AND:
case ASAND:
case DIV:
case MUL:
return any_type;
}
switch (r2) {
case 'Z':
switch (oper) {
case GE:
case GT:
case LE:
case LT:
return any_type;
}
return t1;
case 'I':
switch (oper) {
case DEREF:
case PLUS:
case MINUS:
case ASPLUS:
case ASMINUS:
if (t1->check(Pvoid_type,0)==0) {
return any_type;
}
break;
default:
if(perr) error("P%k int",oper);
return any_type;
}
return t1;
case 'F':
if(perr) error("P%k float",oper);
return any_type;
case 'P':
if (t1->check(t2,ASSIGN)) {
Ptype tt1 = t1->is_ptr()->typ->skiptypedefs();
Ptype tt2 = t2->is_ptr()->typ->skiptypedefs();
switch (oper) {
case EQ:
case NE:
case LE:
case GE:
case GT:
case LT:
case MINUS:
case QUEST:
if (tt1 && tt2
&&
tt1->base==COBJ && tt2->base==COBJ
) {
Pclass c1=tt1->classtype();
Pclass c2=tt2->classtype();
if (c1 && c2
&&
c1->baseof(c2) || c2->baseof(c1)
) goto zz;
}
if (t2->check(t1,ASSIGN) == 0) {
if (oper == QUEST) return t2;
goto zz;
}
break;
case REFMUL:
{
Pname cn = tt1->is_cl_obj();
if (cn && tt2->base == FCT
&&
same_class(Pclass(cn->tp),Pfct(tt2)->memof)
)
return t2;
}
}
if(perr) error("T mismatch:%t %k%t",t1,oper,t2);
return any_type;
}
zz:
switch (oper) {
case MINUS:
return (t2!=Pvoid_type)
?
int_type
:
any_type;
case ASMINUS:
if(perr) error("P -=P");
return any_type;
case PLUS:
if(perr) error("P +P");
return any_type;
case ASPLUS:
if(perr) error("P +=P");
return any_type;
case MOD:
case ASMOD:
case AND:
case ER:
case OR:
case ASAND:
case ASOR:
case ASLS:
case ASRS:
case LS:
case RS:
case DEREF:
return any_type;
default:
return t1;
}
case FCT:
return t1;
default:
error('i',"P(%d)",r2);
}
case FCT:
if(oper == QUEST) {
switch (r2) {
case 'Z':
return any_type;
case 'P':
return t2;
case 'I':
case 'F':
if(perr) error("F%k%t",oper,t2);
default:
return t1;
}
}
if(Pfct(t1)->memof && r2=='P' && t2->memptr())
return t2;
if((oper == EQ || oper == NE) && r2=='Z') return t1;
if(perr) error("F%k%t",oper,t2);
return any_type;
default:
error('i',"np_promote(%d,%d)",r1,r2);
return 0;
}
}