From: ceriel <none@none>
Date: Thu, 24 Sep 1987 13:07:31 +0000 (+0000)
Subject: Some minor mods and a bug fix with type transfer functions
X-Git-Tag: release-5-5~3834
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=c5674041bf42e4fed256db7db75896dbb9340f20;p=ack.git

Some minor mods and a bug fix with type transfer functions
---

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index e3e34baa2..b8e92e82f 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/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;
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index f70e4d95c..f51ab47b4 100644
--- a/lang/m2/comp/code.c
+++ b/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;
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 8d76e3c26..bc9ac58e0 100644
--- a/lang/m2/comp/declar.g
+++ b/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
-{
-	t_def *df;
-} :
-			{	++proclevel; }
-	ProcedureHeading(&df, D_PROCEDURE)
-	';' block(&(df->prc_body))
-	IDENT
-			{	EndProc(df, dot.TOK_IDF);
-				--proclevel;
-			}
-;
+ * ProcedureDeclaration
+ * {
+ * 	t_def *df;
+ * } :
+ * 			{	++proclevel; }
+ * 	ProcedureHeading(&df, D_PROCEDURE)
+ * 	';' block(&(df->prc_body))
+ * 	IDENT
+ * 			{	EndProc(df, dot.TOK_IDF);
+ * 				--proclevel;
+ * 			}
+ * ;
 */
 
 ProcedureHeading(t_def **pdf; int type;)
 {
-	t_type *tp = 0;
-	arith parmaddr = needs_static_link() ? pointer_size : 0;
-	struct paramlist *pr = 0;
+	t_type	*tp = 0;
+	arith	parmaddr = needs_static_link() ? pointer_size : 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;):
-	'('
-	[
-		FPSection(ppr, parmaddr)
-		[
-			';' FPSection(ppr, parmaddr)
-		]*
-	]?
-	')'
-	[	':' qualtype(ptp)
-	]?
-;
+ * FormalParameters(t_param **ppr; arith *parmaddr; t_type **ptp;):
+ * 	'('
+ * 	[
+ * 		FPSection(ppr, parmaddr)
+ * 		[
+ * 			';' FPSection(ppr, parmaddr)
+ * 		]*
+ * 	]?
+ * 	')'
+ * 	[	':' qualtype(ptp)
+ * 	]?
+ * ;
 */
 
-FPSection(struct paramlist **ppr; arith *parmaddr;)
+FPSection(t_param **ppr; arith *parmaddr;)
 {
-	t_node *FPList;
-	t_type *tp;
-	int VARp;
+	t_node	*FPList;
+	t_type	*tp;
+	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;
diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index b5d532c83..516b6fdbb 100644
--- a/lang/m2/comp/def.c
+++ b/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();
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 7e505f53f..5df8e4431 100644
--- a/lang/m2/comp/defmodule.c
+++ b/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);
diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index a908072aa..87d5e923d 100644
--- a/lang/m2/comp/desig.c
+++ b/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 ...
diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index 0803a8c59..b562873aa 100644
--- a/lang/m2/comp/enter.c
+++ b/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;
 	
diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c
index 6604c6418..1c589ec14 100644
--- a/lang/m2/comp/lookup.c
+++ b/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);
diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index 05ff093ee..4001f3b70 100644
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -23,10 +23,10 @@
 #include	"def.h"
 #include	"node.h"
 
-struct scope *PervasiveScope;
-struct scopelist *CurrVis, *GlobalVis;
+t_scope *PervasiveScope;
+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 struct scopelist *ls = new_scopelist();
+	register t_scope *sc = new_scope();
+	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 struct scopelist *ls = new_scopelist();
+	register t_scope *sc = new_scope();
+	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);
 
diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h
index 1ccda9374..bad79417e 100644
--- a/lang/m2/comp/scope.h
+++ b/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();
diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C
index 88429a5ae..8bb65a019 100644
--- a/lang/m2/comp/tmpvar.C
+++ b/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;
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index fdbaf7bdb..a29518768 100644
--- a/lang/m2/comp/type.H
+++ b/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 {
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index b6cc0accb..66692660c 100644
--- a/lang/m2/comp/type.c
+++ b/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) {
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index a10289571..ca77ccb18 100644
--- a/lang/m2/comp/typequiv.c
+++ b/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
 	*/
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index ced9c3fb5..aaf53574d 100644
--- a/lang/m2/comp/walk.c
+++ b/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;
-	struct scopelist *savevis = CurrVis;
+	register t_scope *sc;
+	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;
-	register struct scope *sc = procedure->prc_vis->sc_scope;
+	t_scopelist *savevis = CurrVis;
+	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) {