dcl2.c

c 语言编译器 源代码- c compiler

			{	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 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;
}

int name.no_of_names()
{
	register int i = 0;
	register Pname n;
	for (n=this; n; n=n->n_list) i++;
	return i;
}

static Pexpr lvec[20], *lll;
static Pexpr list_back = 0;
#define list_put_back(x) list_back = x;

void new_list(Pexpr lx)
{
	if (lx->base != ILIST) error('i',"IrLX");

	lll = lvec;
	lll++;
	*lll = lx->e1;
}

Pexpr next_elem()
{
	Pexpr e;
	Pexpr lx;

	if (lll == lvec) return 0;

 	lx = *lll;

	if (list_back) {
		e = list_back;
		list_back = 0;
		return e;
	}

	if (lx == 0) {				/* end of list */
		lll--;
		return 0;
	}

	switch (lx->base) {
	case ELIST:
		e = lx->e1;
		*lll = lx->e2;
		switch (e->base) {
		case ILIST:
			lll++;
			*lll = e->e1;
			return (Pexpr)1;	/* start of new ILIST */
		case ELIST:
			error("nestedEL");
			return 0;
		default:
			return e;
		}
	default:
		error('i',"IrL");
	}
}

void list_check(Pname nn, Ptype t, Pexpr il)
/*
	see if the list "lll" can be assigned to something of type "t"
	"nn" is the name of the variable for which the assignment is taking place.
	"il" is the last list element returned by next_elem()
*/
{
	Pexpr e;
	bit lst = 0;
	int i;
	Pclass cl;
//error('d',"list_check%n: %t (%d)",nn,t,il);
	switch ( (int)il ) {
	case 0:		break;
	case 1:		lst = 1; break;
	default:	list_put_back(il);
	}

zzz:
	switch (t->base) {
	case TYPE:
		t = Pbase(t)->b_name->tp;
		goto zzz;

	case VEC:
	{	Pvec v = (Pvec)t;
		Ptype vt = v->typ;

		if (v->size) {	/* get at most v->size initializers */
			if (v->typ->base == CHAR) {
				e = next_elem();
				if (e->base == STRING) {	// v[size] = "..."
					int isz = Pvec(e->tp)->size;
					if (v->size < isz) error("Ir too long (%d characters) for%n[%d]",isz,nn,v->size);
					break;
				}
				else
					list_put_back(e);
			}
			for (i=0; i<v->size; i++) { // check next list element type
			ee:
				e = next_elem();
				if (e == 0) goto xsw; // too few initializers are ok
			vtz:
//error('d',"vtz: %d",vt->base);
				switch (vt->base) {
				case TYPE:
					vt = Pbase(vt)->b_name->tp;
					goto vtz;
				case VEC:
				case COBJ:
					list_check(nn,vt,e);
					break;
				default:
					if (e == (Pexpr)1) {
						error("unXIrL");
						goto ee;
					}
					if (vt->check(e->tp,ASSIGN))
						error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
				}
			}
			if ( lst && (e=next_elem()) ) error("end ofIrLX after vector");
		xsw:;
		}
		else {		/* determine v->size */
			i = 0;
		xx:
			while ( e=next_elem() ) {	// get another initializer
				i++;
			vtzz:
//error('d',"vtzz: %d",vt->base);
				switch (vt->base) {
				case TYPE:
					vt = Pbase(vt)->b_name->tp;
					goto vtzz;
				case VEC:
				case COBJ:
					list_check(nn,vt,e);
					break;
				default:
					if (e == (Pexpr)1) {
						error("unXIrL");
						goto xx;
					}
					if (vt->check(e->tp,ASSIGN))
						error("badIrT for%n:%t (%tX)",nn,e->tp,vt);
				}
			}
			v->size = i;
		}
		break;
	}

	case CLASS:
		cl = (Pclass)t;
		goto ccc;

	case COBJ:	/* initialize members */
		cl = Pclass(Pbase(t)->b_name->tp);
	ccc:
	{	Ptable tbl = cl->memtbl;
		Pname m;

		if (cl->clbase) list_check(nn,cl->clbase->tp,0);

		for (m=tbl->get_mem(i=1); m; m=tbl->get_mem(++i)) {
			Ptype mt = m->tp;
			switch (mt->base) {
			case FCT:
			case OVERLOAD:
			case CLASS:
			case ENUM:
				continue;
			}
			if (m->n_stclass == STATIC) continue;
			/* check assignment to next member */
		dd:
			e = next_elem();
			if (e == 0) return; //break;
		mtz:
//error('d',"mtz%n: %d",m,mt->base);
			switch (mt->base) {
			case TYPE:
				mt = Pbase(mt)->b_name->tp;
				goto mtz;
			case CLASS:
			case ENUM:
				break;
			case VEC:
			case COBJ:
				list_check(nn,m->tp,e);
				break;
			default:
				if (e == (Pexpr)1) {
					error("unXIrL");
					goto dd;
				}
				if (mt->check(e->tp,ASSIGN))
					error("badIrT for%n:%t (%tX)",m,e->tp,m->tp);
			}
		}
		if (lst && (e=next_elem()) ) error("end ofIrLX afterCO");
		break;
	}
	default:
		e = next_elem();

		if (e == 0) {
			error("noIr forO");
			break;
		}
		
		if (e == (Pexpr)1) {
			error("unXIrL");
			break;
		}
		if (t->check(e->tp,ASSIGN)) error("badIrT for%n:%t (%tX)",nn,e->tp,t);
		if (lst && (e=next_elem()) ) error("end ofIrLX afterO");
		break;
	}
}