many bug fixes, and added flexibility in alignments
This commit is contained in:
		
							parent
							
								
									da54801353
								
							
						
					
					
						commit
						a0c21bf820
					
				
					 13 changed files with 337 additions and 122 deletions
				
			
		|  | @ -1 +1 @@ | ||||||
| char Version[] = "ACK Modula-2 compiler Version 0.8"; | static char Version[] = "ACK Modula-2 compiler Version 0.9"; | ||||||
|  |  | ||||||
|  | @ -540,7 +540,7 @@ ChkProcCall(expp) | ||||||
| 		if (left->nd_symb == STRING) { | 		if (left->nd_symb == STRING) { | ||||||
| 			TryToString(left, TypeOfParam(param)); | 			TryToString(left, TypeOfParam(param)); | ||||||
| 		} | 		} | ||||||
| 		else if (! TstParCompat(RemoveEqual(TypeOfParam(param)), | 		if (! TstParCompat(RemoveEqual(TypeOfParam(param)), | ||||||
| 				   left->nd_type, | 				   left->nd_type, | ||||||
| 				   IsVarParam(param), | 				   IsVarParam(param), | ||||||
| 				   left)) { | 				   left)) { | ||||||
|  | @ -1017,10 +1017,14 @@ ChkStandard(expp, left) | ||||||
| 	case S_TSIZE:	/* ??? */ | 	case S_TSIZE:	/* ??? */ | ||||||
| 	case S_SIZE: | 	case S_SIZE: | ||||||
| 		expp->nd_type = intorcard_type; | 		expp->nd_type = intorcard_type; | ||||||
| 		if (! getname(&arg, D_FIELD|D_VARIABLE|D_ISTYPE, 0, edf)) { | 		if (!(left = getname(&arg,D_FIELD|D_VARIABLE|D_ISTYPE,0,edf))) { | ||||||
| 			return 0; | 			return 0; | ||||||
| 		} | 		} | ||||||
| 		cstcall(expp, S_SIZE); | 		if (! IsConformantArray(left->nd_type)) cstcall(expp, S_SIZE); | ||||||
|  | 		else node_warning(expp, | ||||||
|  | 				  W_STRICT, | ||||||
|  | 				  "%s on conformant array", | ||||||
|  | 				  expp->nd_left->nd_def->df_idf->id_text); | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case S_TRUNC: | 	case S_TRUNC: | ||||||
|  |  | ||||||
|  | @ -65,27 +65,6 @@ CodeString(nd) | ||||||
| 	} | 	} | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| STATIC |  | ||||||
| CodePadString(nd, sz) |  | ||||||
| 	register struct node *nd; |  | ||||||
| 	arith sz; |  | ||||||
| { |  | ||||||
| 	/*	Generate code to push the string indicated by "nd".
 |  | ||||||
| 		Make it null-padded to "sz" bytes |  | ||||||
| 	*/ |  | ||||||
| 	register arith sizearg = WA(nd->nd_type->tp_size); |  | ||||||
| 
 |  | ||||||
| 	assert(nd->nd_type->tp_fund == T_STRING); |  | ||||||
| 
 |  | ||||||
| 	if (sizearg != sz) { |  | ||||||
| 		/* null padding required */ |  | ||||||
| 		assert(sizearg < sz); |  | ||||||
| 		C_zer(sz - sizearg); |  | ||||||
| 	} |  | ||||||
| 	CodeString(nd);		/* push address of string */ |  | ||||||
| 	C_loi(sizearg); |  | ||||||
| } |  | ||||||
| 
 |  | ||||||
| CodeExpr(nd, ds, true_label, false_label) | CodeExpr(nd, ds, true_label, false_label) | ||||||
| 	register struct node *nd; | 	register struct node *nd; | ||||||
| 	register struct desig *ds; | 	register struct desig *ds; | ||||||
|  | @ -180,7 +159,7 @@ CodeExpr(nd, ds, true_label, false_label) | ||||||
| 	if (true_label != 0) { | 	if (true_label != 0) { | ||||||
| 		/* Only for boolean expressions
 | 		/* Only for boolean expressions
 | ||||||
| 		*/ | 		*/ | ||||||
| 		CodeValue(ds, tp->tp_size); | 		CodeValue(ds, tp->tp_size, tp->tp_align); | ||||||
| 		*ds = InitDesig; | 		*ds = InitDesig; | ||||||
| 		C_zne(true_label); | 		C_zne(true_label); | ||||||
| 		C_bra(false_label); | 		C_bra(false_label); | ||||||
|  | @ -422,7 +401,16 @@ CodeParameters(param, arg) | ||||||
| 		return; | 		return; | ||||||
| 	} | 	} | ||||||
| 	if (left_type->tp_fund == T_STRING) { | 	if (left_type->tp_fund == T_STRING) { | ||||||
| 		CodePadString(left, tp->tp_size); | 		register arith szarg = WA(left_type->tp_size); | ||||||
|  | 		arith sz = WA(tp->tp_size); | ||||||
|  | 
 | ||||||
|  | 		if (szarg != sz) { | ||||||
|  | 			/* null padding required */ | ||||||
|  | 			assert(szarg < sz); | ||||||
|  | 			C_zer(sz - szarg); | ||||||
|  | 		} | ||||||
|  | 		CodeString(left);	/* push address of string */ | ||||||
|  | 		C_loi(szarg); | ||||||
| 		return; | 		return; | ||||||
| 	} | 	} | ||||||
| 	CodePExpr(left); | 	CodePExpr(left); | ||||||
|  | @ -480,6 +468,15 @@ CodeStd(nd) | ||||||
| 		DoHIGH(left); | 		DoHIGH(left); | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
|  | 	case S_SIZE: | ||||||
|  | 	case S_TSIZE: | ||||||
|  | 		assert(IsConformantArray(tp)); | ||||||
|  | 		DoHIGH(left); | ||||||
|  | 		C_inc(); | ||||||
|  | 		C_loc(tp->arr_elem->tp_size); | ||||||
|  | 		C_mlu(word_size); | ||||||
|  | 		break; | ||||||
|  | 
 | ||||||
| 	case S_ODD: | 	case S_ODD: | ||||||
| 		CodePExpr(left); | 		CodePExpr(left); | ||||||
| 		if (tp->tp_size == word_size) { | 		if (tp->tp_size == word_size) { | ||||||
|  | @ -951,7 +948,7 @@ CodeEl(nd, tp) | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| CodePExpr(nd) | CodePExpr(nd) | ||||||
| 	struct node *nd; | 	register struct node *nd; | ||||||
| { | { | ||||||
| 	/*	Generate code to push the value of the expression "nd"
 | 	/*	Generate code to push the value of the expression "nd"
 | ||||||
| 		on the stack. | 		on the stack. | ||||||
|  | @ -960,7 +957,7 @@ CodePExpr(nd) | ||||||
| 
 | 
 | ||||||
| 	designator = InitDesig; | 	designator = InitDesig; | ||||||
| 	CodeExpr(nd, &designator, NO_LABEL, NO_LABEL); | 	CodeExpr(nd, &designator, NO_LABEL, NO_LABEL); | ||||||
| 	CodeValue(&designator, nd->nd_type->tp_size); | 	CodeValue(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align); | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| CodeDAddress(nd) | CodeDAddress(nd) | ||||||
|  | @ -988,7 +985,7 @@ CodeDStore(nd) | ||||||
| 
 | 
 | ||||||
| 	designator = InitDesig; | 	designator = InitDesig; | ||||||
| 	CodeDesig(nd, &designator); | 	CodeDesig(nd, &designator); | ||||||
| 	CodeStore(&designator, nd->nd_type->tp_size); | 	CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align); | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| DoHIGH(nd) | DoHIGH(nd) | ||||||
|  | @ -1006,8 +1003,9 @@ DoHIGH(nd) | ||||||
| 	assert(IsConformantArray(df->df_type)); | 	assert(IsConformantArray(df->df_type)); | ||||||
| 
 | 
 | ||||||
| 	highoff = df->var_off		/* base address and descriptor */ | 	highoff = df->var_off		/* base address and descriptor */ | ||||||
| 		  + pointer_size	/* skip base address */ | 		  + 2 * word_size;	/* skip base and first field of
 | ||||||
| 		  + word_size;		/* skip first field of descriptor */ | 					   descriptor | ||||||
|  | 					*/ | ||||||
| 	if (df->df_scope->sc_level < proclevel) { | 	if (df->df_scope->sc_level < proclevel) { | ||||||
| 		C_lxa((arith) (proclevel - df->df_scope->sc_level)); | 		C_lxa((arith) (proclevel - df->df_scope->sc_level)); | ||||||
| 		C_lof(highoff); | 		C_lof(highoff); | ||||||
|  |  | ||||||
|  | @ -469,7 +469,7 @@ cstcall(expp, call) | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case S_SIZE: | 	case S_SIZE: | ||||||
| 		expp->nd_INT = WA(expr->nd_type->tp_size); | 		expp->nd_INT = expr->nd_type->tp_size; | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case S_VAL: | 	case S_VAL: | ||||||
|  |  | ||||||
|  | @ -62,11 +62,11 @@ block(struct node **pnd;) : | ||||||
| ; | ; | ||||||
| 
 | 
 | ||||||
| declaration: | declaration: | ||||||
| 	CONST [ ConstantDeclaration ';' ]* | 	CONST [ %persistent ConstantDeclaration ';' ]* | ||||||
| | | | | ||||||
| 	TYPE [ TypeDeclaration ';' ]* | 	TYPE [ %persistent TypeDeclaration ';' ]* | ||||||
| | | | | ||||||
| 	VAR [ VariableDeclaration ';' ]* | 	VAR [ %persistent VariableDeclaration ';' ]* | ||||||
| | | | | ||||||
| 	ProcedureDeclaration ';' | 	ProcedureDeclaration ';' | ||||||
| | | | | ||||||
|  | @ -239,7 +239,7 @@ RecordType(struct type **ptp;) | ||||||
| 		  close_scope(0); | 		  close_scope(0); | ||||||
| 		} | 		} | ||||||
| 	FieldListSequence(scope, &size, &xalign) | 	FieldListSequence(scope, &size, &xalign) | ||||||
| 		{ *ptp = standard_type(T_RECORD, xalign, WA(size)); | 		{ *ptp = standard_type(T_RECORD, xalign, size); | ||||||
| 		  (*ptp)->rec_scope = scope; | 		  (*ptp)->rec_scope = scope; | ||||||
| 		} | 		} | ||||||
| 	END | 	END | ||||||
|  | @ -525,5 +525,8 @@ VariableDeclaration | ||||||
| 
 | 
 | ||||||
| IdentAddr(struct node **pnd;) : | IdentAddr(struct node **pnd;) : | ||||||
| 	IDENT		{ *pnd = MkLeaf(Name, &dot); } | 	IDENT		{ *pnd = MkLeaf(Name, &dot); } | ||||||
| 	ConstExpression(&((*pnd)->nd_left))? | 	[	'[' | ||||||
|  | 		ConstExpression(&((*pnd)->nd_left)) | ||||||
|  | 		']' | ||||||
|  | 	]? | ||||||
| ; | ; | ||||||
|  |  | ||||||
|  | @ -131,6 +131,9 @@ define(id, scope, kind) | ||||||
| 			} | 			} | ||||||
| 			break; | 			break; | ||||||
| 
 | 
 | ||||||
|  | 		case D_TYPE: | ||||||
|  | 			if (kind == D_FORWTYPE) return df; | ||||||
|  | 			break; | ||||||
| 		case D_FORWTYPE: | 		case D_FORWTYPE: | ||||||
| 			if (kind == D_FORWTYPE) return df; | 			if (kind == D_FORWTYPE) return df; | ||||||
| 			if (kind == D_TYPE) { | 			if (kind == D_TYPE) { | ||||||
|  |  | ||||||
|  | @ -103,7 +103,7 @@ GetDefinitionModule(id, incr) | ||||||
| 			df->mod_vis = vis; | 			df->mod_vis = vis; | ||||||
| 		} | 		} | ||||||
| 	} | 	} | ||||||
| 	else if (df == Defined) { | 	else if (df == Defined && level == 1) { | ||||||
| 		error("cannot import from currently defined module"); | 		error("cannot import from currently defined module"); | ||||||
| 		df->df_kind = D_ERROR; | 		df->df_kind = D_ERROR; | ||||||
| 	} | 	} | ||||||
|  |  | ||||||
|  | @ -24,39 +24,85 @@ | ||||||
| extern int	proclevel; | extern int	proclevel; | ||||||
| struct desig	InitDesig = {DSG_INIT, 0, 0}; | struct desig	InitDesig = {DSG_INIT, 0, 0}; | ||||||
| 
 | 
 | ||||||
| CodeValue(ds, size) | STATIC int | ||||||
|  | properly(ds, size, al) | ||||||
|  | 	register struct desig *ds; | ||||||
|  | 	arith size; | ||||||
|  | { | ||||||
|  | 	/*	Check if it is allowed to load or store the value indicated
 | ||||||
|  | 		by "ds" with LOI/STI. | ||||||
|  | 		- if the size is not either a multiple or a dividor of the | ||||||
|  | 		  wordsize, then not. | ||||||
|  | 		- if the alignment is at least "word" then OK. | ||||||
|  | 		- if size is dividor of word_size and alignment >= size then OK. | ||||||
|  | 		- otherwise check alignment of address. This can only be done | ||||||
|  | 		  with DSG_FIXED. | ||||||
|  | 	*/ | ||||||
|  | 
 | ||||||
|  | 	arith szmodword = size % word_size;	/* 0 if multiple of wordsize */ | ||||||
|  | 	arith wordmodsz = word_size % size;	/* 0 if dividor of wordsize */ | ||||||
|  | 
 | ||||||
|  | 	if (szmodword && wordmodsz) return 0; | ||||||
|  | 	if (al >= word_size) return 1; | ||||||
|  | 	if (szmodword && al >= szmodword) return 1; | ||||||
|  | 
 | ||||||
|  | 	return ds->dsg_kind == DSG_FIXED && | ||||||
|  | 	       ((! szmodword && ds->dsg_offset % word_size == 0) || | ||||||
|  | 		(! wordmodsz && ds->dsg_offset % size == 0)); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | CodeValue(ds, size, al) | ||||||
| 	register struct desig *ds; | 	register struct desig *ds; | ||||||
| 	arith size; | 	arith size; | ||||||
| { | { | ||||||
| 	/*	Generate code to load the value of the designator described
 | 	/*	Generate code to load the value of the designator described
 | ||||||
| 		in "ds" | 		in "ds" | ||||||
| 	*/ | 	*/ | ||||||
|  | 	arith tmp = 0; | ||||||
| 
 | 
 | ||||||
| 	switch(ds->dsg_kind) { | 	switch(ds->dsg_kind) { | ||||||
| 	case DSG_LOADED: | 	case DSG_LOADED: | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case DSG_FIXED: | 	case DSG_FIXED: | ||||||
| 		if (size == word_size) { | 		if (ds->dsg_offset % word_size == 0) {	 | ||||||
| 			if (ds->dsg_name) { | 			if (size == word_size) { | ||||||
| 				C_loe_dnam(ds->dsg_name, ds->dsg_offset); | 				if (ds->dsg_name) { | ||||||
|  | 					C_loe_dnam(ds->dsg_name,ds->dsg_offset); | ||||||
|  | 				} | ||||||
|  | 				else	C_lol(ds->dsg_offset); | ||||||
|  | 				break; | ||||||
| 			} | 			} | ||||||
| 			else	C_lol(ds->dsg_offset); | 	 | ||||||
| 			break; | 			if (size == dword_size) { | ||||||
| 		} | 				if (ds->dsg_name) { | ||||||
| 
 | 					C_lde_dnam(ds->dsg_name,ds->dsg_offset); | ||||||
| 		if (size == dword_size) { | 				} | ||||||
| 			if (ds->dsg_name) { | 				else	C_ldl(ds->dsg_offset); | ||||||
| 				C_lde_dnam(ds->dsg_name, ds->dsg_offset); | 				break; | ||||||
| 			} | 			} | ||||||
| 			else	C_ldl(ds->dsg_offset); |  | ||||||
| 			break; |  | ||||||
| 		} | 		} | ||||||
| 		/* Fall through */ | 		/* Fall through */ | ||||||
| 	case DSG_PLOADED: | 	case DSG_PLOADED: | ||||||
| 	case DSG_PFIXED: | 	case DSG_PFIXED: | ||||||
| 		CodeAddress(ds); | 		if (properly(ds, size, al)) { | ||||||
| 		C_loi(size); | 			CodeAddress(ds); | ||||||
|  | 			C_loi(size); | ||||||
|  | 			break; | ||||||
|  | 		} | ||||||
|  | 		if (ds->dsg_kind == DSG_PLOADED) { | ||||||
|  | 			tmp = NewPtr(); | ||||||
|  | 			C_stl(tmp); | ||||||
|  | 		} | ||||||
|  | 		C_asp(-WA(size)); | ||||||
|  | 		if (!tmp) CodeAddress(ds); | ||||||
|  | 		else { | ||||||
|  | 			C_lol(tmp); | ||||||
|  | 			FreePtr(tmp); | ||||||
|  | 		} | ||||||
|  | 		C_loc(size); | ||||||
|  | 		C_cal("_load"); | ||||||
|  | 		C_asp(2 * word_size); | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case DSG_INDEXED: | 	case DSG_INDEXED: | ||||||
|  | @ -70,36 +116,46 @@ CodeValue(ds, size) | ||||||
| 	ds->dsg_kind = DSG_LOADED; | 	ds->dsg_kind = DSG_LOADED; | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| CodeStore(ds, size) | CodeStore(ds, size, al) | ||||||
| 	register struct desig *ds; | 	register struct desig *ds; | ||||||
| 	arith size; | 	arith size; | ||||||
| { | { | ||||||
| 	/*	Generate code to store the value on the stack in the designator
 | 	/*	Generate code to store the value on the stack in the designator
 | ||||||
| 		described in "ds" | 		described in "ds" | ||||||
| 	*/ | 	*/ | ||||||
|  | 	struct desig save; | ||||||
| 
 | 
 | ||||||
|  | 	save = *ds; | ||||||
| 	switch(ds->dsg_kind) { | 	switch(ds->dsg_kind) { | ||||||
| 	case DSG_FIXED: | 	case DSG_FIXED: | ||||||
| 		if (size == word_size) { | 		if (ds->dsg_offset % word_size == 0) { | ||||||
| 			if (ds->dsg_name) { | 			if (size == word_size) { | ||||||
| 				C_ste_dnam(ds->dsg_name, ds->dsg_offset); | 				if (ds->dsg_name) { | ||||||
|  | 					C_ste_dnam(ds->dsg_name,ds->dsg_offset); | ||||||
|  | 				} | ||||||
|  | 				else	C_stl(ds->dsg_offset); | ||||||
|  | 				break; | ||||||
| 			} | 			} | ||||||
| 			else	C_stl(ds->dsg_offset); |  | ||||||
| 			break; |  | ||||||
| 		} |  | ||||||
| 
 | 
 | ||||||
| 		if (size == dword_size) { | 			if (size == dword_size) { | ||||||
| 			if (ds->dsg_name) { | 				if (ds->dsg_name) { | ||||||
| 				C_sde_dnam(ds->dsg_name, ds->dsg_offset); | 					C_sde_dnam(ds->dsg_name,ds->dsg_offset); | ||||||
|  | 				} | ||||||
|  | 				else	C_sdl(ds->dsg_offset); | ||||||
|  | 				break; | ||||||
| 			} | 			} | ||||||
| 			else	C_sdl(ds->dsg_offset); |  | ||||||
| 			break; |  | ||||||
| 		} | 		} | ||||||
| 		/* Fall through */ | 		/* Fall through */ | ||||||
| 	case DSG_PLOADED: | 	case DSG_PLOADED: | ||||||
| 	case DSG_PFIXED: | 	case DSG_PFIXED: | ||||||
| 		CodeAddress(ds); | 		CodeAddress(&save); | ||||||
| 		C_sti(size); | 		if (properly(ds, size, al)) { | ||||||
|  | 			C_sti(size); | ||||||
|  | 			break; | ||||||
|  | 		} | ||||||
|  | 		C_loc(size); | ||||||
|  | 		C_cal("_store"); | ||||||
|  | 		C_asp(2 * word_size + WA(size)); | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case DSG_INDEXED: | 	case DSG_INDEXED: | ||||||
|  | @ -113,6 +169,146 @@ CodeStore(ds, size) | ||||||
| 	ds->dsg_kind = DSG_INIT; | 	ds->dsg_kind = DSG_INIT; | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
|  | CodeCopy(lhs, rhs, sz, psize) | ||||||
|  | 	register struct desig *lhs, *rhs; | ||||||
|  | 	arith sz, *psize; | ||||||
|  | { | ||||||
|  | 	struct desig l, r; | ||||||
|  | 
 | ||||||
|  | 	l = *lhs; r = *rhs; | ||||||
|  | 	*psize -= sz; | ||||||
|  | 	lhs->dsg_offset += sz; | ||||||
|  | 	rhs->dsg_offset += sz; | ||||||
|  | 	CodeAddress(&r); | ||||||
|  | 	C_loi(sz); | ||||||
|  | 	CodeAddress(&l); | ||||||
|  | 	C_sti(sz); | ||||||
|  | } | ||||||
|  | 
 | ||||||
|  | CodeMove(rhs, left, rtp) | ||||||
|  | 	register struct desig *rhs; | ||||||
|  | 	register struct node *left; | ||||||
|  | 	struct type *rtp; | ||||||
|  | { | ||||||
|  | 	struct desig dsl; | ||||||
|  | 	register struct desig *lhs = &dsl; | ||||||
|  | 	register struct type *tp = left->nd_type; | ||||||
|  | 	int	loadedflag = 0; | ||||||
|  | 
 | ||||||
|  | 	dsl = InitDesig; | ||||||
|  | 
 | ||||||
|  | 	/*	Generate code for an assignment. Testing of type
 | ||||||
|  | 		compatibility and the like is already done. | ||||||
|  | 		Go through some (considerable) trouble to see if a BLM can be | ||||||
|  | 		generated. | ||||||
|  | 	*/ | ||||||
|  | 
 | ||||||
|  | 	switch(rhs->dsg_kind) { | ||||||
|  | 	case DSG_LOADED: | ||||||
|  | 		CodeDesig(left, lhs); | ||||||
|  | 		CodeAddress(lhs); | ||||||
|  | 		if (rtp->tp_fund == T_STRING) { | ||||||
|  | 			C_loc(rtp->tp_size); | ||||||
|  | 			C_loc(tp->tp_size); | ||||||
|  | 			C_cal("_StringAssign"); | ||||||
|  | 			C_asp(word_size << 2); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		CodeStore(lhs, tp->tp_size, tp->tp_align); | ||||||
|  | 		return; | ||||||
|  | 	case DSG_PLOADED: | ||||||
|  | 	case DSG_PFIXED: | ||||||
|  | 		CodeAddress(rhs); | ||||||
|  | 		if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { | ||||||
|  | 			CodeDesig(left, lhs); | ||||||
|  | 			CodeAddress(lhs); | ||||||
|  | 			C_blm(tp->tp_size); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		CodeValue(rhs, tp->tp_size, tp->tp_align); | ||||||
|  | 		CodeDStore(left); | ||||||
|  | 		return; | ||||||
|  | 	case DSG_FIXED: | ||||||
|  | 		CodeDesig(left, lhs); | ||||||
|  | 		if (lhs->dsg_kind == DSG_FIXED && | ||||||
|  | 		    lhs->dsg_offset % word_size == | ||||||
|  | 		    rhs->dsg_offset % word_size) { | ||||||
|  | 			register arith sz; | ||||||
|  | 			arith size = tp->tp_size; | ||||||
|  | 
 | ||||||
|  | 			while (size && (sz = (lhs->dsg_offset % word_size))) { | ||||||
|  | 				/*	First copy up to word-aligned
 | ||||||
|  | 					boundaries | ||||||
|  | 				*/ | ||||||
|  | 				if (sz < 0) sz = -sz;	/* bloody '%' */ | ||||||
|  | 				while (word_size % sz) sz--; | ||||||
|  | 				CodeCopy(lhs, rhs, sz, &size); | ||||||
|  | 			} | ||||||
|  | 			if (size > 3*dword_size) { | ||||||
|  | 				/*	Do a block move
 | ||||||
|  | 				*/ | ||||||
|  | 				struct desig l, r; | ||||||
|  | 
 | ||||||
|  | 				sz = (size / word_size) * word_size; | ||||||
|  | 				l = *lhs; r = *rhs; | ||||||
|  | 				CodeAddress(&r); | ||||||
|  | 				CodeAddress(&l); | ||||||
|  | 				C_blm(sz); | ||||||
|  | 				rhs->dsg_offset += sz; | ||||||
|  | 				lhs->dsg_offset += sz; | ||||||
|  | 				size -= sz; | ||||||
|  | 			} | ||||||
|  | 			else for (sz = dword_size; sz; sz -= word_size) { | ||||||
|  | 				while (size >= sz) { | ||||||
|  | 					/*	Then copy dwords, words.
 | ||||||
|  | 						Depend on peephole optimizer | ||||||
|  | 					*/ | ||||||
|  | 					CodeCopy(lhs, rhs, sz, &size); | ||||||
|  | 				} | ||||||
|  | 			} | ||||||
|  | 			sz = word_size; | ||||||
|  | 			while (size && --sz) { | ||||||
|  | 				/*	And then copy remaining parts
 | ||||||
|  | 				*/ | ||||||
|  | 				while (word_size % sz) sz--; | ||||||
|  | 				while (size >= sz) { | ||||||
|  | 					CodeCopy(lhs, rhs, sz, &size); | ||||||
|  | 				} | ||||||
|  | 			} | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		if (lhs->dsg_kind == DSG_PLOADED || | ||||||
|  | 		    lhs->dsg_kind == DSG_INDEXED) { | ||||||
|  | 			CodeAddress(lhs); | ||||||
|  | 			loadedflag = 1; | ||||||
|  | 		} | ||||||
|  | 		if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { | ||||||
|  | 			CodeAddress(rhs); | ||||||
|  | 			if (loadedflag) C_exg(pointer_size); | ||||||
|  | 			else CodeAddress(lhs); | ||||||
|  | 			C_blm(tp->tp_size); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 		{ | ||||||
|  | 			arith tmp; | ||||||
|  | 
 | ||||||
|  | 			if (loadedflag) {	 | ||||||
|  | 				tmp = NewPtr(); | ||||||
|  | 				lhs->dsg_offset = tmp; | ||||||
|  | 				lhs->dsg_name = 0; | ||||||
|  | 				lhs->dsg_kind = DSG_PFIXED; | ||||||
|  | 				C_stl(tmp);		/* address of lhs */ | ||||||
|  | 			} | ||||||
|  | 			CodeValue(rhs, tp->tp_size, tp->tp_align); | ||||||
|  | 			CodeStore(lhs, tp->tp_size, tp->tp_align); | ||||||
|  | 			if (loadedflag) FreePtr(tmp); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
|  | 	default: | ||||||
|  | 		crash("CodeMove"); | ||||||
|  | 	} | ||||||
|  | } | ||||||
|  | 
 | ||||||
| CodeAddress(ds) | CodeAddress(ds) | ||||||
| 	register struct desig *ds; | 	register struct desig *ds; | ||||||
| { | { | ||||||
|  | @ -136,8 +332,11 @@ CodeAddress(ds) | ||||||
| 		break; | 		break; | ||||||
| 		 | 		 | ||||||
| 	case DSG_PFIXED: | 	case DSG_PFIXED: | ||||||
| 		ds->dsg_kind = DSG_FIXED; | 		if (ds->dsg_name) { | ||||||
| 		CodeValue(ds, pointer_size); | 			C_loe_dnam(ds->dsg_name,ds->dsg_offset); | ||||||
|  | 			break; | ||||||
|  | 		} | ||||||
|  | 		C_lol(ds->dsg_offset); | ||||||
| 		break; | 		break; | ||||||
| 
 | 
 | ||||||
| 	case DSG_INDEXED: | 	case DSG_INDEXED: | ||||||
|  | @ -353,7 +552,7 @@ CodeDesig(nd, ds) | ||||||
| 		case DSG_INDEXED: | 		case DSG_INDEXED: | ||||||
| 		case DSG_PLOADED: | 		case DSG_PLOADED: | ||||||
| 		case DSG_PFIXED: | 		case DSG_PFIXED: | ||||||
| 			CodeValue(ds, pointer_size); | 			CodeValue(ds, pointer_size, pointer_align); | ||||||
| 			ds->dsg_kind = DSG_PLOADED; | 			ds->dsg_kind = DSG_PLOADED; | ||||||
| 			ds->dsg_offset = 0; | 			ds->dsg_offset = 0; | ||||||
| 			break; | 			break; | ||||||
|  |  | ||||||
|  | @ -112,9 +112,11 @@ EnterVarList(Idlist, type, local) | ||||||
| 		if (idlist->nd_left) { | 		if (idlist->nd_left) { | ||||||
| 			/* An address was supplied
 | 			/* An address was supplied
 | ||||||
| 			*/ | 			*/ | ||||||
|  | 			register struct type *tp = idlist->nd_left->nd_type; | ||||||
|  | 
 | ||||||
| 			df->var_addrgiven = 1; | 			df->var_addrgiven = 1; | ||||||
| 			df->df_flags |= D_NOREG; | 			df->df_flags |= D_NOREG; | ||||||
| 			if (idlist->nd_left->nd_type != card_type) { | 			if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){ | ||||||
| 				node_error(idlist->nd_left, | 				node_error(idlist->nd_left, | ||||||
| 					   "illegal type for address"); | 					   "illegal type for address"); | ||||||
| 			} | 			} | ||||||
|  | @ -224,6 +226,11 @@ DoImport(df, scope) | ||||||
| 		/* Also import all definitions that are exported from this
 | 		/* Also import all definitions that are exported from this
 | ||||||
| 		   module | 		   module | ||||||
| 		*/ | 		*/ | ||||||
|  | 		if (df->mod_vis == CurrVis) { | ||||||
|  | 			error("cannot import current module \"%s\"", | ||||||
|  | 				df->df_idf->id_text); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
| 		for (df = df->mod_vis->sc_scope->sc_def; | 		for (df = df->mod_vis->sc_scope->sc_def; | ||||||
| 		     df; | 		     df; | ||||||
| 		     df = df->df_nextinscope) { | 		     df = df->df_nextinscope) { | ||||||
|  | @ -391,11 +398,16 @@ EnterFromImportList(Idlist, FromDef, FromId) | ||||||
| 		break; | 		break; | ||||||
| 	case D_MODULE: | 	case D_MODULE: | ||||||
| 		vis = FromDef->mod_vis; | 		vis = FromDef->mod_vis; | ||||||
|  | 		if (vis == CurrVis) { | ||||||
|  | node_error(FromId, "cannot import from current module \"%s\"", | ||||||
|  | 		        	FromDef->df_idf->id_text); | ||||||
|  | 			return; | ||||||
|  | 		} | ||||||
| 		break; | 		break; | ||||||
| 	default: | 	default: | ||||||
| 		node_error(FromId, "identifier \"%s\" does not represent a module", | node_error(FromId, "identifier \"%s\" does not represent a module", | ||||||
| 		       FromDef->df_idf->id_text); | 		       FromDef->df_idf->id_text); | ||||||
| 		break; | 		return; | ||||||
| 	} | 	} | ||||||
| 
 | 
 | ||||||
| 	for (; idlist; idlist = idlist->next) { | 	for (; idlist; idlist = idlist->next) { | ||||||
|  |  | ||||||
|  | @ -157,10 +157,11 @@ definition | ||||||
| 	register struct def *df; | 	register struct def *df; | ||||||
| 	struct def *dummy; | 	struct def *dummy; | ||||||
| } : | } : | ||||||
| 	CONST [ ConstantDeclaration ';' ]* | 	CONST [ %persistent ConstantDeclaration ';' ]* | ||||||
| | | | | ||||||
| 	TYPE | 	TYPE | ||||||
| 	[ IDENT 	{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } | 	[ %persistent | ||||||
|  | 	  IDENT 	{ df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } | ||||||
| 	  [ '=' type(&(df->df_type)) | 	  [ '=' type(&(df->df_type)) | ||||||
| 	  | /* empty */ | 	  | /* empty */ | ||||||
| 	    /* | 	    /* | ||||||
|  | @ -175,7 +176,7 @@ definition | ||||||
| 	  ';' | 	  ';' | ||||||
| 	]* | 	]* | ||||||
| | | | | ||||||
| 	VAR [ VariableDeclaration ';' ]* | 	VAR [ %persistent VariableDeclaration ';' ]* | ||||||
| | | | | ||||||
| 	ProcedureHeading(&dummy, D_PROCHEAD) | 	ProcedureHeading(&dummy, D_PROCHEAD) | ||||||
| 	';' | 	';' | ||||||
|  |  | ||||||
|  | @ -71,6 +71,10 @@ Forward(tk, ptp) | ||||||
| 	*/ | 	*/ | ||||||
| 	register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE); | 	register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE); | ||||||
| 
 | 
 | ||||||
|  | 	if (df->df_kind == D_TYPE) { | ||||||
|  | 		ptp->next = df->df_type; | ||||||
|  | 		return; | ||||||
|  | 	} | ||||||
| 	df->df_forw_type = ptp; | 	df->df_forw_type = ptp; | ||||||
| 	df->df_forw_node = tk; | 	df->df_forw_node = tk; | ||||||
| } | } | ||||||
|  | @ -106,8 +110,17 @@ chk_forw(pdf) | ||||||
| 
 | 
 | ||||||
| 	while (df = *pdf) { | 	while (df = *pdf) { | ||||||
| 		if (df->df_kind == D_FORWTYPE) { | 		if (df->df_kind == D_FORWTYPE) { | ||||||
| node_error(df->df_forw_node, "type \"%s\" not declared", df->df_idf->id_text); | 			register struct def *df1 = df; | ||||||
| 			FreeNode(df->df_forw_node); | 
 | ||||||
|  | 			*pdf = df->df_nextinscope; | ||||||
|  | 			RemoveFromIdList(df); | ||||||
|  | 			df = lookfor(df->df_forw_node, CurrVis, 1); | ||||||
|  | 			if (! df->df_kind & (D_ERROR|D_FTYPE|D_TYPE)) { | ||||||
|  | node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text); | ||||||
|  | 			} | ||||||
|  | 			df1->df_forw_type->next = df->df_type; | ||||||
|  | 			FreeNode(df1->df_forw_node); | ||||||
|  | 			free_def(df1); | ||||||
| 		} | 		} | ||||||
| 		else if (df->df_kind == D_FTYPE) { | 		else if (df->df_kind == D_FTYPE) { | ||||||
| 			df->df_kind = D_TYPE; | 			df->df_kind = D_TYPE; | ||||||
|  |  | ||||||
|  | @ -31,7 +31,12 @@ statement(register struct node **pnd;) | ||||||
| 				} | 				} | ||||||
| 		ActualParameters(&(nd->nd_right))? | 		ActualParameters(&(nd->nd_right))? | ||||||
| 	| | 	| | ||||||
| 		BECOMES		{ nd = MkNode(Stat, *pnd, NULLNODE, &dot); } | 		[ BECOMES	 | ||||||
|  | 		| '='		{ error("':=' expected instead of '='"); | ||||||
|  | 				  DOT = BECOMES; | ||||||
|  | 				} | ||||||
|  | 		] | ||||||
|  | 				{ nd = MkNode(Stat, *pnd, NULLNODE, &dot); } | ||||||
| 		expression(&(nd->nd_right)) | 		expression(&(nd->nd_right)) | ||||||
| 	] | 	] | ||||||
| 				{ *pnd = nd; } | 				{ *pnd = nd; } | ||||||
|  |  | ||||||
|  | @ -221,9 +221,11 @@ WalkProcedure(procedure) | ||||||
| 						/* upper - lower */ | 						/* upper - lower */ | ||||||
| 				C_inc();	/* gives number of elements */ | 				C_inc();	/* gives number of elements */ | ||||||
| 				C_loc(tp->arr_elem->tp_size); | 				C_loc(tp->arr_elem->tp_size); | ||||||
| 				C_cal("_wa"); | 				C_mli(word_size); | ||||||
| 				C_asp(dword_size); | 				C_loc(word_size - 1); | ||||||
| 				C_lfr(word_size); | 				C_adi(word_size); | ||||||
|  | 				C_loc(word_size); | ||||||
|  | 				C_dvi(word_size); | ||||||
| 						/* size in words */ | 						/* size in words */ | ||||||
| 				C_loc(word_size); | 				C_loc(word_size); | ||||||
| 				C_mli(word_size); | 				C_mli(word_size); | ||||||
|  | @ -241,25 +243,16 @@ WalkProcedure(procedure) | ||||||
| 						*/ | 						*/ | ||||||
| 				C_ass(word_size); | 				C_ass(word_size); | ||||||
| 						/* adjusted stack pointer */ | 						/* adjusted stack pointer */ | ||||||
| 				C_lor((arith) 1); | 				C_lol(param->par_def->var_off); | ||||||
| 						/* destination address (sp),
 |  | ||||||
| 						   also assumes stack grows |  | ||||||
| 						   downwards ??? |  | ||||||
| 						*/ |  | ||||||
| 				C_lal(param->par_def->var_off); |  | ||||||
| 				C_loi(pointer_size); |  | ||||||
| 						/* push source address */ | 						/* push source address */ | ||||||
| 				C_exg(pointer_size); |  | ||||||
| 						/* exchange them */ |  | ||||||
| 				C_lol(tmpvar);	/* push size */ | 				C_lol(tmpvar);	/* push size */ | ||||||
| 				C_bls(word_size); | 				C_cal("_load");	/* copy */ | ||||||
| 						/* copy */ | 				C_asp(2 * word_size); | ||||||
| 				C_lor((arith) 1);	 | 				C_lor((arith) 1);	 | ||||||
| 						/* push new address of array
 | 						/* push new address of array
 | ||||||
| 						   ... downwards ... ??? | 						   ... downwards ... ??? | ||||||
| 						*/ | 						*/ | ||||||
| 				C_lal(param->par_def->var_off); | 				C_stl(param->par_def->var_off); | ||||||
| 				C_sti(pointer_size); |  | ||||||
| 				FreeInt(tmpvar); | 				FreeInt(tmpvar); | ||||||
| 			} | 			} | ||||||
| 		} | 		} | ||||||
|  | @ -529,7 +522,7 @@ WalkStat(nd, exit_label) | ||||||
| 			*/ | 			*/ | ||||||
| 			ds.dsg_offset = NewPtr(); | 			ds.dsg_offset = NewPtr(); | ||||||
| 			ds.dsg_name = 0; | 			ds.dsg_name = 0; | ||||||
| 			CodeStore(&ds, pointer_size); | 			CodeStore(&ds, pointer_size, pointer_align); | ||||||
| 			ds.dsg_kind = DSG_PFIXED; | 			ds.dsg_kind = DSG_PFIXED; | ||||||
| 			/* the record is indirectly available */ | 			/* the record is indirectly available */ | ||||||
| 			wds.w_desig = ds; | 			wds.w_desig = ds; | ||||||
|  | @ -709,7 +702,7 @@ DoAssign(nd, left, right) | ||||||
| 	   it sais that the left hand side is evaluated first. | 	   it sais that the left hand side is evaluated first. | ||||||
| 	   DAMN THE BOOK! | 	   DAMN THE BOOK! | ||||||
| 	*/ | 	*/ | ||||||
| 	struct desig dsl, dsr; | 	struct desig dsr; | ||||||
| 	register struct type *rtp, *ltp; | 	register struct type *rtp, *ltp; | ||||||
| 
 | 
 | ||||||
| 	if (! (ChkExpression(right) & ChkVariable(left))) return; | 	if (! (ChkExpression(right) & ChkVariable(left))) return; | ||||||
|  | @ -724,34 +717,18 @@ DoAssign(nd, left, right) | ||||||
| 		return; | 		return; | ||||||
| 	} | 	} | ||||||
| 
 | 
 | ||||||
|  | #define StackNeededFor(ds)	((ds)->dsg_kind == DSG_PLOADED \ | ||||||
|  | 				  || (ds)->dsg_kind == DSG_INDEXED) | ||||||
| 	CodeExpr(right, &dsr, NO_LABEL, NO_LABEL); | 	CodeExpr(right, &dsr, NO_LABEL, NO_LABEL); | ||||||
| 	if (complex(rtp)) CodeAddress(&dsr); | 	if (complex(rtp)) { | ||||||
|  | 		if (StackNeededFor(&dsr)) CodeAddress(&dsr); | ||||||
|  | 	} | ||||||
| 	else { | 	else { | ||||||
| 		CodeValue(&dsr, rtp->tp_size); | 		CodeValue(&dsr, rtp->tp_size, rtp->tp_align); | ||||||
| 		RangeCheck(ltp, rtp); |  | ||||||
| 		CodeCoercion(rtp, ltp); | 		CodeCoercion(rtp, ltp); | ||||||
|  | 		RangeCheck(ltp, rtp); | ||||||
| 	} | 	} | ||||||
| 	dsl = InitDesig; | 	CodeMove(&dsr, left, rtp); | ||||||
| 	CodeDesig(left, &dsl); |  | ||||||
| 
 |  | ||||||
| 	/*	Generate code for an assignment. Testing of type
 |  | ||||||
| 		compatibility and the like is already done. |  | ||||||
| 	*/ |  | ||||||
| 
 |  | ||||||
| 	if (dsr.dsg_kind == DSG_LOADED) { |  | ||||||
| 		if (rtp->tp_fund == T_STRING) { |  | ||||||
| 			CodeAddress(&dsl); |  | ||||||
| 			C_loc(rtp->tp_size); |  | ||||||
| 			C_loc(ltp->tp_size); |  | ||||||
| 			C_cal("_StringAssign"); |  | ||||||
| 			C_asp((int_size << 1) + (pointer_size << 1)); |  | ||||||
| 			return; |  | ||||||
| 		} |  | ||||||
| 		CodeStore(&dsl, ltp->tp_size); |  | ||||||
| 		return; |  | ||||||
| 	} |  | ||||||
| 	CodeAddress(&dsl); |  | ||||||
| 	C_blm(ltp->tp_size); |  | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| RegisterMessages(df) | RegisterMessages(df) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		
		Reference in a new issue