Some minor mods and a bug fix with type transfer functions

lang/m2/comp/chk_expr.c

@@ -592,7 +592,7 @@ ChkProcCall(expp)
 	*/
 	register t_node *left;
 	t_def *edf = 0;
-	register struct paramlist *param;
+	register t_param *param;
 	int retval = 1;
 	int cnt = 0;
 
@@ -1264,12 +1264,12 @@ ChkCast(expp)
 		is no problem as such values take a word on the EM stack
 		anyway.
 	*/
-	register t_node *left = expp->nd_left;
 	register t_node *arg = expp->nd_right;
-	register t_type *lefttype = left->nd_type;
+	register t_type *lefttype = expp->nd_left->nd_type;
+	t_def		*df = expp->nd_left->nd_def;
 
 	if ((! arg) || arg->nd_right) {
-		return df_error(expp, "type cast must have 1 parameter", left->nd_def);
+		return df_error(expp, "type cast must have 1 parameter", df);
 	}
 
 	if (! ChkExpression(arg->nd_left)) return 0;
@@ -1280,11 +1280,17 @@ ChkCast(expp)
 	if (arg->nd_type->tp_size != lefttype->tp_size &&
 	    (arg->nd_type->tp_size > word_size ||
 	     lefttype->tp_size > word_size)) {
-		df_error(expp, "unequal sizes in type cast", left->nd_def);
+		return df_error(expp, "unequal sizes in type cast", df);
+	}
+
+	if (IsConformantArray(arg->nd_type)) {
+		return df_error(expp,
+		  "type transfer function on conformant array not supported",
+		  df);
 	}
 
 	if (arg->nd_class == Value) {
-		FreeNode(left);
+		FreeNode(expp->nd_left);
 		expp->nd_right->nd_left = 0;
 		FreeNode(expp->nd_right);
 		*expp = *arg;

lang/m2/comp/code.c

@@ -359,7 +359,7 @@ CodeCall(nd)
 }
 
 CodeParameters(param, arg)
-	struct paramlist *param;
+	t_param *param;
 	t_node *arg;
 {
 	register t_type *tp;

lang/m2/comp/declar.g

@@ -31,30 +31,31 @@
 int		proclevel = 0;		/* nesting level of procedures */
 int		return_occurred;	/* set if a return occurs in a block */
 
+extern t_node	*EmptyStatement;
+
 #define needs_static_link()	(proclevel > 1)
-extern t_node *EmptyStatement;
 }
 
 /* inline in declaration: need space
-ProcedureDeclaration
+ * ProcedureDeclaration
-{
+ * {
-	t_def *df;
+ * 	t_def *df;
-} :
+ * } :
-			{	++proclevel; }
+ * 			{	++proclevel; }
-	ProcedureHeading(&df, D_PROCEDURE)
+ * 	ProcedureHeading(&df, D_PROCEDURE)
-	';' block(&(df->prc_body))
+ * 	';' block(&(df->prc_body))
-	IDENT
+ * 	IDENT
-			{	EndProc(df, dot.TOK_IDF);
+ * 			{	EndProc(df, dot.TOK_IDF);
-				--proclevel;
+ * 				--proclevel;
-			}
+ * 			}
-;
+ * ;
 */
 
 ProcedureHeading(t_def **pdf; int type;)
 {
-	t_type *tp = 0;
+	t_type	*tp = 0;
-	arith parmaddr = needs_static_link() ? pointer_size : 0;
+	arith	parmaddr = needs_static_link() ? pointer_size : 0;
-	struct paramlist *pr = 0;
+	t_param	*pr = 0;
 } :
 	PROCEDURE IDENT
 			{ *pdf = DeclProc(type, dot.TOK_IDF); }
@@ -116,25 +117,25 @@ declaration
 ;
 
 /* inline in procedureheading: need space
-FormalParameters(struct paramlist **ppr; arith *parmaddr; t_type **ptp;):
+ * FormalParameters(t_param **ppr; arith *parmaddr; t_type **ptp;):
-	'('
+ * 	'('
-	[
+ * 	[
-		FPSection(ppr, parmaddr)
+ * 		FPSection(ppr, parmaddr)
-		[
+ * 		[
-			';' FPSection(ppr, parmaddr)
+ * 			';' FPSection(ppr, parmaddr)
-		]*
+ * 		]*
-	]?
+ * 	]?
-	')'
+ * 	')'
-	[	':' qualtype(ptp)
+ * 	[	':' qualtype(ptp)
-	]?
+ * 	]?
-;
+ * ;
 */
 
-FPSection(struct paramlist **ppr; arith *parmaddr;)
+FPSection(t_param **ppr; arith *parmaddr;)
 {
-	t_node *FPList;
+	t_node	*FPList;
-	t_type *tp;
+	t_type	*tp;
-	int VARp;
+	int	VARp;
 } :
 	var(&VARp) IdentList(&FPList) ':' FormalType(&tp)
 			{ EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
@@ -267,7 +268,7 @@ ArrayType(t_type **ptp;)
 
 RecordType(t_type **ptp;)
 {
-	register struct scope *scope;
+	register t_scope *scope;
 	arith size = 0;
 	int xalign = struct_align;
 }
@@ -285,14 +286,14 @@ RecordType(t_type **ptp;)
 	END
 ;
 
-FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
+FieldListSequence(t_scope *scope; arith *cnt; int *palign;):
 	FieldList(scope, cnt, palign)
 	[
 		';' FieldList(scope, cnt, palign)
 	]*
 ;
 
-FieldList(struct scope *scope; arith *cnt; int *palign;)
+FieldList(t_scope *scope; arith *cnt; int *palign;)
 {
 	t_node *FldList;
 	t_type *tp;
@@ -358,7 +359,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 ]?
 ;
 
-variant(struct scope *scope; arith *cnt; t_type *tp; int *palign;)
+variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
 {
 	t_node *nd;
 } :
@@ -442,7 +443,7 @@ ProcedureType(t_type **ptp;) :
 	  	FormalTypeList(ptp)
 	|
 			{ *ptp = proc_type((t_type *) 0, 
-					   (struct paramlist *) 0,
+					   (t_param *) 0,
 					   (arith) 0);
 			}
 	]
@@ -450,7 +451,7 @@ ProcedureType(t_type **ptp;) :
 
 FormalTypeList(t_type **ptp;)
 {
-	struct paramlist *pr = 0;
+	t_param *pr = 0;
 	arith parmaddr = 0;
 } :
 	'('
@@ -467,7 +468,7 @@ FormalTypeList(t_type **ptp;)
 			{ *ptp = proc_type(*ptp, pr, parmaddr); }
 ;
 
-VarFormalType(struct paramlist **ppr; arith *parmaddr;)
+VarFormalType(t_param **ppr; arith *parmaddr;)
 {
 	t_type *tp;
 	int isvar;

lang/m2/comp/def.c

@@ -61,7 +61,7 @@ DefInFront(df)
 t_def *
 MkDef(id, scope, kind)
 	register t_idf *id;
-	register struct scope *scope;
+	register t_scope *scope;
 {
 	/*	Create a new definition structure in scope "scope", with
 		id "id" and kind "kind".
@@ -85,7 +85,7 @@ MkDef(id, scope, kind)
 t_def *
 define(id, scope, kind)
 	register t_idf *id;
-	register struct scope *scope;
+	register t_scope *scope;
 	int kind;
 {
 	/*	Declare an identifier in a scope, but first check if it
@@ -228,7 +228,7 @@ DeclProc(type, id)
 		Also create a name for it.
 	*/
 	register t_def *df;
-	register struct scope *scope;
+	register t_scope *scope;
 	extern char *sprint();
 	static int nmcount;
 	char buf[256];
@@ -312,7 +312,7 @@ DefineLocalModule(id)
 		a name to be used for code generation.
 	*/
 	register t_def *df = define(id, CurrentScope, D_MODULE);
-	register struct scope *sc;
+	register t_scope *sc;
 	static int modulecount = 0;
 	char buf[256];
 	extern char *sprint();

lang/m2/comp/defmodule.c

@@ -91,10 +91,10 @@ GetDefinitionModule(id, incr)
 	*/
 	register t_def *df;
 	static int level;
-	struct scopelist *vis;
+	t_scopelist *vis;
 	char *fn = FileName;
 	int ln = LineNumber;
-	struct scope *newsc = CurrentScope;
+	t_scope *newsc = CurrentScope;
 
 	level += incr;
 	df = lookup(id, GlobalScope, 1);

lang/m2/comp/desig.c

@@ -473,7 +473,7 @@ CodeVarDesig(df, ds)
 		it is a value parameter, it is a var parameter, it is one of
 		those of an enclosing procedure, or it is global.
 	*/
-	register struct scope *sc = df->df_scope;
+	register t_scope *sc = df->df_scope;
 
 	/* Selections from a module are handled earlier, when identifying
 	   the variable, so ...

lang/m2/comp/enter.c

@@ -83,7 +83,7 @@ EnterEnumList(Idlist, type)
 EnterFieldList(Idlist, type, scope, addr)
 	t_node *Idlist;
 	register t_type *type;
-	struct scope *scope;
+	t_scope *scope;
 	arith *addr;
 {
 	/*	Put a list of fields in the symbol table.
@@ -115,7 +115,7 @@ EnterVarList(Idlist, type, local)
 	*/
 	register t_def *df;
 	register t_node *idlist = Idlist;
-	register struct scopelist *sc = CurrVis;
+	register t_scopelist *sc = CurrVis;
 	char buf[256];
 	extern char *sprint();
 
@@ -179,7 +179,7 @@ EnterVarList(Idlist, type, local)
 }
 
 EnterParamList(ppr, Idlist, type, VARp, off)
-	struct paramlist **ppr;
+	t_param **ppr;
 	t_node *Idlist;
 	t_type *type;
 	int VARp;
@@ -189,11 +189,11 @@ EnterParamList(ppr, Idlist, type, VARp, off)
 		"ids" indicates the list of identifiers, "tp" their type, and
 		"VARp" indicates D_VARPAR or D_VALPAR.
 	*/
-	register struct paramlist *pr;
+	register t_param *pr;
 	register t_def *df;
 	register t_node *idlist = Idlist;
 	t_node *dummy = 0;
-	static struct paramlist *last;
+	static t_param *last;
 
 	if (! idlist) {
 		/* Can only happen when a procedure type is defined */
@@ -232,7 +232,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
 STATIC
 DoImport(df, scope)
 	register t_def *df;
-	struct scope *scope;
+	t_scope *scope;
 {
 	/*	Definition "df" is imported to scope "scope".
 		Handle the case that it is an enumeration type or a module.
@@ -266,7 +266,7 @@ DoImport(df, scope)
 	}
 }
 
-STATIC struct scopelist *
+STATIC t_scopelist *
 ForwModule(df, nd)
 	register t_def *df;
 	t_node *nd;
@@ -275,7 +275,7 @@ ForwModule(df, nd)
 		We could also end up here for not found DEFINITION MODULES.
 		Create a declaration and a scope for this module.
 	*/
-	struct scopelist *vis;
+	t_scopelist *vis;
 
 	if (df->df_scope != GlobalScope) {
 		df->df_scope = enclosing(CurrVis)->sc_scope;
@@ -298,7 +298,7 @@ ForwModule(df, nd)
 STATIC t_def *
 ForwDef(ids, scope)
 	register t_node *ids;
-	struct scope *scope;
+	t_scope *scope;
 {
 	/*	Enter a forward definition of "ids" in scope "scope",
 		if it is not already defined.
@@ -396,7 +396,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
 	/*	Import the list Idlist from the module indicated by Fromdef.
 	*/
 	register t_node *idlist = Idlist;
-	register struct scopelist *vis;
+	register t_scopelist *vis;
 	register t_def *df;
 	char *module_name = FromDef->df_idf->id_text;
 	int forwflag = 0;
@@ -462,7 +462,7 @@ EnterImportList(Idlist, local)
 		This case is indicated by the value 0 of the "local" flag.
 	*/
 	register t_node *idlist = Idlist;
-	struct scope *sc = enclosing(CurrVis)->sc_scope;
+	t_scope *sc = enclosing(CurrVis)->sc_scope;
 	extern t_def *GetDefinitionModule();
 	struct f_info f;
 	

lang/m2/comp/lookup.c

@@ -26,7 +26,7 @@
 t_def *
 lookup(id, scope, import)
 	register t_idf *id;
-	struct scope *scope;
+	t_scope *scope;
 {
 	/*	Look up a definition of an identifier in scope "scope".
 		Make the "def" list self-organizing.
@@ -65,14 +65,14 @@ lookup(id, scope, import)
 t_def *
 lookfor(id, vis, give_error)
 	register t_node *id;
-	struct scopelist *vis;
+	t_scopelist *vis;
 {
 	/*	Look for an identifier in the visibility range started by "vis".
 		If it is not defined create a dummy definition and,
 		if "give_error" is set, give an error message.
 	*/
 	register t_def *df;
-	register struct scopelist *sc = vis;
+	register t_scopelist *sc = vis;
 
 	while (sc) {
 		df = lookup(id->nd_IDF, sc->sc_scope, 1);

lang/m2/comp/scope.C

@@ -23,10 +23,10 @@
 #include	"def.h"
 #include	"node.h"
 
-struct scope *PervasiveScope;
+t_scope *PervasiveScope;
-struct scopelist *CurrVis, *GlobalVis;
+t_scopelist *CurrVis, *GlobalVis;
 extern int proclevel;
-static struct scopelist *PervVis;
+static t_scopelist *PervVis;
 extern char options[];
 
 /* STATICALLOCDEF "scope" 10 */
@@ -37,8 +37,8 @@ open_scope(scopetype)
 {
 	/*	Open a scope that is either open (automatic imports) or closed.
 	*/
-	register struct scope *sc = new_scope();
+	register t_scope *sc = new_scope();
-	register struct scopelist *ls = new_scopelist();
+	register t_scopelist *ls = new_scopelist();
 	
 	assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 
@@ -53,10 +53,10 @@ open_scope(scopetype)
 	CurrVis = ls;
 }
 
-struct scope *
+t_scope *
 open_and_close_scope(scopetype)
 {
-	struct scope *sc;
+	t_scope *sc;
 
 	open_scope(scopetype);
 	sc = CurrentScope;
@@ -66,8 +66,8 @@ open_and_close_scope(scopetype)
 
 InitScope()
 {
-	register struct scope *sc = new_scope();
+	register t_scope *sc = new_scope();
-	register struct scopelist *ls = new_scopelist();
+	register t_scopelist *ls = new_scopelist();
 
 	sc->sc_scopeclosed = 0;
 	sc->sc_def = 0;
@@ -161,7 +161,7 @@ df->df_idf->id_text);
 				   Maybe the definitions are in the
 				   enclosing scope?
 				*/
-				register struct scopelist *ls =
+				register t_scopelist *ls =
 						nextvisible(CurrVis);
 				t_def *df1 = df->df_nextinscope;
 	
@@ -213,7 +213,7 @@ close_scope(flag)
 		either POINTER declarations, or EXPORTs, or forward references
 		to MODULES
 	*/
-	register struct scope *sc = CurrentScope;
+	register t_scope *sc = CurrentScope;
 
 	assert(sc != 0);
 

lang/m2/comp/scope.h

@@ -38,10 +38,13 @@ struct scopelist {
 	struct scopelist *sc_encl;
 };
 
-extern struct scope
+typedef struct scope t_scope;
+typedef struct scopelist t_scopelist;
+
+extern t_scope
 	*PervasiveScope;
 
-extern struct scopelist
+extern t_scopelist
 	*CurrVis, *GlobalVis;
 
 #define CurrentScope	(CurrVis->sc_scope)
@@ -50,4 +53,4 @@ extern struct scopelist
 #define scopeclosed(x)	((x)->sc_scopeclosed)
 #define nextvisible(x)	((x)->sc_next)		/* use with scopelists */
 
-struct scope *open_and_close_scope();
+t_scope *open_and_close_scope();

lang/m2/comp/tmpvar.C

@@ -39,11 +39,11 @@ struct tmpvar {
 
 static struct tmpvar	*TmpInts,	/* for integer temporaries */
 			*TmpPtrs;	/* for pointer temporaries */
-static struct scope	*ProcScope;	/* scope of procedure in which the
+static t_scope	*ProcScope;	/* scope of procedure in which the
 					   temporaries are allocated
 					*/
 
-TmpOpen(sc) struct scope *sc;
+TmpOpen(sc) t_scope *sc;
 {
 	/*	Initialize for temporaries in scope "sc".
 	*/
@@ -54,7 +54,7 @@ arith
 TmpSpace(sz, al)
 	arith sz;
 {
-	register struct scope *sc = ProcScope;
+	register t_scope *sc = ProcScope;
 
 	sc->sc_off = - WA(align(sz - sc->sc_off, al));
 	return sc->sc_off;

lang/m2/comp/type.H

@@ -16,6 +16,8 @@ struct paramlist {		/* structure for parameterlist of a PROCEDURE */
 #define TypeOfParam(xpar)	((xpar)->par_def->df_type)
 };
 
+typedef struct paramlist t_param;
+
 /* ALLOCDEF "paramlist" 20 */
 
 struct enume {

lang/m2/comp/type.c

@@ -393,7 +393,7 @@ subr_type(lb, ub)
 t_type *
 proc_type(result_type, parameters, n_bytes_params)
 	t_type *result_type;
-	struct paramlist *parameters;
+	t_param *parameters;
 	arith n_bytes_params;
 {
 	register t_type *tp = construct_type(T_PROCEDURE, result_type);
@@ -538,7 +538,7 @@ FreeType(tp)
 		This procedure is only called for types, constructed with
 		T_PROCEDURE.
 	*/
-	register struct paramlist *pr, *pr1;
+	register t_param *pr, *pr1;
 
 	assert(tp->tp_fund == T_PROCEDURE);
 
@@ -713,7 +713,7 @@ DumpType(tp)
 		break;
 	case T_PROCEDURE:
 		{
-		register struct paramlist *par = ParamList(tp);
+		register t_param *par = ParamList(tp);
 
 		print("PROCEDURE");
 		if (par) {

lang/m2/comp/typequiv.c

@@ -72,7 +72,7 @@ TstProcEquiv(tp1, tp2)
 		may also be used for the testing of assignment compatibility
 		between procedure variables and procedures.
 	*/
-	register struct paramlist *p1, *p2;
+	register t_param *p1, *p2;
 
 	/* First check if the result types are equivalent
 	*/

lang/m2/comp/walk.c

@@ -110,8 +110,8 @@ WalkModule(module)
 		Also generate code for its body.
 		This code is collected in an initialization routine.
 	*/
-	register struct scope *sc;
+	register t_scope *sc;
-	struct scopelist *savevis = CurrVis;
+	t_scopelist *savevis = CurrVis;
 
 	CurrVis = module->mod_vis;
 	priority = module->mod_priority ? module->mod_priority->nd_INT : 0;
@@ -176,10 +176,10 @@ WalkProcedure(procedure)
 	/*	Walk through the definition of a procedure and all its
 		local definitions, checking and generating code.
 	*/
-	struct scopelist *savevis = CurrVis;
+	t_scopelist *savevis = CurrVis;
-	register struct scope *sc = procedure->prc_vis->sc_scope;
+	register t_scope *sc = procedure->prc_vis->sc_scope;
 	register t_type *tp;
-	register struct paramlist *param;
+	register t_param *param;
 	label func_res_label = 0;
 	arith StackAdjustment = 0;
 	arith retsav = 0;
@@ -575,7 +575,7 @@ WalkStat(nd, exit_label)
 
 	case WITH:
 		{
-			struct scopelist link;
+			t_scopelist link;
 			struct withdesig wds;
 			t_desig ds;
 
@@ -728,7 +728,7 @@ DoForInit(nd)
 	}
 
 	if (df->df_scope != CurrentScope) {
-		register struct scopelist *sc = CurrVis;
+		register t_scopelist *sc = CurrVis;
 
 		for (;;) {
 			if (!sc) {