V10/cmd/cfront/xptcfront/expr3.c
/*ident "@(#)ctrans:src/expr3.c 1.6" */
/***************************************************************************
C++ source for cfront, the C++ compiler front-end
written in the computer science research center of Bell Labs
Copyright (c) 1984 AT&T, Inc. All Rights Reserved
THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF AT&T, INC.
expr3.c:
type check function calls, casts, and explicit coercions
************************************************************************/
#include "cfront.h"
#include "size.h"
int pr_dominate(Ptype t1, Ptype t2)
/*
*/
{
Pname cn1 = t1->is_cl_obj();
Pname cn2 = t2->is_cl_obj();
//error('d',"pr_dominate(%t,%t)",t1,t2);
if (cn1==0 || cn2==0) {
Ptype p1 = t1->is_ptr();
Ptype p2 = t2->is_ptr();
if (p1 && p2) { // pointers
cn1 = Pptr(p1)->typ->is_cl_obj();
cn2 = Pptr(p2)->typ->is_cl_obj();
if (cn1==0 || cn2==0) return 0;
}
else {
p1 = t1->is_ref();
p2 = t2->is_ref();
if (p1 && p2) { // references
cn1 = Pptr(p1)->typ->is_cl_obj();
cn2 = Pptr(p2)->typ->is_cl_obj();
if (cn1==0 || cn2==0) return 0;
}
// else if (p1 && cn2) {
// cn1 = Pptr(p1)->typ->is_cl_obj();
// }
else
return 0; // not the same and not classes
}
}
Pclass c1 = Pclass(cn1->tp);
Pclass c2 = Pclass(cn2->tp);
//error('d'," c1 : c2 %d; c2 : c1 %d",c1->has_base(c2),c2->has_base(c1));
if (c1->has_base(c2)) return 1;
if (c2->has_base(c1)) return 2;
return 0;
}
int exact1(Pname,Ptype);
static exact2(Pname,Ptype);
static exact3(Pname,Ptype);
static Pname user_dominate(Pname n1, Pname n2, Pexpr arg)
{
Pfct f1 = Pfct(n1->tp);
Pfct f2 = Pfct(n2->tp);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
//error('d',"user_dominate: %n %t %t",n1,f1,f2);
for(; a1 && a2; a1 = a1->n_list, a2 = a2->n_list) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
}
if (a1 && !a1->n_evaluated) return n1;
if (a2 && !a2->n_evaluated) return n2;
a1 = f1->argtype;
a2 = f2->argtype;
Pname prev = 0;
Pexpr e = arg;
for(; a1 && a2 && e; a1 = a1->n_list, a2 = a2->n_list, e = e->e2) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
Ptype at = e->e1->tp;
int j = can_coerce(t1,at);
Ptype tt1 = Ncoerce ? Pfct(Ncoerce->tp)->returns : 0;
j = can_coerce(t2,at);
Ptype tt2 = Ncoerce ? Pfct(Ncoerce->tp)->returns : 0;
if(!tt1 || !tt2 || tt1->check(tt2,OVERLOAD))
return 0;
int one = 0, two = 0;
if(exact1(a1,tt1)) one = 4;
else if(exact2(a1,tt1)) one = 3;
else if(exact3(a1,tt1)) one = 2;
else one = 1;
if(exact1(a2,tt1)) two = 4;
else if(exact2(a2,tt1)) two = 3;
else if(exact3(a2,tt1)) two = 2;
else two = 1;
if(one > two && (!prev || prev==n1)) prev = n1;
else if(two > one && (!prev || prev==n2)) prev = n2;
else if(one == two && one) ;
else return 0;
}
if(prev) return prev;
return 0;
}
Pname dominate(Pname n1, Pname n2, Pexpr arg, int const_obj, int level)
/*
the two functions n1 and n2 can each respond to a call using
standard conversions. Does the one dominate the other in the
sense that all its arguments are identical to the other or
classes defived from the class of the corresponding argument
of the other.
If so return it, otherwise return 0;
*/
{
Pname res = 0;
Pfct f1 = Pfct(n1->tp);
Pfct f2 = Pfct(n2->tp);
Pname a1 = f1->argtype;
Pname a2 = f2->argtype;
Pexpr e = arg;
//error('d',"dominate: %n %t %t e %d",n1,f1,f2,e);
if (e == 0) {
if (const_obj) {
if (f1->f_const && f2->f_const==0) return n1;
if (f2->f_const && f1->f_const==0) return n2;
}
else {
if (f1->f_const==0 && f2->f_const) return n1;
if (f2->f_const==0 && f1->f_const) return n2;
}
return 0;
}
for(; a1 && a2 && e; a1 = a1->n_list, a2 = a2->n_list, e = e->e2) {
Ptype t1 = a1->tp;
Ptype t2 = a2->tp;
Ptype at = e->e1->tp;
//error('d',"t1 %t t2 %t at %t",t1,t2,at);
if (t1==t2 || t1->check(t2,0)==0 )
continue;
Pptr r1 = t1->is_ref();
Pptr r2 = t2->is_ref();
//error('d',"const_problem %t %t %t %d",t1,t2,at,const_problem);
if (const_problem) { // t1 and t1 differs only in const
Pname rr;
if (at->check(t1,0)==0 && const_problem==0) {
if (t1->is_ptr())
rr = n1;
else
goto nc;
}
else if (at->check(t2,0)==0 && const_problem==0) {
if (t2->is_ptr())
rr = n2;
else
goto nc;
}
else if (r1 && r1->typ->check(at,0)==0 && const_problem==0)
rr = n1;
else if (r2 && r2->typ->check(at,0)==0 && const_problem==0)
rr = n2;
else
goto nc;
if (res && res!=rr) return 0; // mutual dominace
res = rr;
continue; // identical
}
nc:
if (r2 && (t1==r2 || t1->check(r2->typ,0)==0)) continue;
if (r1 && (t2==r1 || t2->check(r1->typ,0)==0)) continue;
Pname rr = 0;
if (t1==at || exact1(a1,at))
rr = n1;
else if (t2==at || exact1(a2,at))
rr = n2;
else if (1<level) { // try integral promotion
if (exact2(a1,at))
rr = n1;
if (exact2(a2,at)) {
if (rr) rr = 0;
else rr = n2;
}
}
if (!rr && 2<level) { // try standard conversions
if (exact3(a1,at))
rr = n1;
if (exact3(a2,at)) {
if (rr) rr = 0;
else rr = n2;
}
}
if (rr) {
if (res && res!=rr) return 0; // mutual dominance
res = rr;
continue;
}
int r = pr_dominate(t1,t2);
//error('d',"pr1 %d",r);
if (r) {
Pname rr = r==1?n1:n2;
if (res && res!=rr) return 0; // mutual dominace
res = rr;
continue;
}
r = pr_dominate(t1,at);
//error('d',"pr2 %d",r);
if (r==2) {
if (res && res!=n1) return 0; // mutual dominace
res = n1;
r = pr_dominate(t2,at);
if (r==2) return 0; // mutual dominace
continue;
}
r = pr_dominate(t2,at);
//error('d',"pr3 %d",r);
if (r==2) {
if (res && res!=n2) return 0; // mutual dominace
res = n2;
continue;
}
}
//if (a1==0 && a2 && a2->n_initializer==0) return 0; // wrong number of arguments
//if (a2==0 && a1 && a1->n_initializer==0) return 0; // wrong number of arguments
if (e) {
//error('d',"more args %t a1 %t a2 %t",e->e1->tp,a1?a1->tp:0,a2?a2->tp:0);
int k1 = f1->nargs_known!=ELLIPSIS;
int k2 = f2->nargs_known!=ELLIPSIS;
if (a1 && a1->tp->check(e->e1->tp,ASSIGN)==0) return n1;
if (a2 && a2->tp->check(e->e1->tp,ASSIGN)==0) return n2;
if (k1 && k2) return 0;
}
if (a1==0 && a2 && a2->n_initializer==0) return 0;
if (a2==0 && a1 && a1->n_initializer==0) return 0;
if (res==0)
if (const_obj) {
if (f1->f_const && f2->f_const==0) return n1;
if (f2->f_const && f1->f_const==0) return n2;
}
else {
if (f1->f_const==0 && f2->f_const) return n1;
if (f2->f_const==0 && f1->f_const) return n2;
}
//error('d'," -> %n %t",res,res?res->tp:0);
return res;
}
Pname Ntmp;
static refd; // initialization routine called by ref_init, do not apply itor
static no_sti;
extern int stat_init;
Pname make_tmp(char c, Ptype t, Ptable tbl)
{
int dt = 0;
Pname tn = tbl->t_name;
Pname cn = t->is_cl_obj();
if (tn && tn->tp) error('s',"defaultA too complicated");
if (cn && Pclass(cn->tp)->has_dtor()) dt = 1;
if (Ntmp == 0 && dt ) Ntmp = cn;
//error('d',"tbl %d cstmt %d %d sti %d",tbl,Cstmt,Cstmt?Cstmt->memtbl:0,sti_tbl);
if (Cstmt) { // make Cstmt into a block
if (Cstmt->memtbl == 0) Cstmt->memtbl = new table(4,tbl,0);
tbl = Cstmt->memtbl;
}
else if (tbl == gtbl && no_sti == 0) {
if (sti_tbl == 0) sti_tbl = new table(8,gtbl,0);
tbl = sti_tbl;
}
Pname tmpx = new name(make_name(c));
tmpx->where = no_where;
tmpx->tp = t;
(void) t->tsizeof();
if ( t->base == COBJ ) {
Pclass cl = Pclass(Pbase(t)->b_name->tp);
if ( cl->lex_level ) tmpx->lex_level = cl->lex_level;
}
TOK scop = ARG;
if (stat_init && dt) {
tmpx->n_sto = STATIC; scop = ARGS;
}
// ARG[S]: no init; ARGS: static dtor
Pname tmp = tmpx->dcl(tbl,scop);
delete tmpx;
// n_scope == ARGS sets static dtor in simpl2.c
tmp->n_scope = (scop==ARG) ? FCT : ARGS;
return tmp;
}
Pexpr init_tmp(Pname tmp, Pexpr init, Ptable tbl)
{
Pname cn = tmp->tp->is_cl_obj();
Pname ct = cn ? Pclass(cn->tp)->has_itor() : 0;
tmp->n_assigned_to = 1;
//error('d',"init_tmp %n ct %n refd %d",tmp,ct,refd);
if (ct) { // must initialize
if (refd) {
//error('d',"'orrible %k",init->e1->base);
switch (init->e1->base) { // 'orrible 'ack
case NAME:
case REF:
case DEREF:
if (init->e1->tp->is_ptr())
init = init->e1;
else
init = new expr(G_CM,init,init->e1->address());
}
if (ct->tp->base == OVERLOAD) ct = Pgen(ct->tp)->fct_list->f; // first fct
tbl = 0;
}
return call_ctor(tbl,tmp,ct,init,DOT);
}
Pexpr ass = new expr(ASSIGN,tmp,init); // no ctor: can assign
ass->tp = tmp->tp;
return ass;
}
/*
int exact0(Pname nn, Ptype at)
// return 1 if
// exact match
{
if (nn == 0) return 0; //known==ELLIPSIS;
Ptype nt = nn->tp;
if (at == nt) return 1;
//error('d',"exact0 %d",nt->check(at,0));
return nt->check(at,0)==0;
}
*/
int exact3(Pname nn, Ptype at)
/*
return 1 if
match with standard conversions
*/
{
if (nn == 0) return 0; //known==ELLIPSIS;
Ptype nt = nn->tp;
while(nt->base == TYPE)
nt = Pbase(nt)->b_name->tp;
if (at == nt) return 1;
switch (nt->base) {
case RPTR:
if (at==zero_type && Pptr(nt)->typ->is_ptr()==0) return 0; //break;
if (nt->check(at,COERCE)) {
Pptr pt = at->addrof();
nt->base = PTR; // handle derived classes
if (nt->check(pt,COERCE)) {
nt->base = RPTR;
delete pt;
return 0;
}
nt->base = RPTR;
delete pt;
}
break;
default:
switch (at->base) {
default:
if (nt->check(at,COERCE)) return 0;
break;
case OVERLOAD:
// the actual argument is an overloaded function
// we'll try each instance until one matches
register Plist gl;
int no_match = 1;
for (gl = Pgen(at)->fct_list; gl; gl=gl->l) {
if (nt->check(gl->f->tp,COERCE)==0) {
no_match = 0;
break;
}
}
if ( no_match ) return 0;
}
}
return 1;
}
int exact1(Pname nn, Ptype at)
/*
return 1 if
exact match with
T <-> const T
X -> X&
T* -> const T*
T* -> T*const
taken into account
*/
{
if (nn == 0) return 0;//known==ELLIPSIS;
Ptype nt = nn->tp;
if (at == nt) return 1;
//error('d',"exact1 nt %t at %t",nt,at);
if (nt->check(at,0)) {
//error('d',"nt %t at %t cp %d",nt,at,const_problem);
if (const_problem) return 1; // handle T <-> const T
Pptr rt = nt->is_ref(); //handle X -> X&
if (rt && (at->check(Pptr(rt)->typ,0)==0 || const_problem)) return 1;
Pptr art = at->is_ptr();
if (rt && art) return 0; // ptrs do not match refs
// handle T* -> const T* and
// T* -> T*const
if (rt || (rt = nt->is_ptr())) {
if (art == 0) art = at->is_ref();
if (art) {
//error('d',"art %t %t",art->typ,rt->typ);
if (art->typ->check(rt->typ,0)) {
if (const_problem) return 1;
}
else // T* -> T*const
return 1;
}
}
return 0;
}
return 1;
}
Pexpr Ninit; // default argument used;
int Nstd; // standard coercion used (derived* =>base* or int=>long or ...)
bit exact_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
This function goes through three stages:
(1) exact match (no coercions at all)
(2) do integral promotions and float->double and re-try exact match
(3) try for unique standard conversions
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"exact_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if (at->base == ZTYPE) at = int_type;
if (exact1(nn,at)==0) return 0;
}
//error('d',"exact %d -> %d",nn,nn?nn->n_initializer!=0:1);
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
//error('d',"return 1");
return 1; // exact match without any promotions
}
int exact2(Pname nn, Ptype at)
/*
return 1 if
do integral promotion and float->double on at, then match
*/
{
//error('d',"exact2 nt %t at %t",nn?nn->tp:0,at);
while(at->base == TYPE)
at = Pbase(at)->b_name->tp;
switch (at->base) {
case EOBJ:
at = Penum(Pbase(at)->b_name->tp)->e_type;
break;
case ZTYPE:
at = int_type;
break;
case CHAR:
case SHORT:
at = (Pbase(at)->b_unsigned && at->tsizeof()==SZ_INT) ? uint_type : int_type;
break;
case FLOAT:
at = double_type;
}
if (nn == 0) return 0;//known==ELLIPSIS;
Ptype nt = nn->tp;
//error('d'," exact2 nt %t at %t",nt,at);
if (at == nt) return 1;
if (nt->check(at,0)) {
if (const_problem) return 1;
Pptr rt = nt->is_ref(); // handle X -> X&
if (rt && (at->check(Pptr(rt)->typ,0)==0 || const_problem)) return 1;
Pptr art = at->is_ptr();
if (rt && art) return 0; // ptrs do not match refs
// handle T* -> const T* and
// T* -> T*const
if (rt || (rt = nt->is_ptr())) {
if (art == 0) art = at->is_ref();
if (art) {
if (art->typ->check(rt->typ,0)) {
if (const_problem) return 1;
}
else // T* -> T*const
return 1;
}
}
return 0;
}
return 1;
}
bit prom_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
using integral promotions and float->double
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"prom_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if (exact2(nn,at)==0) return 0;
}
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
return 1; // exact match with promotions
}
bit std_match(Pname n, Pexpr arg)
/*
look for an exact match between "n" and the argument list "arg"
using standard conversions
*/
{
Pfct f = Pfct(n->tp);
register Pexpr e;
register Pname nn;
// error('d',"std_match(%n) %t",n,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
Pexpr a = e->e1;
Ptype at = a->tp;
if (at->base == ANY) return 0;
if ( exact3(nn,at) == 0) return 0;
}
if (nn) {
Ninit = nn->n_initializer;
return Ninit!=0;
}
return 1;
}
Pname Ncoerce;
int ref_cast;
bit can_coerce(Ptype t1, Ptype t2)
/* return number of possible coercions of t2 into t1,
Ncoerce holds a coercion function (not constructor), if found
*/
{
int zz = 0;
Ncoerce = 0;
if (t2->base == ANY) return 0;
// error('d',"can_coerce t1 %t t2 %t",t1, t2);
while(t1->base == TYPE)
t1 = Pbase(t1)->b_name->tp;
switch (t1->base) {
case RPTR:
while(t2->base == TYPE)
t2 = Pbase(t2)->b_name->tp;
switch (t2->base) {
// case VEC:
// case PTR:
// case RPTR:
// if (t1->check(t2,COERCE) == 0) return 1;
default:
{ Ptype tt2 = t2->addrof();
if (t1->check(tt2,COERCE) == 0) return 1;
if (ref_cast) break;//return 0; // (T&): no coercions
// except operator T&()
Ptype tt1 = Pptr(t1)->typ;
while (tt1->base==TYPE) tt1 = Pbase(tt1)->b_name->tp;
int bc;
if ( tt1->base != PTR && tt1->base != RPTR ) {
bc = Pbase(tt1)->b_const;
Pbase(tt1)->b_const = 0;
}
int i = can_coerce(tt1,t2);
if ( tt1->base != PTR && tt1->base != RPTR )
Pbase(tt1)->b_const = bc;
if (i) return i;
zz = 1;
}
}
}
Pname c1 = t1->is_cl_obj();
Pname c2 = t2->is_cl_obj();
int val = 0;
if (ref_cast || zz) goto oper_coerce;
if (c1) {
Pclass cl = Pclass(c1->tp);
if (c2 && c2->tp==cl) return 1;
// A more comprehensive test for template classes
if (c2 && (Pclass(c1->tp)->same_class(Pclass(c2->tp))))
return 1 ;
/* look for constructor
with one argument
or with default for second argument
of acceptable type
*/
Pname ctor = cl->has_ctor();
if (ctor == 0) goto oper_coerce;
register Pfct f = Pfct(ctor->tp);
//error('d',"ctor %n f %t",ctor,f);
switch (f->base) {
case FCT:
switch (f->nargs) {
case 1:
one:
{ Ptype tt = f->argtype->tp;
if (tt->check(t2,COERCE)==0)
val = 1;
else if (const_problem) {
Pptr p1 = tt->is_ptr_or_ref();
if (p1==0 || p1->typ->tconst()) val = 1;
}
if (tt = tt->is_ref()) {
Pptr pt = t2->addrof(); // handle derived classed
tt->base = PTR;
if (tt->check(pt,COERCE) == 0) val = 1;
tt->base = RPTR;
delete pt;
}
goto oper_coerce;
}
default:
if (f->argtype->n_list->n_initializer) goto one;
case 0:
goto oper_coerce;
}
case OVERLOAD:
{ register Plist gl;
for (gl=Pgen(f)->fct_list; gl; gl=gl->l) { // look for match
Pname nn = gl->f;
Pfct ff = Pfct(nn->tp);
switch (ff->nargs) {
case 0:
break;
case 1:
over_one:
{ Ptype tt = ff->argtype->tp;
//error('d',"over one %t %t -> %d %d",tt,t2,tt->check(t2,COERCE),const_problem);
if (tt->check(t2,COERCE)==0)
val = 1;
else if (const_problem) {
Pptr p1 = tt->is_ptr_or_ref();
if (p1==0 || p1->typ->tconst()) val = 1;
}
if (tt=tt->is_ref()) {
Pptr pt = t2->addrof(); // handle derived classed
tt->base = PTR;
if (tt->check(pt,COERCE) == 0) {
tt->base = RPTR;
delete pt;
val = 1;
goto oper_coerce;
}
tt->base = RPTR;
delete pt;
}
break;
}
default:
if (ff->argtype->n_list->n_initializer) goto over_one;
}
}
goto oper_coerce;
}
default:
error('i',"cannot_coerce(%k)\n",f->base);
}
}
oper_coerce:
//error('d',"oper_coerce %d",val);
if (c2) {
Pclass cl = Pclass(c2->tp);
int std = 0;
int oval = val;
extern Pname conv_dominates(Pname,Pname);
for (Pname ox, on=cl->conv; on; on=ox) {
ox = on->n_list;
// error( 'd', "can_coerce: ox: %s on: %s tp: %k", ox?ox->string:"", on->string, on->tp->base );
Plist gl = 0;
if ( on->tp->base == OVERLOAD ) {
gl = Pgen(on->tp)->fct_list;
on = gl->f;
gl = gl->l;
}
overlist:
// error( 'd', "can coerce: on: %n tp: %t gl: %d", on, on->tp, gl );
Pfct f = Pfct(on->tp);
Nstd = 0;
if (t1->check(f->returns,COERCE) == 0) {
if (Nstd==0) { // forget solutions involving standard conversions
Pname old = Ncoerce;
if (std) { // forget
val = oval+1;
std = 0;
Ncoerce = on;
}
else if (Ncoerce == 0) {
// val = 1;
val++;
Ncoerce = on;
}
else if ((Ncoerce = conv_dominates(Ncoerce,on))==0) {
if (val == 1) {
//error('d',"val==1 on %n old %n",on,old);
Ptype ton = Pfct(on->tp)->returns;
Ptype tco = Pfct(old->tp)->returns;
if (t1->check(ton,0)==0)
;
else if (t1->check(tco,0)==0)
on = old;
else
val++;
}
else
val++;
Ncoerce = on;
}
}
else { // take note only if no exact match seen
if (Ncoerce==0 || on->tp->check(Ncoerce->tp,0)) {
if (val==0 || std) {
if (Ncoerce) Ncoerce = conv_dominates(Ncoerce,on);
if (Ncoerce == 0) {
Ncoerce = on;
val++;
std = 1;
}
}
}
}
}
// error( 'd', "can_coerce: gl: %d", gl );
if ( gl ) {
on = gl->f;
gl = gl->l;
goto overlist; // must walk list of overloaded instances
}
}
}
//error('d',"val %d",val);
if (val) return val;
if (c1 && Pclass(c1->tp)->has_itor()) return 0;
//error('d',"%t->check(%t) -> %d",t1,t2,t1->check(t2,COERCE));
if (t1->check(t2,COERCE)) return 0;
return 1;
}
int gen_coerce(Pname n, Pexpr arg)
/*
look to see if the argument list "arg" can be coerced into a call of "n"
1: it can
0: it cannot or it can be done in more than one way
*/
{
Pfct f = (Pfct) n->tp;
register Pexpr e;
register Pname nn;
//error('d',"gen_coerce(%n,%d) %t",n,arg,n->tp);
for (e=arg, nn=f->argtype; e; e=e->e2, nn=nn->n_list) {
if (nn == 0) return f->nargs_known==ELLIPSIS;
Pexpr a = e->e1;
Ptype at = a->tp;
int i = can_coerce(nn->tp,at);
if (i != 1) return 0;
}
if (nn && nn->n_initializer==0) return 0;
return 1;
}
Pname Nover;
// int Nover_coerce;
int over_call(Pname n, Pexpr arg)
/*
return 4 if n(arg) can be performed without coercion of arg
return 3 if n(arg) can be performed only with promotion coercion of arg
return 2 if n(arg) can be performed only with standard coercion of arg
return 1 if n(arg) can be performed only with user defined coercion of arg
return 0 if n(arg) is an error
Nover is the function found, if any
Nstd is the number of standard coercions used
*/
{
register Plist gl;
Pgen g = Pgen(n->tp);
if (arg && arg->base!= ELIST) error('i',"ALX");
//error('d',"over_call(%n) %k",n,n->tp->base);
extern suppress_error;
suppress_error = 1;
// Nover_coerce = 0;
Nstd = 0;
switch (g->base) {
default: error('i',"over_call(%t)\n",g);
case OVERLOAD: break;
case FCT:
Nover = n;
Ninit = 0;
if (exact_match(n,arg)) {suppress_error = 0; return 4;}
if (prom_match(n,arg)) {suppress_error = 0; return 3;}
if (std_match(n,arg) && Ninit==0) {suppress_error = 0; return 2;}
Nstd = 0;
suppress_error = 0;
return gen_coerce(n,arg);
}
Pname exact = 0;
int no_exact = 0;
int ret = 0;
Pname nret;
for (gl=g->fct_list; gl; gl=gl->l) { /* look for match */
Nover = gl->f;
Ninit = 0;
Nstd = 0;
if (exact_match(Nover,arg)) {suppress_error = 0; return 4;} // no coercion
// if (prom_match(Nover,arg)) return 3; // only promotion
// if (std_match(Nover,arg) && Ninit==0) return 2; // only built-in conversion
if (ret<3 && prom_match(Nover,arg)) {
nret = Nover;
ret = 3;
}
if (ret<2 && std_match(Nover,arg) && Ninit==0) {
nret = Nover;
ret = 2;
}
}
suppress_error = 0;
if (ret) {
Nover = nret;
return ret;
}
Nover = 0;
for (gl=g->fct_list; gl; gl=gl->l) { /* look for coercion */
Pname nn = gl->f;
if (gen_coerce(nn,arg)) {
Nover = nn;
return 1;
}
}
return 0;
}
Ptype expr::call_fct(Ptable tbl)
/*
check "this" call:
e1(e2)
e1->typ() and e2->typ() has been done
*/
{
Pfct f;
Pname fn;
int x;
int k;
Pname nn;
Pexpr e;
Ptype t;
Pexpr arg = e2;
Ptype t1 = e1?e1->tp:0;
int argno;
Pexpr etail = 0;
bit no_change = 0;
Pname no_virt = 0; // set if explicit qualifier was used: c::f()
Pname chk = 0; // set if visibility check is needed
// that is if function name might have been
// found without use of find_name()
int const_obj = 0;
if (t1 == any_type) return any_type;
switch (base) {
case CALL:
case G_CALL: break;
default: error('i',"call_fct(%k)",base);
}
// error('d',"call %d %k %n arg %d",this,e1->base,e1->base==NAME?e1:0,arg);
if (t1 == 0) error('i',"call_fct(e1=%d,e1->tp=%t)",e1,t1);
if (arg && arg->base!=ELIST) error('i',"badAL%d%k",arg,arg->base);
switch (e1->base) {
case NAME:
fn = Pname(e1);
//error('d',"name %n %k",fn,fn->n_oper);
switch (fn->n_oper) {
case 0:
case CTOR:
case DTOR:
case TYPE:
case NEW:
case DELETE:
break;
default: // real operator: check for operator+(1,2);
if (arg == 0) break;
Pexpr a = arg->e1; // first operand
if (Pfct(fn->tp)->memof // obj.operator(1) is OK
|| a->tp->is_cl_obj()
|| a->tp->is_ref()) break;
a = arg->e2;
if (a == 0) // unary
error("%k of basicT",fn->n_oper);
else { // binary
a = a->e1; // second operand
if (a->tp->is_cl_obj() || a->tp->is_ref()) break;
error("%k of basicTs",fn->n_oper);
}
break;
}
break;
case REF:
case DOT:
no_virt = Pname(e1->n_initializer);
e1->n_initializer = 0;
if (e1 && e1->e1) {
Ptype t = e1->e1->tp;
Pptr tt = t->is_ptr_or_ref();
Ptype ft = tt ? tt->typ : t;
Pexpr ee = e1->e1;
const_obj = ft->tconst();
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
if (ee) {
Ptype ttt = ee->tp;
int tc;
switch (e1->base) {
case REF:
Pptr p = ttt?ttt->is_ptr():0;
if (p && p->typ->tconst())
const_obj = 1;
break;
case DOT:
tc = ttt ? ttt->tconst() : 0;
if(ttt && tc && (!strict_opt || tc!=2))
const_obj = 1;
}
}
}
case MDOT:
{ Pexpr n = e1->mem;
lxlx:
switch (n->base) {
case MDOT:
// reverse mdot (see expr::print())
// p->a.b() => (&p->a)->b() => b(&p->a)
// or p->a->b() => (p->a)->b() => b(p->a)
// or oo.a.b() => (&oo.a)->b() => b(&oo.a)
// or oo.a->b() => (oo.a)->b() => b(oo.a)
{
Pexpr r = e1;
Pexpr p = r->e1;
for (Pexpr m = r->mem; m->base==MDOT; m = r->mem) {
p = new mdot(m->string2,p);
p->i1 = m->i1+2;
p->tp = p->mem->tp;
r->mem = m->mem;
r->e1 = p;
}
}
case REF:
case DOT:
n = n->mem;
goto lxlx;
case NAME:
break;
default:
error('i',"ref %k",n->base);
}
fn = Pname(n);
//error('d',"mem %n",fn);
break;
}
case MEMPTR:
default:
fn = 0;
};
lll:
//error('d',"lll: %t %k",t1,t1->base);
switch (t1->base) {
case TYPE:
t1 = Pbase(t1)->b_name->tp;
goto lll;
case PTR: // pf() allowed as shorthand for (*pf)()
switch (Pptr(t1)->typ->base) {
case FCT:
case OVERLOAD:
if (Pptr(t1)->memof) error("O missing in call throughP toMF");
t1 = Pptr(t1)->typ;
fn = 0;
goto lll;
}
default:
if (fn)
error("call of%n;%n is a%t",fn,fn,e1->tp);
else
error("call of%kE ofT%t",e1->base,e1->tp);
case ANY:
return any_type;
case OVERLOAD:
{ register Plist gl;
Pgen g = Pgen(t1);
Pname found = 0;
Pname exact = 0;
int no_exact = 0;
int no_gen = 0;
for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
register Pname nn = gl->f;
if (exact_match(nn,arg)) {
//error('d',"found exact %n %t",nn,nn->tp);
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,0);
if (d)
nn = d;
else
error("two exact matches for%n:%t and%t",nn,nn->tp,found->tp);
}
found = nn;
}
}
//error('d',"found exact2 %n",found);
if (found) goto fnd;
Pname mvec[20];
/****************************************************************************
the next 2 loops have been commented out to eliminate the rule that calls
requiring only promotions and standard conversions are preferred over
calls requiring user-defined conversions.
for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
register Pname nn = gl->f;
if (prom_match(nn,arg)) {
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,1);
if (d)
nn = d;
else
error("two exact matches (after integral promotions) for%n:%t and%t",nn,nn->tp,found->tp);
}
found = nn;
}
}
//error('d',"found exact2 %n",found);
if (found) goto fnd;
// for (gl=g->fct_list; gl; gl=gl->l) { // look for exact match
// register Pname nn = gl->f;
//
// if (exact_match(nn,arg) || prom_match(nn,arg)) {
// found = nn;
// goto fnd;
// }
// }
for (gl=g->fct_list; gl; gl=gl->l) { // look for match
// with standard conversion
register Pname nn = gl->f;
Ninit = 0;
Nstd = 0;
if (std_match(nn,arg)) {
// if (Nstd == 0) {
// found = nn;
// goto fnd;
// }
if (exact) {
// check if one fct dominates the other
Pname d = dominate(exact,nn,arg,const_obj,2);
if (d == 0) {
mvec[no_exact++] = nn;
// no_exact++;
// error("two standard conversions possible for%n: %t and %t",fn,exact->tp,nn->tp);
}
else
exact = d;
}
else
exact = nn;
}
}
//error('d',"excact %n",exact);
if (exact) {
if (no_exact) {
while (no_exact) {
Pname d = dominate(exact,mvec[--no_exact],arg,const_obj,2);
if (d)
exact = d;
else
error("two standard conversions possible for%n: %t and %t",fn,exact->tp,mvec[no_exact]->tp);
}
}
//error('d',"found exact3 %n",found);
found = exact;
goto fnd;
}
this is the end of the commented out section.
************************************************************************/
for (gl=g->fct_list; gl; gl=gl->l) { /* look for coercion */
register Pname nn = gl->f;
if (prom_match(nn,arg) ||
std_match(nn,arg) ||
gen_coerce(nn,arg)) {
//error('d',"user2 %n %t",nn,nn->tp);
if (found) {
// check if one fct dominates the other
Pname d = dominate(found,nn,arg,const_obj,3);
//error('d',"dom d %d",d);
if (d == 0) d = user_dominate(found,nn,arg);
if (d == 0) {
mvec[no_gen++] = nn;
}
else
found = d;
}
else
found = nn;
}
}
if(found) {
while(no_gen) {
Pname d = dominate(found,mvec[--no_gen],arg,const_obj,3);
if(d==0) d = user_dominate(found,mvec[no_gen],arg);
if(d)
found = d;
else {
//error("ambiguousA for%n: %t and %t",fn,found->tp,mvec[no_gen]->tp);
error("ambiguous call of%n: %t and %t",fn,found->tp,mvec[no_gen]->tp);
}
}
}
fnd:
//error('d',"fnd %t",found?found->tp:0);
if (found) {
overFound = chk = fn = found;
f = Pfct(fn->tp);
}
else {
error("badAL for%n (no match against any %n)",fn,fn);
return any_type;
}
break;
}
case FCT:
f = Pfct(t1);
if (fn) {
switch (fn->n_oper) {
case CTOR:
case TYPE:
chk = fn;
}
}
}
//error('d',"chk %n",chk);
if (chk) {
Ptype t = 0;
Pexpr ee = e1->e1;
switch (e1->base) {
case REF: // ptr->chk()
if (ee == 0) { // 0->x() fudge handling new x()
check_visibility(chk,no_virt,Pclass(chk->n_table->t_name->tp),tbl,cc->nof);
break;
};
t = ee->tp;
while(t->base==TYPE) t = Pbase(t)->b_name->tp;
t = Pptr(t)->typ;
break;
case DOT: // obj.chk()
t = ee->tp;
}
Pname cn = t?t->is_cl_obj():0;
Pclass cl = cn?Pclass(cn->tp):0; // class of ``this'' for chk
if (cl) {
if (chk->n_oper==CTOR
&& chk->n_protect
&& cc->nof
&& cc->nof->n_oper==CTOR)
// BUG: cannot handle protected base
// class constructor
;
else {
check_visibility(chk,no_virt,cl,tbl,cc->nof);
}
}
}
if (fn && f->returns->is_cl_obj() && f->f_result==0) {
// protect against class cn; cn f(); ... class cn { cn(cn&); ... };
make_res(f);
//error('d',"returns %t",f->returns);
f->returns->tsizeof(); // make sure it is declared
}
//error('d',"fn %n %t printed %d",fn,fn?fn->tp:0,fn?fn->n_dcl_printed:0);
if (fn && fn->n_dcl_printed==0) {
if (f->f_inline==0 && f->f_imeasure) {
extern void uninline(Pname fn);
uninline(fn);
}
// ensure printout of class declaration:
for (Pname nn=f->argtype; nn; nn=nn->n_list)
if (nn->tp->is_cl_obj()) (void) nn->tp->tsizeof();
fn->dcl_print(0);
}
if (no_virt && f->f_static==0) {
if (e1->base==REF || e1->base==DOT) e1->n_initializer = fn;
}
else
fct_name = fn;
//error('d',"fn %n %t %d %d",fn,f,f->f_this,f->f_static);
if (f->f_this) { //SSS call of non-static memberfunction
switch (e1->base) {
case MEMPTR:
case REF:
case DOT:
break;
default:
error("O orP missing for%n ofT %t",fct_name,f);
}
}
else if (fn) { //SSS call of static function
sss:
switch (e1->base) {
case REF:
case DOT:
e1 = e1->mem;
goto sss;
}
}
if (fn) fn->use(); // a patch: ctors are sometimes not use()d
if (f->f_const==0
&& (fn==0 || (fn->n_oper!=CTOR && fn->n_oper!=DTOR))) { //CCC
Pexpr ee = e1->e1;
// while (ee && (ee->base==DOT || ee->base==REF)) ee = ee->e1;
while (ee && (ee->base==DOT || ee->base==REF)) {
Pexpr m = ee->mem;
// error('d', "m: %k tp %t", m?m->base:0, m?m->tp:0 );
if ( ee->base==REF && m->tp && m->tp->is_ptr())
break;
ee = ee->e1;
}
// error('d', "ee: %k tp %k", ee?ee->base:0, ee?ee->tp->base:0);
if (ee) {
Ptype tt = ee->tp;
switch (e1->base) {
case REF:
{ Pptr p = tt?tt->is_ptr():0;
if (p && p->typ->tconst())
error(strict_opt?0:'w',"non-constMF%n called for constO (anachronism)",fn);
// is really an error, but only warn to help transition
break;
}
case DOT:
int tc = tt ? tt->tconst() : 0;
if (tt && tc && (!strict_opt || tc!=2))
error(strict_opt?0:'w',"non-constMF%n called for constO (anachronism)",fn);
// is really an error, but only warn to help transition
}
}
}
t = f->returns;
x = f->nargs;
k = f->nargs_known;
e = arg;
if (k == 0) goto rlab;
for (nn=f->argtype, argno=1; e||nn; nn=nn->n_list, e=etail->e2, argno++) {
Pexpr a;
int save_base = 0;
char* save_name = 0;
if (e) {
a = e->e1;
etail = e;
if (nn) { /* type check */
Ptype t1 = nn->tp;
//error('d',"argtp %t etp %t a %k",t1,a->tp,a->base);
while(t1->base == TYPE)
t1 = Pbase(t1)->b_name->tp;
switch (t1->base) {
case RPTR:
{ Ptype pt = Pptr(t1)->typ;
if (pt->base != FCT ||
( pt->base == FCT &&
pt->check(a->tp,0)))
a = ref_init(Pptr(nn->tp),a,tbl);
goto cbcb;
}
case COBJ:
if (a->base!=G_CM
|| nn->tp->check(a->tp,ASSIGN))
a = class_init(0,t1,a,tbl);
else
a->e2=class_init(0,t1,a->e2,tbl);
if (nn->n_xref) {
// (temp.ctor(arg),&arg)
a = a->address();
}
else {
// defend against:
// int f(X); ... X(X&);
Pname cln = Pbase(t1)->b_name;
if (cln && Pclass(cln->tp)->has_itor()) {
// mark X(X&) arguments
nn->n_xref = 1;
a = a->address();
}
}
cbcb:
//error('d',"cbcb: a %d %k %t",a->base,a->base,a->tp);
if (a->base==G_CM) {
if (a->e1->base==DEREF) a->e1 = a->e1->e2; // (*e1,e2) => (e1,e2)
//error('d'," a %d %k",a->e1->base,a->e1->base);
if (a->e1->base==G_CALL
&& Pname(a->e1->fct_name)
&& Pname(a->e1->fct_name)->n_oper==CTOR
&& (a->e2->base==G_ADDROF || a->e2->base==ADDROF)) {
a = a->e1; // (ctor(&tmp),&tmp) => ctor(&tmp)
//error('d',"tmp %k %n",a->e2->base,a->e2->e2);
goto cccc;
}
else if (a->e2->base==G_ADDROF
&& a->e2->e2->base==NAME) {
cccc:
//error('d',"cccc: a %d %k %t",a->base,a->base,a->tp);
if (t1->base==RPTR
&& Pptr(t1)->typ->tconst()==0) { // temporary used
if (warning_opt)
error('w',"temporary used for non-const%tA",nn->tp);
else {
Ptype atp = a->tp;
if (atp==void_type
&& a->base==G_CALL
&& a->e1->tp->base==FCT)
atp = Pfct(a->e1->tp)->s_returns;
Ptype tt = t1->is_ref();
//error('d',"tt %t atp %t",tt,atp);
if (tt) {
if (Pptr(tt)->typ->tsizeof()!=atp->tsizeof()) { // sliced
Ptype aat = atp->is_ptr_or_ref();
if (aat==0
|| Pptr(tt)->typ->tsizeof()!=Pptr(aat)->typ->tsizeof())
error('w',"temporary used for non-const%tA",nn->tp);
}
}
else if (t1->tsizeof()!=atp->tsizeof()) // sliced
error('w',"temporary used for non-const%tA",nn->tp);
}
// if (warning_opt // blabber
// || t1->tsizeof()!=a->tp->tsizeof())) // sliced
// error('w',"temporary used for non-const%tA",nn->tp);
}
}
}
e->e1 = a;
break;
case ANY:
goto rlab;
case PTR:
{
save_base = e->e1->base;
if(a->tp->base==OVERLOAD)
save_name = Pgen(a->tp)->fct_list->f->string;
Pexpr te_a = a;
e->e1 = a = ptr_init(Pptr(t1),a,tbl);
no_change = (te_a == a);
// if (x==a || x==a->e2) goto def; // needs checking
if (Pchecked == 0) goto def;
break;
}
// e->e1 = a = ptr_init(Pptr(t1),a,tbl);
// goto def;
case CHAR:
case SHORT:
case INT:
// if (a->base==ICON && a->tp==long_type)
// error('w',"long constantA for%n,%kX",fn,t1->base);
{ Ptype t = a->tp;
while(t->base == TYPE)
t = Pbase(t)->b_name->tp;
switch (t->base) {
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"A%d: %t passed as %t",argno,a->tp,t1);
}
}
// no break
case LONG:
if (Pbase(t1)->b_unsigned
&& a->base==UMINUS
&& a->e2->base==ICON)
error('w',"negativeA for%n, unsignedX",fn);
default:
def:
{ Pexpr x = try_to_coerce(t1,a,"argument",tbl);
//error('d',"x %d t1 %t nn %t a1 %t",x,t1,nn->tp,a->tp);
if (x) {
if (Pchecked == 0 && no_change) {
Pexpr te_x = ptr_init(Pptr(t1), x, tbl);
if ( te_x != x ) e->e1 = a = te_x; else e->e1=x;
}
else
e->e1 = x;
}
else if (nn->tp->check(a->tp,ARG)) {
error("badA %dT for%n:%t (%tX)",argno,fn,a->tp,nn->tp);
return any_type;
}
}
}
Pexpr tt = e->e1;
while ( tt->base == CAST )
tt = tt->e1;
if ( tt->base == ILIST )
e->e1 = tt;
if (e->e1->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
if(save_base == REF) {
Pptr m = Pptr(a->tp);
error(strict_opt?0:'w',
"address of boundF (try using ``%s::*'' forPT and ``&%s::%s'' for address) (anachronism)",
m->memof->string,
m->memof->string,
save_name
);
}
Pname temp = make_tmp('A',mptr_type,tbl);
e->e1 = mptr_assign(temp,e->e1);
e->e1 = a = new expr(G_CM,e->e1,temp);
a->tp = temp->tp;
}
}
else {
if (k != ELLIPSIS) {
error("unexpected %dA for%n",argno,fn);
return any_type;
}
Pexpr te=e;
while(e) {
if (e->e1->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
Pname temp = make_tmp('A',mptr_type,tbl);
e->e1 = mptr_assign(temp,e->e1);
e->e1 = a = new expr(G_CM,e->e1,temp);
a->tp = temp->tp;
}
e = e->e2;
}
e = te;
goto rlab;
}
}
else { /* default argument? */
a = nn->n_initializer;
if (a == 0) {
error("A %d ofT%tX for%n",argno,nn->tp,fn);
return any_type;
}
if (a->base == ILIST) {
// memptr constant
// f({1,2,f}) ==> memptr t; f((t={1,2,f},t))
Pname temp = make_tmp('A',mptr_type,tbl);
a = mptr_assign(temp,a);
a = new expr(G_CM,a,temp);
a->tp = temp->tp;
}
a->permanent = 2; // ought not be necessary, but it is
e = new expr(ELIST,a,0);
if (etail)
etail->e2 = e;
else
e2 = e;
etail = e;
}
}
rlab:
//error('d',"rlab fct_name %n %t",fct_name,fct_name?fct_name->tp:0);
for (; e; e = e->e2) { // unchecked arguments
Pexpr a = e->e1;
Pname cn;
if (a->base==NAME && a->tp->base==FCT) {
// function name that escaped the type system:
// update use count
a->lval(ADDROF);
}
else if (warning_opt && (cn = a->tp->is_cl_obj())) {
Pclass cl = Pclass(cn->tp);
if (cl->has_ctor() || cl->memtbl->look("__as",0))//cl->has_oper(ASSIGN)
{
if (fct_name)
error('w',"O ofC%t withK or = copied asA to%n (%t)",cl,fct_name,fct_name->tp);
else
error('w',"O ofC%t withK or = copied asA to `...'",cl);
}
}
else if (a->tp->is_ref())
e->e1 = a->contents();
}
if (f->f_result) { // f(args) => (f(&temp,args),temp)
Pname tn = make_tmp('R',f->returns,tbl);
e2 = new expr(ELIST,tn->address(),e2);
// error('d',"result %n refd: %d",fn, refd);
Pexpr ee = new expr(0,0,0);
*ee = *this;
base = G_CM; // (f(&temp,args),temp)
e1 = ee;
if (refd == 2)
e2 = tn->address();
else e2 = tn;
tp = tn->tp;
}
return t;
}
int cm_const_save;
Pexpr ref_init(Pptr p, Pexpr init, Ptable tbl)
/*
initialize the "p" with the "init"
remember to call ptr_init to ensure that pointers to second bases
are handled correctly.
*/
{
register Ptype it = init->tp;
Pptr px = p;
while (px->base == TYPE) px = Pptr(Pbase(px)->b_name->tp);
Ptype p1 = px->typ;
Pname c1 = p1->is_cl_obj();
// error('d',"ref_init: p %t, p1 %t, px %t, init->tp %t",p,p1,px,it);
// error('d', "ref_init: nof: %n f_const: %d", cc?cc->nof:0, cc?(cc->nof?Pfct(cc->nof->tp)->f_const:0):0);
if (init->base == ILIST) error("IrL as RIr");
if (init->base==NAME
&& Pname(init)->n_scope==ARG
&& init->tp->base==FLOAT)
error('w',"initializing a float& with floatA is non-portable");
while(it->base == TYPE)
it = Pbase(it)->b_name->tp;
switch (it->base) {
default:
{ Ptype tt = it->addrof();
px->base = PTR; // allow &x for y& when y : public x
// but not &char for int&
int x = px->check(tt,COERCE);
if (x == 0) { //CCC type is fine check for constness:
if (init->tp->tconst()
&& vec_const==0
&& fct_const==0) {
// not ``it''
if (init->base == ELIST) init = init->e1;
if (px->typ->tconst() == 0) error("R to constO");
px->base = RPTR;
// if we have a const lvalue we can still pass its address
ignore_const++;
if (init->lval(0)) {
init->lval(ADDROF); // force output
ignore_const--;
//error('d',"in1 %t",init->tp);
return ptr_init(px,init->address(),tbl);//return init->address();
}
ignore_const--;
goto xxx;
}
px->base = RPTR;
if (init->lval(0)) { // can pass the address // no temporary needed
init->lval(ADDROF); // force output
//error('d',"px %t init %t init %t",px,init->tp,init->tp);
return ptr_init(px,init->address(),tbl);
}
goto xxx;
}
px->base = RPTR;
}
}
//error('d',"c1 %n",c1);
if (c1) { // assigning to a const X & is fine
ref_cast++;
Pexpr x = try_to_coerce(p,init,"reference initialization",tbl);
ref_cast--;
if (x) {
init = x;
goto xxx;
}
while (p1->base==TYPE) p1 = Pbase(p1)->b_name->tp;
int bc = Pbase(p1)->b_const;
Pbase(p1)->b_const = 0;
// refd = 1;
switch ( init->base ) {
case STRING: case ZERO: case CCON:
case ICON: case FCON: case IVAL:
case NAME:
refd = 1;
break;
default:
refd = (init->e1 && init->e1->base == NAME &&
init->e1->tp->base != RPTR &&
Pname(init->e1)->n_xref == 0) ? 2: 1;
break;
}
// error('d', "***** refd: %d", refd );
Pexpr a = class_init(0,p1,init,tbl);
Pbase(p1)->b_const = bc;
refd = 0;
if (a==init && init->tp!=any_type) goto xxx;
// error('d',"ri a %d %k",a->base,a->base);
switch (a->base) {
case G_CALL:
// case CM:
// case G_CM:
init = a;
goto xxx;
}
a = a->address();
a = ptr_init(px,a,tbl);
return a;
// return ptr_init(px,a->address(),tbl);//a->address();
}
//error('d',"p1 %t it %t",p1,it);
if (p1->check(it,0)) {
if (p1->check(it,ASSIGN) == 0) {
// if (p1->is_ptr()) // check for base* = derived*
// goto xxx;
// things like ``double& rr = 1;'' temporary needed
// warn in case of ``slightly wrong lvalue'', e.g.
// int i; double& r = i;
if (init->lval(0) && p1->tconst()==0)
error('w',"temporary used toIR; no changes will be propagated to actualA");
goto def;
}
Pexpr x = try_to_coerce(p1,init,"reference",tbl); // x==init
if (x==0) x = try_to_coerce(px,init,"reference",tbl); // x&=init
if (x) {
init = x;
goto def;
}
error("badIrT:%t (%tX)",it,p);
if (init->base != NAME) init->tp = any_type;
return init;
}
xxx: /*
here comes the test of a ``fundamental theorem'':
a structure valued expression is
(1) an lvalue of type T (possibly const)
or (2) the result of a function (a _result if X(X&) is defined)
or (3) a * or [] or ? or , expression
*/
//error('d',"xxx %k %d %t",init->base,init->base,init->tp);
switch (init->base) {
case NAME:
case DEREF:
case REF:
case DOT: // init => &init
if (it->tconst() && vec_const==0 && fct_const==0) goto def;
if ( cc && cc->nof &&
Pfct(cc->nof->tp)->f_const )
cm_const_save = Pbase(p->typ)->b_const;
init->lval(ADDROF);
cm_const_save = 0;
if (vec_const) return init;
if (fct_const && p1->is_ptr()) goto def; // fptr& = fct
// no break
case CM:
case G_CM: // & (f(&temp), temp)
return ptr_init(px,init->address(),tbl);//init->address();
default:
def:
{
// error('d',"def: init->tp %t p1 %t ",init->tp,p1);
// error('d',"p1: %t const_ptr: %d", p1, const_ptr);
if (const_ptr == 0) {
if (tbl == gtbl || strict_opt)
error("Ir for%snon-constR not an lvalue", strict_opt?"":" global ");
else
if (warning_opt)
error('w', "Ir for non-constR not an lvalue (anachronism)");
}
Pname tcl = p1->is_cl_obj ();
if(tcl && Pclass(tcl->tp)->c_abstract)
error("a temporary is needed for a parameter, but the argument type is abstract class %t.", tcl->tp);
Pname n = make_tmp('I',p1,tbl);
Pexpr a;
Pname ic = init->tp->is_cl_obj();
if (p1->tconst()==0
&& (init->tp->tconst() && vec_const==0 && fct_const==0)
&& p1->check(it,ASSIGN)==0)
error('w',"constIr: temporary used toI reference");
switch (p1->base) {
case INT:
case CHAR:
case SHORT:
switch (it->base) {
case LONG:
case FLOAT:
case DOUBLE:
case LDOUBLE:
error('w',"%t assigned to %t inRIr",it,p1);
}
}
if (ic!=c1 && Pclass(ic->tp) != Pclass(c1->tp)) {
// derived class1 => must cast: ``it Ix; (Ix=init,(p)&Ix);''
n->tp = init->tp;
a = ptr_init(px,n->address(),tbl);//n->address();
PERM(p);
a = new texpr(CAST,p,a);
a->tp = p;
}
else
a = n->address();
refd = 1;
Pexpr as = init_tmp(n,init,tbl);
refd = 0;
a = new expr(G_CM,as,a);
a->tp = a->e2->tp;
return a;
}
}
}
Pexpr class_init(Pexpr nn, Ptype tt, Pexpr init, Ptable tbl)
/*
initialize "nn" of type "tt" with "init"
if nn==0 make a temporary,
nn may not be a name
*/
{
if (init == dummy) return 0;
//error('d',"class_init %t with %t init %k refd %d",tt,init->tp,init->base,refd);
Pname c1 = tt->is_cl_obj();
if (init == 0) {
error("emptyIr");
return dummy;
}
if (c1) {
Pclass cl = Pclass(c1->tp);
Pname c2 = init->tp->is_cl_obj();
if (c1!=c2 || (refd==0 && cl->has_itor())) {
/* really ought to make a temp if refd,
but ref_init can do that
*/
int i = can_coerce(tt,init->tp);
//error('d',"i %d nn %n",i,nn);
switch (i) {
default:
error("%d ways of making a%n from a%t",i,c1,init->tp);
init->tp = any_type;
return init;
case 0:
if (c2 && Pclass(c2->tp)->has_base(cl)) {
init = init->address();
Pexpr x = cast_cptr(cl,init,tbl,0);
if (x == init) {
Ptype pt = tt->addrof();
PERM(pt);
x = new cast(pt,init);
}
return x->contents();
}
error("cannot make a%n from a%t",c1,init->tp);
init->tp = any_type;
return init;
case 1:
//error('d',"ncoerce %n %k %d",Ncoerce,init->base,init->base);
if (Ncoerce == 0) {
Pexpr a = new expr(ELIST,init,0);
a = new texpr(VALUE,tt,a);
a->e2 = nn;
// return a->typ(tbl);
a = a->typ(tbl);
//error('d',"ci a %k %d %t",a->base,a->base,a->tp);
return a;
}
switch (init->base) {
case CM:
case G_CM: //ddd
case NAME: /* init.coerce() */
/* *ref */ case DEREF:
{ Pref r = new ref(DOT,init,Ncoerce);
Pexpr rr = r->typ(tbl);
init = new expr(G_CALL,rr,0);
init->fct_name = Ncoerce;
break;
}
default: // (temp=init,temp.coerce())
{ Pname tmp = make_tmp('U',init->tp,tbl);
int x = refd;
refd = 0; // ??
Pexpr ass = init_tmp(tmp,init,tbl);
refd = x;
Pref r = new ref(DOT,tmp,Ncoerce);
Pexpr rr = r->typ(tbl);
Pexpr c = new expr(G_CALL,rr,0);
c->fct_name = Ncoerce;
c = c->typ(tbl);
init = new expr(CM,ass,c);
init->tp = c->tp;
if (refd) { // &f() => (t=f(), &t)
Pname tmp2 = make_tmp('L',c->tp,tbl);
ass = init_tmp(tmp2,init,tbl);
init = new expr(G_CM,ass,tmp2);
}
}
}
//error('d',"nn %n",nn);
if (nn) {
Pexpr a = new expr(ELIST,init,0);
a = new texpr(VALUE,tt,a);
a->e2 = nn;
return a->typ(tbl);
}
}
//error('d',"c1 %n c2 %n",c1,c2);
return init->typ(tbl);
}
return init;
}
//error('d',"ci check tt %t init->tp %t",tt,init->tp);
if (tt->check(init->tp,ASSIGN) && refd==0) {
error("badIrT:%t (%tX)",init->tp,tt);
init->tp = any_type;
}
return init;
}
extern int bound; // fudge for bound pointers to functions
Pexpr expr::docast(Ptable tbl)
{
// check cast against value, INCOMPLETE
//error('d',"docast %d %t %k",this,tp2,e1->base);
if (e1 == dummy) {
error("E missing for cast");
tp = any_type;
return this;
}
int pmf = 0;
int ptom_cast = 0;
Pexpr ee = e1;
//error('d',"ee %k %d",ee->base,ee->base);
switch (ee->base) {
case ADDROF:
ee = ee->e2;
switch (ee->base) {
case NAME: goto nm;
case REF: goto rf;
}
break;
case NAME:
nm:
if (Pname(ee)->n_qualifier) pmf = 1;
break;
case REF:
rf:
if (ee->e1->base == THIS) bound = 1;
break;
}
e1 = e1->typ(tbl);
int b = bound; // distinguish between explicit and implicit THIS
bound = 0;
pmf = pmf && e1->base==CAST;
Ptype etp = e1->tp;
Ptype tt = tp2;
Ptype t = tt;
tt->dcl(tbl);
while (etp->base == TYPE) etp = Pbase(etp)->b_name->tp;
while (tt->base == TYPE) tt = Pbase(tt)->b_name->tp;
//error('d',"e1 %k etp %t tt %t",e1->base,etp,tt);
switch (etp->base) {
case PTR:
case RPTR:
if (Pptr(etp)->typ->base == OVERLOAD) goto over;
if (warning_opt && i2==0 && Pptr(etp)->typ->tconst()) {
switch (tt->base) {
case FCT:
break;
case PTR:
case RPTR:
if (Pptr(tt)->typ->tconst()) break;
default:
// casting away const
// should be an error
// but ANSI says OK so I chicken out
// to be able to compile strtok(), etc.
error('w',"const cast away:%t->%t",e1->tp,tp2);
}
}
else
i2 = 0; // to allow cfront to escape its own checking
break;
case COBJ:
{ ref_cast = 1;
Pexpr x = try_to_coerce(tt,e1,"cast",tbl);
ref_cast = 0;
//error('d',"x %k %t tt %d %t",x?x->base:0,x?x->tp:0,tt,tt);
if (x) {
if (x!=e1 && x->base==DEREF && tt->is_ref()) x = x->e1;
if (tt==x->tp || tt->check(x->tp,0)==0 || const_problem)
return x;
else
return new cast(tt,x);
}
// else if (e1->base==DEREF && tt->is_ref()) return e1;
break;
}
case VOID:
if (tt->base == VOID) {
tp = t;
return this;
}
error("cast of void value");
// no break;
case ANY:
any:
tp = any_type;
return this;
case FCT:
if (tt->base == PTR && Pptr(tt)->typ->base != FCT)
error('w',"P toF cast toP to nonF");
break;
case OVERLOAD:
over:
error("cast of overloaded");
goto any;
}
//error('d',"tt %t",tt);
switch (tt->base) {
case PTR:
if (Pptr(tt)->typ->base==FCT && Pptr(tt)->memof) {
if (etp->base!=PTR
|| Pptr(etp)->typ->base!=FCT
|| Pptr(etp)->memof==0)
error("cast toP toM %t",tt);
else { // adjust delta in MI case
// for the moment just suppress the cast
// all pmfs are the same to cc
/*
Pclass c1 = Pptr(tt)->memof;
Pclass c2 = Pptr(etp)->memof;
*/
ptom_cast = 1;
tp2 = void_type;
}
}
switch (etp->base) {
case COBJ:
error("cannot castCO toP");
break;
case FCT:
e1 = new expr(G_ADDROF,0,e1);
bound = b;
e1 = e1->typ(tbl);
bound = 0;
if (e1->base == CAST)
pmf = 1;
else
break;
// no break;
case PTR:
{ Pname cn = Pptr(tt)->typ->is_cl_obj();
if (cn) {
Pexpr x = cast_cptr(Pclass(cn->tp),e1,tbl,1);
if (x == e1) {
PERM(tt);
e1 = new cast(tt,e1);
e1->i2 = i2;
}
else
e1 = x;
}
if (pmf) {
while(tt->base == TYPE)
tt = Pbase(tt)->b_name->tp;
switch (tt->base) {
case PTR:
if (Pptr(tt)->memof) break;
default:
error("%t cast to%t (%t is not aP toM)",e1->tp,tp2,tp2);
}
}
}
}
break;
case RPTR: // (x&)e: pretend e is an x
{ Ptype er = etp;
Ptype cr = tt;
do {
if (er = er->is_ptr_or_ref()) er = Pptr(er)->typ;
if (cr = cr->is_ptr_or_ref()) cr = Pptr(cr)->typ;
} while (er && cr);
int pp = er!=0; // if `e' is a suitable pointer cast it:
// (x&)e => (x*)e, otherwise
// (x&)e => *(x*)&e
// error('d',"rptr tt %t e1->base %k e1->tp %t",tt,e1->base,e1->tp);
// if (Pptr(tt)->typ->tsizeof()>etp->tsizeof()) goto zse;
// we need to be able to ``raise the type'' from base to derived
// if (etp->is_cl_obj() && Pptr(tt)->typ->is_cl_obj()==0) goto zse;
if (e1->base==G_CM
|| e1->base==CALL
|| e1->base==G_CALL
|| e1->lval(0))
;
else if (e1->tp->tconst()) {
// casting away const
// should be an error
// but ANSI says OK so I chicken out
// to be able to compile strtok(), etc.
if (warning_opt && Pptr(tt)->typ->tconst()==0)
error('w',"const cast away:%t->%t",e1->tp,tp2);
}
else
error("cannot cast%t to%t",etp,t);
//error('d',"e1 %k %t %d",e1->base,e1->tp,pp);
if (pp == 0) e1 = e1->address(); // *(x*)&e
tp = t;
// do proper pointer manipulation for multiple inheritance
Pname cn = Pptr(tt)->typ->is_cl_obj();
if (cn) {
Pexpr x = cast_cptr(Pclass(cn->tp),e1,tbl,1);
if (x == e1) {
PERM(tt);
e1 = new cast(tt,e1);
e1->i2 = i2;
}
else
e1 = x;
}
return pp ? this : contents();
// zse:
// error("cannot cast%t to%t",etp,t);
// tp2 = tt = any_type;
// break;
}
case COBJ:
base = VALUE; // (x)e => x(e): construct an x from e
e1 = new expr(ELIST,e1,0);
return typ(tbl);
case CHAR:
case INT:
case SHORT:
case LONG:
switch (etp->base) {
case FCT:
e1 = new expr(ADDROF,0,e1);
e1 = e1->typ(tbl);
//etp = e1->tp;
case PTR:
if(!e1->tp->memptr() && e1->tp->tsizeof()>tt->tsizeof())
error("type ``%t'' not large enough for values of ``%t ''",tt,etp);
break;
case COBJ:
error("cannot castCO to%k",tt->base);
break;
}
break;
case FLOAT:
case DOUBLE:
case LDOUBLE:
switch (etp->base) {
case FLOAT:
case DOUBLE:
case LDOUBLE:
case CHAR:
case INT:
case SHORT:
case LONG:
case EOBJ:
case ZTYPE:
break;
default:
error("cannot cast ``%t '' to ``%t''",etp,tt);
break;
}
break;
case FCT:
error("cannot cast toFT");
break;
}
tp = t;
if (e1->base==ILIST && ptom_cast==0) { // pointer to member constant
Pexpr ee = e1->e1; // ELIST
int i;
switch (ee->e2->base) {
case IVAL:
i = int(ee->e2->i1);
break;
case ZERO:
i = 0;
}
if (i<0)
e1 = e1->e2; // just the function
else
e1 = ee->e2; // just the index
return this;
}
if (etp->base==PTR && Pptr(etp)->memof && Pptr(etp)->typ->base==FCT) {
Pclass cl = Pptr(etp)->memof;
if (Pptr(tt)->memof==0 && b == 0 ) {
Pexpr y = new mdot("f",e1);
y->i1 = 9;
y = new cast(tt,y);
if (cl->virt_count && b==0) {
// ERROR: no check for side effects
Pexpr z = new mdot("i",e1);
Pexpr x = new mdot("i",e1);
x->i1 = 9;
x = new cast(tt,x);
z->i1 = 9;
Pexpr q = new expr (QUEST,x,y);
q->cond = new expr(LE,zero,z);
q->tp = tt;
delete this;
return q;
}
delete this;
return y;
}
}
return this;
}
Pexpr expr::dovalue(Ptable tbl)
{
Ptype tt = tp2;
Pclass cl;
Pname cn;
//error('d',"value %d %t e1 %d e2 %d",tt,tt,e1,e2);
tt->dcl(tbl);
while(tt->base == TYPE)
tt = Pbase(tt)->b_name->tp;
switch (tt->base) {
case EOBJ:
default:
if (e1 == 0) {
error("value missing in conversion to%t",tt);
return dummy;
}
base = CAST;
e1 = e1->e1; // strip ELIST
return typ(tbl);
case CLASS:
cl = Pclass(tt);
tp2 = Pptr(cl->this_type)->typ;
break;
case COBJ:
cn = Pbase(tt)->b_name;
cl = Pclass(cn->tp);
}
//error('d',"e1 %k e1->e2 %k",e1->base,e1?e1->e2->base:0);
if (e1 && e1->e2==0) { // single argument
if (e1->e1->base==ELIST) e1->e1 = e1->e1->e1; // spurious elist
e1->e1 = e1->e1->typ(tbl);
if (tt->base==COBJ) {
Pexpr x = try_to_coerce(tt,e1->e1,"type conversion",tbl);
if (x) return x;
}
Pname acn = e1->e1->tp->is_cl_obj();
//error('d',"acn %n %d",acn,cl->has_itor());
if (acn && cl->has_itor()==0) {
Pclass acl = Pclass(acn->tp);
int hb = acl->has_base(cl);
if (acl==cl || hb) {
vcllist->clear();
vcllist=0;
if (1<is_unique_base(acl,cl->string,0)) error("ambiguous assignment to base %t",cl);
Pexpr ee = e1->e1;
if (ee->base == ELIST) ee = ee->e1; // ???
if (hb) { // ee => *(tp2*)&ee
// remember = may be overloaded
//error('d',"hb %k %t %d",ee->base,ee->tp,ee->lval(0));
ignore_const++;
if (ee->lval(0)==0) {
Pname tmp = make_tmp('T',ee->tp,tbl);
ee = init_tmp(tmp,ee,tbl);
ee = new expr(G_CM,ee,tmp->address());
}
else
ee = ee->address();
ignore_const--;
ee = new texpr(CAST,new ptr(PTR,tp2),ee); //new cast(new ptr(PTR,tp2),ee);
ee = ee->contents();
ee->typ(tbl);
}
if (e2) { // x(x_obj) => e2=x_obj
base = ASSIGN;
e1 = e2;
e2 = ee;
tp = tp2;
return this;
}
return ee; // strip ELIST: x(x_obj) => x_obj
}
}
}
/* x(a) => obj.ctor(a); where e1==obj */
Pname ctor = cl->has_ctor();
if (ctor == 0) {
error("cannot make a%t",cl);
return dummy;
}
// error('d',"e2 %k",e2?e2->base:0);
// error('d',"refd: %d const_ptr: %d", refd, const_ptr);
if (e2 == 0) { // x(a) => x temp; (temp.x(a),temp)
/* incomplete condition
if ( refd && const_ptr == 0) {
if ( tbl == gtbl ) {
error("Ir forG non-constCR not an lvalue");
}
else
if (strict_opt)
error("Ir for non-constCR not an lvalue");
else
if (warning_opt)
error('w', "Ir for non-constR not an lvalue (anachronism)");
}
*/
no_sti = 1;
Pname n = make_tmp('V',tp2,tbl);
no_sti = 0;
n->assign();
if (tbl == gtbl) n->dcl_print(0); // a hack
Pexpr c = call_ctor(tbl,n,ctor,e1,DOT);
c = new expr(G_CM,c,n);
c->tp = n->tp;
//error('d',"tp1 %t",c->tp);
return c;
}
else {
Pexpr c = call_ctor(tbl,e2,ctor,e1,DOT);
c = new expr(DEREF,c,0); // deref value returned by constructor
c->tp = c->e1->tp;
//error('d',"tp2 %t",c->tp);
return c;
}
}