Pbase start_cl(TOK t, Pname c, Pname b)
{
if (c == 0) c = new name(make_name('C'));
//error('d',"c: %d %s",c->base,c->string);
Pname n = c->tname(t); /* t ignored */
n->where = curloc;
Pbase bt = (Pbase)n->tp; /* COBJ */
if (bt->base != COBJ) {
error("twoDs of%n:%t andC",n,bt);
error('i', "can't recover from previous errors");
}
Pclass occl = ccl;
ccl = (Pclass)bt->b_name->tp; /* CLASS */
if (ccl->defined) {
error("C%n defined twice");
ccl->defined |= IN_ERROR;
}
ccl->defined |= DEF_SEEN;
if (ccl->in_class = occl) occl->tn_list = modified_tn; // save mod-list
modified_tn = 0;
ccl->string = n->string;
ccl->csu = t;
if (b) ccl->clbase = b->tname(t);
return bt;
}
void get_tag()
/* saw AGGR or ENUM */
{
switch (lookahead()) {
default:
error('e', "missing tag");
insert_tok(ID);
latok->retval.s = "__MISSING__";
case ID:
{
Pname n = ktbl->look(latok->retval.s,HIDDEN);
if (n == 0) {
n = new name(latok->retval.s);
n->lex_level = 0;
n = n->tname(latok->last->retval.t);
modified_tn = modified_tn->l;
}
else {
switch (n->tp->base) {
case COBJ:
case EOBJ:
break;
default:
error('i',"hidden%n:%t",n,n->tp);
}
}
latok->tok = TNAME;
latok->retval.pn = n;
break;
}
case TNAME:
break;
}
switch (lookahead()) {
default:
backup(); return;
case COLON:
switch (lookahead()) {
case ID: case TNAME: case LC:
break;
default:
backup(); return;
}
case LC:{ int level = 1;
for(;;) switch (lookahead()) {
case LC: level++; break;
case RC: if(--level==0) return;
break;
case EOFTOK:
error('i', "unexpected eof");
}
} // case LC
} // switch
}
Pbase end_enum(Pname n, Pname b)
{
if (n == 0) n = new name(make_name('E'));
n = n->tname(ENUM);
Pbase bt = (Pbase)n->tp;
if (bt->base != EOBJ) {
error("twoDs of%n:%t and enum",n,bt);
error('i', "can't recover from previous errors");
}
Penum en = (Penum)bt->b_name->tp;
en->e_body = 2;
en->mem = name_unlist((class nlist *)b);
if (en->defined) {
error("enum%n defined twice",n);
en->defined |= IN_ERROR;
}
en->defined |= DEF_SEEN;
return bt;
}
int error(int t, loc* lc, const char* s, const ea& a0, const ea& a1, const ea& a2, const ea& a3)
/*
"int" not "void" because of "pch" in lex.c
legal error types are:
not counted in error count:
'w' warning
'd' debug
'D' debug -- no prefix
'C' text -- line no. and no newline
'c' text -- no line no. and no newline
counted in error count:
's' "not implemented" message
'l' "compiler limit exceeded" message
0 error
'e' error -- no newline
'i' internal error (causes abort)
't' error while printing error message
*/
{
if (suppress_error && t!='i' && t!='d') return 0;
if (in_error++)
if (t == 't')
t = 'i';
else if (4 < in_error) {
fprintf(stderr,"\nOops!, error while handling error\n");
ext(13);
}
FILE * of = out_file;
out_file = stderr;
if (!scan_started || t=='t')
putch('\n');
else if (lc != &dummy_loc) {
if(t != 'D' && t != 'c') lc->put(out_file);
} else {
if(t != 'D' && t != 'c') print_loc();
}
int user_error = 0;
switch (t) {
case 'C':
case 'c':
break;
case 'e':
user_error = 1;
// no break
case 0:
putstring("error: ");
user_error += 1;
break;
case 'd':
putstring("DEBUG: ");
case 'D':
break;
case 'w':
// no_of_warnings++;
putstring("warning: ");
break;
case 'l':
putstring("compiler limit exceeded: ");
break;
case 's':
putstring("sorry, not implemented: ");
user_error = 1;
break;
case 'i':
if (error_count++) {
fprintf(out_file,"sorry, cannot recover from earlier errors\n");
out_file = of; // restore for fflush()
#ifdef TEST_SUITE
ext(INTERNAL2);
#else
ext(INTERNAL);
#endif
}
else
fprintf(out_file,"internal %s error: ",prog_name);
}
ea argv[4];
ea* a = argv;
argv[0] = a0;
argv[1] = a1;
argv[2] = a2;
argv[3] = a3;
int c;
while (c = *s++) {
if ('A'<=c && c<='Z')
putstring(abbrev_tbl[c-'A']);
else if (c == '%') {
switch (c = *s++) {
case 'k': // TOK assumed passed as an int
{ int x = TOK(a->i);
if (0 < x && x<=MAXTOK && keys[x])
fprintf(out_file," %s",keys[x]);
else
fprintf(out_file," token(%d)",x);
break;
}
case 't': // Ptype
{ Ptype tt = Ptype(a->p);
if (tt == 0) break;
putch(' ');
int nt = ntok;
emode = 1;
tt->dcl_print(0);
emode = 0;
ntok = nt;
break;
}
case 'n': // Pname
{ Pname nn = Pname(a->p);
if (nn && nn->string) {
// suppress generated class names:
if (nn->string[0]=='_'
&& nn->string[1]=='_'
&& nn->string[2]=='C') break;
emode = 1;
putch(' ');
nn->print();
emode = 0;
}
else
putstring(" ?");
break;
}
case 'p': // pointer
{ char* f = sizeof(char*)==sizeof(int)?" %d":" %ld";
fprintf(out_file,f,a->p);
break;
}
case 'a': // fully qualified function
{ Pname nn = Pname(a->p);
if (nn->tp->base!=FCT && nn->tp->base!=OVERLOAD)
error('i',"%n not function",nn);
if (nn && nn->string) {
// suppress generated class names:
if (nn->string[0]=='_'
&& nn->string[1]=='_'
&& nn->string[2]=='C') break;
emode = 1;
putch(' ');
nn->print(1);
emode = 0;
}
else
putstring(" ?");
break;
}
case 'c': // char assumed passed as an int
putch((int)a->i);
break;
case 'd': // int
fprintf(out_file," %d",a->i);
break;
case 'o': // int
fprintf(out_file," 0%o",a->i);
break;
case 's': // char*
{
char *s = ((char *)a->p);
if ( s ) putst((char*)a->p);
break;
}
}
a++;
}
else
putch(c);
}
/*
switch (t) {
case 'd':
case 't':
case 'w':
putch('\n');
break;
default:
*/
if (t != 'c' && t != 'e' && t != 'C')
print_context();
/*
}
*/
if (user_error)
basic_inst::head->print_error_loc(user_error==2);
out_file = of; // restore before ext() for fflush()
if (!scan_started && t!='d' && t!='w') ext(4);
// now we may want to carry on
switch (t) {
case 't':
if (--in_error) {
fflush(stderr);
//fflush(out_file);
return 0;
}
case 'i':
ext(INTERNAL);
case 0:
case 'e':
case 'l':
case 's':
#ifdef TEST_SUITE
if (t == 's')
ext(SORRY);
#endif
if (MAXERR<++error_count) {
fprintf(stderr,"Sorry, too many errors\n");
ext(7);
}
}
in_error = 0;
fflush(stderr);
//fflush(out_file);
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 classdef.dcl(Pname cname, Ptable tbl)
{
int nmem;
Pname p;
Pptr cct;
Pbase bt;
Pname px;
Ptable btbl;
int bvirt;
Pclass bcl;
int i;
int fct_seen = 0;
int static_seen = 0;
int local = tbl!=gtbl;
int byte_old = byte_offset;
int bit_old = bit_offset;
int max_old = max_align;
int boff;
int in_union;
int usz;
int make_ctor = 0;
int make_dtor = 0;
/* this is the place for paranoia */
if (this == 0) error('i',"0->Cdef.dcl(%d)",tbl);
if (base != CLASS) error('i',"Cdef.dcl(%d)",base);
if (cname == 0) error('i',"unNdC");
if (cname->tp != this) error('i',"badCdef");
if (tbl == 0) error('i',"Cdef.dcl(%n,0)",cname);
if (tbl->base != TABLE) error('i',"Cdef.dcl(%n,tbl=%d)",cname,tbl->base);
nmem = pubmem->no_of_names() + privmem->no_of_names() + pubdef->no_of_names();
in_union = (csu==UNION || csu==ANON);
if (clbase) {
if (clbase->base != TNAME) error("BC%nU",clbase);
clbase = Pbase(clbase->tp)->b_name;
bcl = (Pclass)clbase->tp;
if ((bcl->defined&SIMPLIFIED) == 0) error("BC%nU",clbase);
tbl = bcl->memtbl;
if (tbl->base != TABLE) error('i',"badBC table %d",tbl);
btbl = tbl;
bvirt = bcl->virt_count;
if (bcl->csu == UNION) error('s',"C derived from union");
if (in_union)
error("derived union");
else
if (pubbase == 0) csu = CLASS;
boff = bcl->real_size;
max_align = bcl->align();
bit_ass = bcl->bit_ass;
}
else {
btbl = 0;
bvirt = 0;
boff = 0;
if (!in_union) csu = (virt_count) ? CLASS : STRUCT;
while (tbl!=gtbl && tbl->t_name) tbl = tbl->next; // nested classes
max_align = AL_STRUCT;
bit_ass = 1; // can be bitwise copied
}
memtbl->set_scope(tbl);
memtbl->set_name(cname);
if (nmem) memtbl->grow((nmem<=2)?3:nmem);
cc->stack();
cc->not = cname;
cc->cot = this;
//error('d',"classdef%n",cname);
byte_offset = usz = boff;
bit_offset = 0;
bt = new basetype(COBJ,cname);
bt->b_table = memtbl;
this_type = cc->tot = cct = new ptr(PTR,bt,0);
PERM(cct);
PERM(bt);
for (p=privmem; p; p=px) {
Pname m;
px = p->n_list;
//error('d',"privmem%n %d",p,p->tp->base);
if (p->tp->base==FCT) {
Pfct f = (Pfct)p->tp;
Pblock b = f->body;
f->body = 0;
switch( p->n_sto ) {
case AUTO:
case STATIC:
case REGISTER:
case EXTERN:
error("M%n cannot be%k",p,p->n_sto);
p->n_sto = 0;
}
m = p->dcl(memtbl,0);
if (b) {
if (m->tp->defined&(DEFINED|SIMPLIFIED))
error("two definitions of%n",m);
else if (p->where.line!=m->where.line)
error('s',"previously declared%n cannot be defined inCD",p);
else
Pfct(m->tp)->body = b;
}
fct_seen = 1;
}
else {
m = p->dcl(memtbl,0);
if (m) {
if (m->n_stclass==STATIC) {
static_seen = 1;
m->n_sto = (tbl == gtbl) ? 0 : STATIC;
if (m->n_initializer) error('s',"staticM%n withIr",m);
}
if (in_union) {
if (usz < byte_offset) usz = byte_offset;
byte_offset = 0;
}
}
}
}
if (privmem && csu==STRUCT) csu = CLASS;
for (p=pubmem; p; p=px) {
Pname m;
px = p->n_list;
//error('d',"pubmem%n %d",p,p->tp->base);
if (p->tp->base == FCT) {
Pfct f = (Pfct)p->tp;
Pblock b = f->body;
f->body = 0;
switch(p->n_sto) {
case AUTO:
case STATIC:
case REGISTER:
case EXTERN:
error("M%n cannot be%k",p,p->n_sto);
p->n_sto = 0;
}
m = p->dcl(memtbl,PUBLIC);
if (b) {
if (m->tp->defined&(DEFINED|SIMPLIFIED))
error("two definitions of%n",m);
else if (p->where.line!=m->where.line)
error('s',"previously declared%n cannot be defined inCD",p);
else
Pfct(m->tp)->body = b;
}
fct_seen = 1;
}
else {
m = p->dcl(memtbl,PUBLIC);
if (m) {
if (m->n_stclass==STATIC) {
m->n_sto = (tbl == gtbl) ? 0 : STATIC;
static_seen = 1;
if (m->n_initializer) error('s',"staticM%n withIr",m);
}
if (in_union) {
if (usz < byte_offset) usz = byte_offset;
byte_offset = 0;
}
}
}
/*delete p;*/
}
/* pubmem = 0;
*/
// if (local && fct_seen) error("FM of local%k %s",csu,string);
if (in_union) byte_offset = usz;
if (virt_count || bvirt) { /* assign virtual indices */
Pname vp[100];
Pname nn;
nn = has_ctor();
if (nn==0 || nn->n_table!=memtbl) make_ctor = 1;
{ // FUDGE vtbl
char* s = new char[20];
sprintf(s,"%s__vtbl",string);
Pname n = new name(s);
n->tp = Pfctvec_type;
Pname nn = gtbl->insert(n,0);
nn->use();
}
if (virt_count = bvirt)
for (i=0; i<bvirt; i++) vp[i] = bcl->virt_init[i];
for ( nn=memtbl->get_mem(i=1); nn; nn=memtbl->get_mem(++i) ) {
switch (nn->tp->base) {
case FCT:
{ Pfct f = (Pfct)nn->tp;
if (bvirt) {
Pname vn = btbl->look(nn->string,0);
if (vn) { /* match up with base class */
if (vn->n_table==gtbl) goto vvv;
Pfct vnf;
switch (vn->tp->base) {
case FCT:
vnf = (Pfct)vn->tp;
if (vnf->f_virtual) {
if (vnf->check(f,0)) error("virtual%nT mismatch:%t and%t",nn,f,vnf);
f->f_virtual = vnf->f_virtual;
vp[f->f_virtual-1] = nn;
}
else
goto vvv;
break;
case OVERLOAD:
{ Pgen g = (Pgen)vn->tp;
if (f->f_virtual
|| Pfct(g->fct_list->f->tp)->f_virtual)
error('s',"virtual%n overloaded inBC but not in derivedC",nn);
break;
}
default:
goto vvv;
}
}
else
goto vvv;
}
else {
vvv:
/*error('d',"vvv: %n f_virtual %d virt_count %d",nn,f->f_virtual,virt_count);*/
if (f->f_virtual) {
f->f_virtual = ++virt_count;
switch (f->f_virtual) {
case 1:
{ Pname vpn = new name("_vptr");
vpn->tp = Pfctvec_type;
(void) vpn->dcl(memtbl,PUBLIC);
delete vpn;
}
default:
vp[f->f_virtual-1] = nn;
}
}
}
break;
}
case OVERLOAD:
{ Plist gl;
Pgen g = (Pgen)nn->tp;
/*error('d',"overload%n bvirt==%d",nn,bvirt);*/
if (bvirt) {
Pname vn = btbl->look(nn->string,0);
Pgen g2;
Pfct f2;
if (vn) {
/*error('d',"vn%n tp%k",vn,vn->tp->base);*/
if (vn->n_table == gtbl) goto ovvv;
switch (vn->tp->base) {
default:
goto ovvv;
case FCT:
f2 = (Pfct)vn->tp;
if (f2->f_virtual
|| Pfct(g->fct_list->f->tp)->f_virtual)
error('s',"virtual%n overloaded in derivedC but not inBC",nn);
break;
case OVERLOAD:
g2 = (Pgen)vn->tp;
for (gl=g->fct_list; gl; gl=gl->l) {
Pname fn = gl->f;
Pfct f = (Pfct)fn->tp;
Pname vn2 = g2->find(f);
if (vn2 == 0) {
if (f->f_virtual) error('s',"virtual overloaded%n not found inBC",fn);
}
else {
Pfct vn2f = (Pfct)vn2->tp;
if (vn2f->f_virtual) {
f->f_virtual = vn2f->f_virtual;
vp[f->f_virtual-1] = fn;
}
}
}
break;
}
}
else
goto ovvv;
}
else {
ovvv:
for (gl=g->fct_list; gl; gl=gl->l) {
Pname fn = gl->f;
Pfct f = (Pfct)fn->tp;
/*fprintf(stderr,"fn %s f %d %d %d count %d\n",fn->string,f,f->base,f->f_virtual,virt_count+1);*/
if (f->f_virtual) {
f->f_virtual = ++virt_count;
switch (f->f_virtual) {
case 1:
{ Pname vpn = new name("_vptr");
vpn->tp = Pfctvec_type;
(void) vpn->dcl(memtbl,0);
delete vpn;
}
default:
vp[f->f_virtual-1] = fn;
}
}
}
}
break;
}
}
}
virt_init = new Pname[virt_count];
for (i=0; i<virt_count; i++) virt_init[i] = vp[i];
}
Pname pnx;
for (p=pubdef; p; p=pnx) {
char* qs = p->n_qualifier->string;
char* ms = p->string;
Pname cx;
Ptable ctbl;
Pname mx;
pnx = p->n_list;
//error('d',"dcl: pubdef %s::%s",qs,ms);
if (strcmp(ms,qs)==0) ms = "_ctor";
for (cx = clbase; cx; cx = Pclass(cx->tp)->clbase) {
if (strcmp(cx->string,qs) == 0) goto ok;
}
error("publicQr %s not aBC",qs);
continue;
ok:
ctbl = Pclass(cx->tp)->memtbl;
mx = ctbl->lookc(ms,0);
//error('d',"ms %d %d %d",mx,Ebase,Epriv);
if (Ebase) { // cc->nof ??
if (!Ebase->has_friend(cc->nof)) error("QdMN%n is in privateBC",p);
}
else if (Epriv) {
if (!Epriv->has_friend(cc->nof)) error("QdMN%n is private",p);
}
if (mx == 0) {
error("C%n does not have aM %s",cx,p->string);
p->tp = any_type;
}
else {
if (mx->tp->base==OVERLOAD) error('s',"public specification of overloaded%n",mx);
p->base = PUBLIC;
}
p->n_qualifier = mx;
(void) memtbl->insert(p,0);
//error('d',"bbb");
if (Nold) error("twoDs of CM%n",p);
}
pubdef = 0;
if (bit_offset) byte_offset += (bit_offset/BI_IN_BYTE+1);
real_size = byte_offset;
//error('d',"%s: rz=%d (bits %d)",string,byte_offset,bit_offset);
if (byte_offset < SZ_STRUCT) byte_offset = SZ_STRUCT;
int waste = byte_offset%max_align;
if (waste) byte_offset += max_align-waste;
//error('d',"%s: sz=%d al=%d",string,byte_offset,max_align);
obj_size = byte_offset;
obj_align = max_align;
if ( has_dtor() && has_ctor()==0)
error('w',"%s has destructor but no constructor",string);
{ // now look look at the members
Pname m;
Pclass oc = in_class;
int ct = has_ctor()==0;
int dt = has_dtor()==0;
int un = csu==UNION;
Pname statc = 0;
Pname statd = 0;
for (m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i) ) {
if (m->base == PUBLIC) continue;
Ptype t = m->tp;
switch (t->base) {
default:
if (ct && make_ctor==0) {
if (t->is_ref()) error("reference%n inC %s without constructor",m,string);
if (t->tconst() && vec_const==0) error("constant%n inC %s without constructor",m,string);
}
break;
case FCT:
case OVERLOAD:
case CLASS:
case ENUM:
continue;
case VEC:
break;
}
Pname cn = t->is_cl_obj();
if (cn == 0) cn = cl_obj_vec;
if (cn) {
Pclass cl = (Pclass)cn->tp;
if (cl->bit_ass == 0) bit_ass = 0; // no bit copy
if (ct || dt || un) {
Pname ctor = cl->has_ctor();
Pname dtor = cl->has_dtor();
if (ctor) {
if (m->n_stclass==STATIC) {
error('s',"staticM%n ofC%n with constructor",m,cn);
statc = m;
}
else if (un)
error("M%n ofC%n with constructor in union",m,cn);
else if (ct) {
if (statc) error('s',"staticM%n ofC%t with constructor",statc,statc->tp);
make_ctor = 1;
ct = 0;
}
}
if (dtor) {
if (m->n_stclass==STATIC) {
error('s',"staticM%n ofC%n with destructor",m,cn);
statd = m;
}
else if (un)
error("M%n ofC%n with destructor in union",m,cn);
else if (dt) {
if (statd) error('s',"staticM%n ofC%t with constructor",statd,statd->tp);
make_dtor = 1;
dt = 0;
}
}
}
}
}
}
if (make_ctor) {
Pname ct = has_ctor();
if (ct==0 || ct->n_table!=memtbl) {
// make a constructor for the class: x::x() {}
// a base class's constructor is not good enough
if (ct && has_ictor()==0) error("%k %s needs a constructor",csu,string);
Pname n = new name(string);
Pfct f = new fct(defa_type,0,1);
n->tp = f;
n->n_oper = TNAME;
Pname m = n->dcl(memtbl,PUBLIC);
Pfct(m->tp)->body = new block(curloc,0,0);
}
}
if (make_dtor && has_dtor()==0) {
// make a destructor for the class: x::x() {}
Pname n = new name(string);
Pfct f = new fct(defa_type,0,1);
n->tp = f;
n->n_oper = DTOR;
Pname m = n->dcl(memtbl,PUBLIC);
Pfct(m->tp)->body = new block(curloc,0,0);
}
defined |= DEFINED;
for (p=memtbl->get_mem(i=1); p; p=memtbl->get_mem(++i)) {
/* define members defined inline */
//error('d',"member %n",p);
switch (p->tp->base) {
case FCT:
{ Pfct f = (Pfct)p->tp;
if (f->body) {
f->f_inline = 1;
p->n_sto = STATIC;
f->dcl(p);
}
break;
}
case OVERLOAD:
{ Pgen g = (Pgen)p->tp;
Plist gl;
for (gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = (Pfct)n->tp;
if (f->body) {
f->f_inline = 1;
n->n_sto = STATIC;
f->dcl(n);
}
}
}
}
}
Plist fl; /* define friends defined inline */
for (fl=friend_list; fl; fl=fl->l) {
Pname p = fl->f;
switch (p->tp->base) {
case FCT:
{ Pfct f = (Pfct)p->tp;
if (f->body
&& (f->defined&(DEFINED|SIMPLIFIED)) == 0) {
f->f_inline = 1;
p->n_sto = STATIC;
f->dcl(p);
}
break;
}
case OVERLOAD:
{ Pgen g = (Pgen)p->tp;
Plist gl;
for (gl=g->fct_list; gl; gl=gl->l) {
Pname n = gl->f;
Pfct f = (Pfct)n->tp;
if (f->body
&& (f->defined&(DEFINED|SIMPLIFIED)) == 0) {
f->f_inline = 1;
n->n_sto = STATIC;
f->dcl(n);
}
}
}
}
}
byte_offset = byte_old;
bit_offset = bit_old;
max_align = max_old;
cc->unstack();
}
void block.dcl(Ptable tbl)
/*
Note: for a block without declarations memtbl denotes the table
for the enclosing scope.
A function body has its memtbl created by fct.dcl().
*/
{
int bit_old = bit_offset;
int byte_old = byte_offset;
int max_old = max_align;
Pblock block_old = curr_block;
if (base != BLOCK) error('i',"block.dcl(%d)",base);
curr_block = this;
if (d) {
Pname n;
own_tbl = 1;
if (memtbl == 0) {
int nmem = d->no_of_names()+4;
memtbl = new table(nmem,tbl,0);
memtbl->real_block = this;
/* this is a "real" block from the
source text, and not one created by DCL's
inside a block. */
}
else
if (memtbl != tbl) error('i',"block.dcl(?)");
Pname nx;
for (n=d; n; n=nx) {
nx = n->n_list;
n->dcl(memtbl,FCT);
switch (n->tp->base) {
case CLASS:
case ANON:
case ENUM:
break;
default:
delete n;
}
}
}
else
memtbl = tbl;
if (s) {
Pname odcl = Cdcl;
Pname m;
int i;
s->dcl();
if (own_tbl)
for (m=memtbl->get_mem(i=1); m; m=memtbl->get_mem(++i)) {
Ptype t = m->tp;
if (t == 0) {
if (m->n_assigned_to == 0)
error('w',"undefined label %s",m->string);
if (m->n_used == 0)
error('w',"label %s not used", m->string);
continue;
}
ll:
switch (t->base) {
case TYPE: t=((Pbase)t)->b_name->tp; goto ll;
case CLASS:
case ENUM:
case FCT:
case VEC: continue;
}
if (m->n_addr_taken == 0) {
if (m->n_used) {
if (m->n_assigned_to) {
}
else {
switch (m->n_scope) {
case FCT:
Cdcl = m;
error('w',"%n used but not set",m);
}
}
}
else {
if (m->n_assigned_to) {
}
else {
switch (m->n_scope) {
case ARG:
if (m->string[0]=='_' && m->string[1]=='A') break; /* generated name: cannot be used */
case FCT:
Cdcl = m;
error('w',"%n not used",m);
}
}
}
}
}
Cdcl = odcl;
}
d = 0;
if (bit_offset) byte_offset += SZ_WORD;
if (stack_size < byte_offset) stack_size = byte_offset;
bit_offset = bit_old;
byte_offset = byte_old;
curr_block = block_old;
}
TOK lalex()
{
static nocast = 0; // prevent ID CAST, FOR CAST, etc.
//static in_op = 0; // prevent OPERATOR op CAST
static incast = 0; // don't scan in already recognized cast
static in_enum;
static fr;
char en = 0;
switch (la_start()) {
case VOLATILE:
case SIGNED:
error('w',"keyword%k (ignored)",latok->tok);
return lalex();
case ENUM:
en = 1;
case AGGR:
switch (tk) {
/* strictly speaking these ought to be included,
but they only cause grief
case ELSE:
case COLON: // label
case RP: // end of condition
*/
case 0:
case LP: // argument list
case CM:
case NEW:
case CAST:
case RP: // yok, old C: f(i) struct s * i; {}
case OPERATOR:
case DO:
case TYPE: // might be "const"
case COLON: // label
case SM: // end of statement
case RC: // end of statement
case LC: // first statement
break;
default:
error(&curloc,"';' missing afterS orD before\"%k\"",latok->tok);
return tk=SM;
}
{ TOK t = lookahead();
TOK x;
switch (t) {
case TNAME:
x = lookahead();
break;
case ID: // hidden or undefined
x = lookahead();
backup();
switch (x) {
case LC:
in_enum = en;
case COLON: // defining: return AGGR ID
backup();
fr = 0;
DO_RET;
default:
{ Pname n = ktbl->look(latok->retval.s,HIDDEN);
if (n == 0) { // new tag: define it
n = new name(latok->retval.s);
n->lex_level = 0;
n = n->tname(latok->last->retval.t);
modified_tn = modified_tn->l;
}
else {
switch (n->tp->base) {
case COBJ:
case EOBJ:
break;
default:
error('i',"hidden%n:%t",n,n->tp);
}
}
latok->tok = TNAME;
latok->retval.pn = n;
}
}
(void)lookahead();
break;
case LC:
in_enum = en;
default:
fr = 0;
DO_RET;
};
switch (x) {
case LC: // class x {
in_enum = en;
case COLON: // class x :
fr = 0;
DO_RET;
case SM:
if (tk!=NEW && fr==0) { // no further processing necessary
deltok(); // class
deltok(); // x
deltok(); // ;
return lalex();
}
// new class x ; => new x ;
default:
deltok(); // AGGR(?) TNAME(x) => TNAME(x)
fr = 0;
DO_RET;
}
}
case LP:
fr = 0;
if (nocast) {
nocast = 0;
DO_RET;
// } else if (in_op) {
// in_op = 0;
// DO_RET;
} else if (incast)
DO_RET;
/* possible cast */
bad_cast = 0;
if (scan_type()) {
if (scan_mod()) {
if (lookahead() != RP) DO_RET;
switch (lookahead()) {
case CM: case RP: case SM: case LC: case ASSIGN:
/* arg type list in declaration */
if (tk != SIZEOF) DO_RET;
break;
case PLUS: case MINUS: case MUL: case AND:
case NEW: case DELETE: case SIZEOF: case MEM:
case NOT: case COMPL: case ICOP:
case LP: case CAST:
case ID: case TYPE: case TNAME:
case THIS: case OPERATOR: case ZERO:
case ICON: case FCON: case CCON: case STRING:
// cast of a term
break;
default: // something wrong...
// binary op, missing ;, etc.
// "bad cast" could be legal expr
// "( TNAME() )" (ctor call)
if (bad_cast) DO_RET;
else break;
}
backup();
front->tok = CAST;
latok->tok = ENDCAST;
if (bad_cast) {
error("can't cast to function");
rep_cast();
}
incast = 1;
}
}
DO_RET;
case CAST:
incast++;
DO_RET;
case ENDCAST:
if (--incast == 0) nocast = 0;
DO_RET;
case ID:
{ char* s = front->retval.s;
fr = 0;
nocast = 1;
switch (lookahead()) {
case ID:
{ // handle ID ID
// assume ID is a missing, hidden, or misspelt TNAME
char* s2 = latok->retval.s;
backup();
Pname n = ktbl->look(s,HIDDEN);
if (n == 0) { // new tag: define it
error("%s %s:TX (%s is not a TN)",s,s2,s);
n = new name(s);
n->lex_level = 0;
n = n->tname(0);
modified_tn = modified_tn->l;
n->tp = any_type;
}
else {
error("%s %s: %s is hidden",s,s2,s);
}
latok->tok = TNAME;
latok->retval.pn = n;
break;
}
case LC:
backup();
front->retval.pn = new name(s);
front->retval.pn->lex_level--;
break;
default:
backup();
front->retval.pn = new name(s);
}
DO_RET;
}
case CASE:
case DEFAULT:
case PUBLIC:
case ELSE:
fr = 0;
switch (tk) {
case COLON: // label
case SM: // end of statement
case RC: // end of statement
case LC: // first statement
DO_RET;
default:
error(&curloc,"';' missing afterS orD before\"%k\"",latok->tok);
return tk=SM;
}
case DO:
case GOTO:
case CONTINUE:
case BREAK:
case RETURN:
fr = 0;
switch (tk) {
case ELSE:
case DO:
case COLON: // label
case RP: // end of condition
case SM: // end of statement
case RC: // end of statement
case LC: // first statement
DO_RET;
default:
error(&curloc,"';' missing afterS orD before\"%k\"",latok->tok);
return tk=SM;
}
case IF:
case WHILE:
case FOR:
case SWITCH:
fr = 0;
switch (tk) {
case ELSE:
case DO:
case COLON: // label
case RP: // end of condition
case SM: // end of statement
case RC: // end of statement
case LC: // first statement
nocast = 1;
DO_RET;
default:
error(&curloc,"';' missing afterS orD before\"%k\"",latok->tok);
return tk=SM;
}
case TYPE: // dangerous to diddle with: constructor notation
fr = 0;
switch (tk) {
case ID:
// case RP: old C function definition
case RB:
error(&curloc,"';' missing afterS orD before\"%k\"",latok->tok);
return tk=SM;
}
if (latok->retval.t == FRIEND) fr = 1;
nocast = 1;
DO_RET;
case TNAME: // dangerous to diddle with: name hiding
{ Pname n = latok->retval.pn;
if (fr) { // guard against: TYPE(friend) TNAME(x) SM
nocast = 1;
fr = 0;
DO_RET;
}
fr = 0;
// fprintf(stderr,"type or tname %d %s\n",tk,n->string); fflush(stderr);
switch (tk) {
case TYPE: // int TN ? or unsigned TN ?
// beware of unsigned etc.
switch (lookahead()) {
case SM:
case RB:
case COLON:
case ASSIGN:
goto hid;
// case LP: // the real problem
default:
nocast = 1;
DO_RET;
}
case TNAME: // TN TN ?
switch (lookahead()) {
case MEM: // cl_name::mem_name
case DOT: // anachronism: cl_name.mem_name
nocast = 1;
DO_RET;
}
hid:
backup(); // undo lookahead after TNAME
n->hide();
n = new name(n->string);
n->n_oper = TNAME;
latok->tok = ID;
latok->retval.pn = n;
}
}
case NEW:
fr = 0;
nocast = 1;
DO_RET;
/*
case OPERATOR:
switch (lookahead()) {
case LP:
in_op = 1;
if (lookahead() != RP) error("bad operator");
break;
case LB:
if (lookahead() != RB) error("bad operator");
break;
case TYPE:
case TNAME:
while (lookahead() == MUL) ;
backup();
// default : 'regular' operator
}
if (lookahead() == LP) in_op = 1;
DO_RET;
*/
case RC:
fr = 0;
switch (tk) {
case RC: // nested } (either stmt or expr)
case LC: // empty block: {}
case SM: // end of statement
break;
default:
{ TOK t;
loc x = curloc;
switch (t = lookahead()) {
case ELSE:
case RC: // } } probably end of initializer
case CM: // } , definitely end of initializer
case SM: // } ; probably end of initializer or class
case RP: // int f( struct { ... } );
break;
default:
// either "= { ... E } SorD"
// or " SorD }"
// or enum { a, b } c; - yuk
if (in_enum == 0) {
error(&x,"';'X at end ofS orD before '}'");
return tk=SM;
}
in_enum = 0;
}
}
}
in_enum = 0;
default:
fr = 0;
nocast = 0;
DO_RET;
}
ret:
// hand optimized return:
//TOK deltok()
//{
toknode* T = front;
tk = T->tok;
yylval = T->retval;
if (front = front->next) front->last = 0;
delete T;
return tk;
//}
}
int error(int t, loc* lc, char* s ...)
/*
"int" not "void" because of "pch" in lex.c
subsequent arguments fill in %mumble fields
legal error types are:
'w' warning (not counted in error count)
'd' debug
's' "not implemented" message
0 error
'i' internal error (causes abort)
't' error while printing error message
*/
{
FILE * of = out_file;
int c;
char format[3]; /* used for "% mumble" sequences */
int * a = &t;
int argn = 3;
/* check variable argument passing mechanism */
int si = sizeof(int);
int scp = sizeof(char*);
int ssp = sizeof(Pname);
if (si!=ssp || si!=scp || ssp!=scp || &a[2]!=(int*)&s) {
fprintf(stderr,
"\n%s: this c can't handle varargs (%d,%d,%d -- %d %d)\n",
prog_name, si, scp, ssp, &a[1], &s);
ext(12);
}
if (t == 'w' && warn==0) return 0;
if (in_error++)
if (t!='t' || 4<in_error) {
fprintf(stderr,"\nUPS!, error while handling error\n");
ext(13);
}
else if (t == 't')
t = 'i';
out_file = stderr;
if (!scan_started)
/*fprintf(out_file,"error during %s initializing: ",prog_name);*/
putch('\n');
else if (t=='t')
putch('\n');
else if (lc != &dummy_loc)
lc->put(out_file);
else
print_loc();
switch (t) {
case 0:
fprintf(out_file,"error: ");
break;
case 'w':
no_of_warnings++;
fprintf(out_file,"warning: ");
break;
case 's':
fprintf(out_file,"sorry, not implemented: ");
break;
case 'i':
if (error_count++) {
fprintf(out_file,"sorry, %s cannot recover from earlier errors\n",prog_name);
ext(INTERNAL);
}
else
fprintf(out_file,"internal %s error: ",prog_name);
break;
}
while (c = *s++) {
if ('A'<=c && c<='Z' && abbrev_tbl['A'])
putstring(abbrev_tbl[c]);
else if (c == '%')
switch (c = *s++) {
case 'k':
{ TOK x = a[argn];
if (0<x && x<MAXTOK && keys[x])
fprintf(out_file," %s",keys[x]);
else
fprintf(out_file," token(%d)",x);
argn++;
break;
}
case 't': /* Ptype */
{ Ptype tt = (Ptype)a[argn];
if (tt) {
TOK pm = print_mode;
extern int ntok;
int nt = ntok;
print_mode = ERROR;
fprintf(out_file," ");
tt->dcl_print(0);
print_mode = pm;
ntok = nt;
argn++;
}
break;
}
case 'n': /* Pname */
{ Pname nn = (Pname)a[argn];
if (nn) {
TOK pm = print_mode;
print_mode = ERROR;
fprintf(out_file," ");
nn->print();
print_mode = pm;
}
else
fprintf(out_file," ?");
argn++;
break;
}
default:
format[0] = '%';
format[1] = c;
format[2] = '\0';
fprintf(out_file,format,a[argn++]);
break;
}
else
putch(c);
}
if (!scan_started) ext(4);
switch (t) {
case 'd':
case 't':
case 'w':
putch('\n');
break;
default:
print_context();
}
fflush(stderr);
/* now we may want to carry on */
out_file = of;
switch (t) {
case 't':
if (--in_error) return 0;
case 'i':
ext(INTERNAL);
case 0:
case 's':
if (MAXERR<++error_count) {
fprintf(stderr,"Sorry, too many errors\n");
ext(7);
}
}
in_error = 0;
return 0;
}
Pname name.normalize(Pbase b, Pblock bl, bit cast)
/*
if (bl) : a function definition (check that it really is a type
if (cast) : no name string
for each name on the name list
invert the declarator list(s) and attatch basetype
watch out for class object initializers
convert
struct s { int a; } a;
into
struct s { int a; }; struct s a;
*/
{
Pname n;
Pname nn;
TOK stc = b->b_sto;
bit tpdf = b->b_typedef;
bit inli = b->b_inline;
bit virt = b->b_virtual;
Pfct f;
Pname nx;
if (b == 0) error('i',"%d->N.normalize(0)",this);
if (this == 0) error('i',"0->N.normalize(%k)",base);
if (inli && stc==EXTERN) {
error("both extern and inline");
inli = 0;
}
//fprintf(stderr,"name.norm(%d %s) tp (%d %d)\n",this,string,tp,tp->base);
if (stc==FRIEND && tp==0) {
/* friend x;
must be handled during syntax analysis to cope with
class x { friend y; y* p; };
"y" is not local to "x":
class x { friend y; ... }; y* p;
is legal
*/
if (b->base) error(0,"T specified for friend");
if (n_list) {
error("L of friends");
n_list = 0;
}
Pname nx = tname(CLASS);
modified_tn = modified_tn->l; /* global */
n_sto = FRIEND;
tp = nx->tp;
return this;
}
if (tp
&& n_oper==TNAME
&& tp->base==FCT) { /* HORRIBLE FUDGE: fix the bad grammar */
Pfct f = (Pfct)tp;
Pfct f2 = (Pfct)f->returns;
if (f2 && f2->base==FCT) {
Pexpr e = f2->argtype;
//error('d',"%s: mis-analyzedP toF",string);
if (e->base == ELIST) {
// get the real name, fix its type
if (e->e2 || e->e1->base!=DEREF) goto zse1;
Pname rn = (Pname)e->e1->e1;
if (rn->base!=NAME) goto zse1;
f->returns = new ptr(PTR,0);
b = new basetype(TYPE,ktbl->look(string,0));
n_oper = 0;
string = rn->string;
base = NAME;
//error('d',"realN %n b==%t",rn,b);
}
}
}
zse1:
if (cast) string = "";
b = b->check(this);
switch (b->base) { // separate class definitions
// from object and function type declarations
case COBJ:
nn = b->b_name;
//fprintf(stderr,"COBJ (%d %s) -> (%d %d body=%d)\n",nn,nn->string,nn->tp,nn->tp->base,Pclass(nn->tp)->c_body);
if (Pclass(nn->tp)->c_body==2) { /* first occurrence */
if (tp && tp->base==FCT) {
error('s',&this->where,"%k%n defined as returnT for%n (did you forget a ';' after '}' ?)",Pclass(nn->tp)->csu,nn,this);
nn = this;
break;
}
nn->n_list = this;
Pclass(nn->tp)->c_body = 1; /* other occurences */
}
else
nn = this;
break;
case EOBJ:
nn = b->b_name;
if (Penum(nn->tp)->e_body==2) {
if (tp && tp->base==FCT) {
error('s',"enum%n defined as returnT for%n (did you forget a ';'?)",nn,this);
nn = this;
break;
}
nn->n_list = this;
Penum(nn->tp)->e_body = 1;
}
else
nn = this;
break;
default:
nn = this;
}
for (n=this; n; n=nx) {
Ptype t = n->tp;
nx = n->n_list;
n->n_sto = stc;
/*
if (t
&& n_oper==TNAME
&& t->base==FCT) { // HORRIBLE FUDGE: fix the bad grammar
Pfct f = (Pfct)t;
Pfct f2 = (Pfct)f->returns;
if (f2 && f2->base==FCT) {
Pexpr e = f2->argtype;
if (e->base == ELIST) {
// get the real name, fix its type
if (e->e2 || e->e1->base!=DEREF) goto zse;
Pname rn = (Pname)e->e1->e1;
if (rn->base!=NAME) goto zse;
f->returns = new ptr(PTR,0);
b = new basetype(TYPE,ktbl->look(n->string,0));
n->n_oper = 0;
n->string = rn->string;
n->base = NAME;
}
}
}
zse:
*/
if (n->base == TNAME) error('i',"redefinition ofTN%n",n);
if (t == 0) {
if (bl == 0)
n->tp = t = b;
else {
error("body of nonF%n",n);
t = new fct(defa_type,0,0);
}
}
switch (t->base) {
case PTR:
case RPTR:
n->tp = Pptr(t)->normalize(b);
break;
case VEC:
n->tp = Pvec(t)->normalize(b);
break;
case FCT:
n->tp = Pfct(t)->normalize(b);
break;
case FIELD:
if (n->string == 0) n->string = make_name('F');
n->tp = t;
Pbase tb = b;
flatten:
//error('d',"flatten %d %d %d",tb->base,b->b_unsigned,b->b_const);
switch (tb->base) {
case TYPE: /* chase typedefs */
tb = (Pbase)tb->b_name->tp;
goto flatten;
case INT:
Pbase(t)->b_fieldtype = (b->b_unsigned) ? uint_type : int_type;
goto iii;
case CHAR:
Pbase(t)->b_fieldtype = (b->b_unsigned) ? uchar_type : char_type;
goto iii;
case SHORT:
Pbase(t)->b_fieldtype = (b->b_unsigned) ? ushort_type : short_type;
goto iii;
iii:
Pbase(t)->b_unsigned = b->b_unsigned;
Pbase(t)->b_const = b->b_const;
break;
default:
error("non-int field");
n->tp = defa_type;
}
break;
}
f = (Pfct) n->tp;
if (f->base != FCT) {
if (bl) {
error("body for nonF%n",n);
n->tp = f = new fct(defa_type,0,0);
continue;
}
if (inli) error("inline nonF%n",n);
if (virt) error("virtual nonF%n",n);
if (tpdf) {
if (n->n_initializer) {
error("Ir for typedefN%n",n);
n->n_initializer = 0;
}
n->tdef();
}
continue;
}
f->f_inline = inli;
f->f_virtual = virt;
if (tpdf) {
if (f->body = bl) error("typedef%n { ... }",n);
n->tdef();
continue;
}
if (f->body = bl) continue;
/*
Check function declarations.
Look for class object instansiations
The real ambiguity: ; class x fo();
is interpreted as an extern function
declaration NOT a class object with an
empty initializer
*/
{ Pname cn = f->returns->is_cl_obj();
bit clob = (cn || cl_obj_vec);
//error('d',"%n: fr%t cn%n",n,f->returns,cn);
if (f->argtype) { /* check argument/initializer list */
Pname nn;
for (nn=f->argtype; nn; nn=nn->n_list) {
if (nn->base != NAME) {
if (!clob) {
error("ATX for%n",n);
goto zzz;
}
goto is_obj;
}
/*
if (nn->string) {
error("AN%n inD of%n",nn,n);
nn->string = 0;
}
*/
if (nn->tp) goto ok;
}
if (!clob) {
error("FALX");
goto zzz;
}
is_obj:
//fprintf(stderr,"is_obj: %d %s tp = %d %d\n",this,string,f->returns,f->returns->base); fflush(stderr);
/* it was an initializer: expand to constructor */
n->tp = f->returns;
if (f->argtype->base != ELIST) f->argtype = (Pname)new expr(ELIST,(Pexpr)f->argtype,0);
n->n_initializer = new texpr(VALUE,cn->tp,(Pexpr)f->argtype);
goto ok;
zzz:
if (f->argtype) {
DEL(f->argtype);
f->argtype = 0;
f->nargs = 0;
f->nargs_known = !fct_void;
}
}
else { /* T a(); => function declaration */
/*
if (clob) {
DEL(n->tp);
n->tp = f->returns;
}
*/
}
ok:
;
}
}
return nn;
}
Pname basetype.aggr()
/*
"type SM" seen e.g. struct s {};
class x;
enum e;
int tname;
friend cname;
friend class x;
int;
convert
union { ... };
into
union name { ... } name ;
*/
{
Pname n;
if (b_xname) {
if (base) {
Pname n = new name(b_xname->string);
b_xname->hide();
b_xname = 0;
return n->normalize(this,0,0);
}
else {
base = TYPE;
b_name = b_xname;
b_xname = 0;
}
}
switch (base) {
case COBJ:
{ Pclass cl = (Pclass)b_name->tp;
char* s = cl->string;
/*fprintf(stderr,"COBJ (%d %s) -> (%d %d) ->(%d %d)\n",this,b_name->string,b_name,b_name->base,cl,cl->base);*/
if (b_name->base == TNAME) error('i',"TN%n inCO",b_name);
if (b_const) error("const%k%n",cl->csu,b_name);
if (cl->c_body == 2) { /* body seen */
if (s[0]=='_' && s[1]=='C') {
char* ss = new char[5];
Pname obj = new name(ss);
if (cl->csu == UNION) {
strcpy(ss,s);
ss[1] = 'O';
cl->csu = ANON;
return obj->normalize(this,0,0);
}
error('w',"un-usable%k ignored",cl->csu);
}
cl->c_body = 1;
return b_name;
}
else { /* really a typedef for cfront only: class x; */
if (b_sto == FRIEND) goto frr;
return 0;
}
}
case EOBJ:
{ Penum en = (Penum)b_name->tp;
/*fprintf(stderr,"EOBJ (%d %s) -> (%d %d) ->(%d %d)\n",this,b_name->string,b_name,b_name->base,en,en->base);*/
if (b_name->base == TNAME) error('i',"TN%n in enumO",b_name);
if (b_const) error("const enum%n",b_name);
if (en->e_body == 2) {
en->e_body = 1;
return b_name;
}
else {
if (b_sto == FRIEND) goto frr;
return 0;
}
}
default:
if (b_typedef) error('w',"illegal typedef ignored");
if (b_sto == FRIEND) {
frr:
Pname fr = ktbl->look(b_name->string,0);
if (fr == 0) error('i',"cannot find friend%n",b_name);
n = new name(b_name->string);
n->n_sto = FRIEND;
n->tp = fr->tp;
return n;
}
else {
n = new name(make_name('D'));
n->tp = any_type;
error('w',"NX inDL");
return n;
}
}
}
Pbase basetype.check(Pname n)
/*
"n" is the first name to be declared using "this"
check the consistency of "this"
and use "b_xname" for "n->string" if possible and needed
*/
{
b_inline = 0;
b_virtual = 0;
//fprintf(stderr,"check n: %d %s n_oper %d b: %d %d %s\n",n,(n)?n->string:"",n?n->n_oper:0,this,base,(b_name)?b_name->string:"");fflush(stderr);
if (b_xname && (n->tp || n->string)) {
if (base)
error("badBT:%k%n",base,b_xname);
else {
base = TYPE;
b_name = b_xname;
}
b_xname = 0;
}
if (b_xname) {
if (n->string)
error("twoNs inD:%n%n",b_xname,n);
else {
n->string = b_xname->string;
b_xname->hide();
}
b_xname = 0;
}
if (ccl==0
&& n
&& n->n_oper==TNAME
&& n->n_qualifier==0
&& n->string) { // hide type name
Pname nx = ktbl->look(n->string,0);
if (nx) nx->hide();
}
switch (base) {
case 0:
base = INT;
break;
case EOBJ:
case COBJ:
if (b_name->base == TNAME)
error('i',"TN%n inCO %d",b_name,this);
}
if (b_long || b_short) {
TOK sl = (b_short) ? SHORT : LONG;
if (b_long && b_short) error("badBT:long short%k%n",base,n);
if (base != INT)
error("badBT:%k%k%n",sl,base,n);
else
base = sl;
b_short = b_long = 0;
}
if (b_typedef && b_sto) error("badBT:typedef%k%n",b_sto,n);
b_typedef = b_sto = 0;
if (Pfctvec_type == 0) return this;
if (b_const) {
if (b_unsigned) {
switch (base) {
default:
error("badBT: unsigned const %k%n",base,n);
b_unsigned = 0;
case LONG:
case SHORT:
case INT:
case CHAR:
return this;
}
}
return this;
}
else if (b_unsigned) {
switch (base) {
case LONG:
delete this;
return ulong_type;
case SHORT:
delete this;
return ushort_type;
case INT:
delete this;
return uint_type;
case CHAR:
delete this;
return uchar_type;
default:
error("badBT: unsigned%k%n",base,n);
b_unsigned = 0;
return this;
}
}
else {
switch (base) {
case LONG:
delete this;
return long_type;
case SHORT:
delete this;
return short_type;
case INT:
if (this != int_type) delete this;
return int_type;
case CHAR:
delete this;
return char_type;
case VOID:
delete this;
return void_type;
case TYPE:
/* use a single base saved in the keyword */
//fprintf(stderr,"type %d bn %d %s q %d\n",this,b_name,b_name->string,b_name->n_qualifier);
if (b_name->n_qualifier) {
delete this;
return (Pbase)b_name->n_qualifier;
}
else {
PERM(this);
b_name->n_qualifier = (Pname)this;
return this;
}
default:
return this;
}
}
}