some fixes and cosmetic changes

lang/m2/comp/Makefile

@@ -202,12 +202,9 @@ tokenname.o: Lpars.h
 tokenname.o: idf.h
 tokenname.o: tokenname.h
 idf.o: idf.h
-input.o: def.h
 input.o: f_info.h
-input.o: idf.h
 input.o: input.h
 input.o: inputtype.h
-input.o: scope.h
 type.o: LLlex.h
 type.o: chk_expr.h
 type.o: const.h
@@ -265,6 +262,7 @@ typequiv.o: LLlex.h
 typequiv.o: debug.h
 typequiv.o: debugcst.h
 typequiv.o: def.h
+typequiv.o: idf.h
 typequiv.o: node.h
 typequiv.o: type.h
 typequiv.o: warning.h
@@ -394,6 +392,7 @@ char.o: class.h
 Lpars.o: Lpars.h
 casestat.o: LLlex.h
 casestat.o: Lpars.h
+casestat.o: chk_expr.h
 casestat.o: debug.h
 casestat.o: debugcst.h
 casestat.o: density.h
@@ -401,6 +400,7 @@ casestat.o: desig.h
 casestat.o: node.h
 casestat.o: type.h
 casestat.o: walk.h
+tmpvar.o: LLlex.h
 tmpvar.o: debug.h
 tmpvar.o: debugcst.h
 tmpvar.o: def.h

lang/m2/comp/chk_expr.c

@@ -429,6 +429,7 @@ ChkSet(expp)
 	assert(expp->nd_symb == SET);
 
 	expp->nd_class = Set;
+	expp->nd_type = error_type;
 
 	/* First determine the type of the set
 	*/
@@ -471,7 +472,6 @@ ChkSet(expp)
 						expp->nd_set)) {
 			retval = 0;
 		}
-		if (nd->nd_left) expp->nd_class = Xset;
 		nd = nd->nd_right;
 	}
 
@@ -577,7 +577,6 @@ ChkProcCall(expp)
 	if (left->nd_type == error_type) {
 		/* Just check parameters as if they were value parameters
 		*/
-		expp->nd_type = error_type;
 		while (expp->nd_right) {
 			getarg(&expp, 0, 0, edf);
 		}
@@ -622,15 +621,15 @@ ChkFunCall(expp)
 {
 	/*	Check a call that must have a result
 	*/
-	int retval = 1;
 
-	if (!ChkCall(expp)) retval = 0;
+	if (! ChkCall(expp)) return 0;
+
 	if (expp->nd_type == 0) {
 		node_error(expp, "function call expected");
 		expp->nd_type = error_type;
-		retval = 0;
+		return 0;
 	}
-	return retval;
+	return 1;
 }
 
 int
@@ -647,7 +646,6 @@ ChkCall(expp)
 
 	/* First, get the name of the function or procedure
 	*/
-	expp->nd_type = error_type;
 	if (ChkDesignator(left)) {
 		if (IsCast(left)) {
 			/* It was a type cast.
@@ -696,11 +694,7 @@ ResultOfOperation(operator, tp)
 	return tp;
 }
 
-STATIC int
+#define Boolean(operator) (operator == OR || operator == AND)
-Boolean(operator)
-{
-	return operator == OR || operator == AND;
-}
 
 STATIC int
 AllowedTypes(operator)
@@ -764,7 +758,7 @@ ChkBinOper(expp)
 	/*	Check a binary operation.
 	*/
 	register struct node *left, *right;
-	struct type *tpl, *tpr;
+	register struct type *tpl, *tpr;
 	int allowed;
 	int retval;
 
@@ -960,6 +954,7 @@ ChkStandard(expp)
 
 	assert(left->nd_class == Def);
 
+	expp->nd_type = error_type;
 	switch(edf->df_value.df_stdname) {
 	case S_ABS:
 		if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
@@ -1027,7 +1022,6 @@ ChkStandard(expp)
 			MkCoercion(&(arg->nd_left), d2);
 		}
 		else {
-			expp->nd_type = error_type;
 			Xerror(left, "unexpected parameter type", edf);
 			break;
 		}
@@ -1093,6 +1087,7 @@ ChkStandard(expp)
 	node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are obsolete");
 			}
 		}
+		expp->nd_type = 0;
 		if (! (left = getvariable(&arg, edf))) return 0;
 		if (! (left->nd_type->tp_fund == T_POINTER)) {
 			return Xerror(left, "pointer variable expected", edf);

lang/m2/comp/declar.g

@@ -460,7 +460,8 @@ FormalTypeList(struct type **ptp;)
 	]?
 	')'
 	[ ':' qualtype(ptp)
-	]?
+	|		{ *ptp = 0; }
+	]
 			{ *ptp = proc_type(*ptp, pr, parmaddr); }
 ;
 

lang/m2/comp/node.c

@@ -34,7 +34,6 @@ MkNode(class, left, right, token)
 	nd->nd_right = right;
 	nd->nd_token = *token;
 	nd->nd_class = class;
-	nd->nd_type = error_type;
 	return nd;
 }
 
@@ -46,7 +45,6 @@ MkLeaf(class, token)
 
 	nd->nd_left = nd->nd_right = 0;
 	nd->nd_token = *token;
-	nd->nd_type = error_type;
 	nd->nd_class = class;
 	return nd;
 }

lang/m2/comp/typequiv.c

@@ -25,6 +25,8 @@
 #include	"node.h"
 #include	"warning.h"
 
+extern char *sprint();
+
 int
 TstTypeEquiv(tp1, tp2)
 	struct type *tp1, *tp2;
@@ -193,7 +195,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
 	char ebuf1[256];
 
 	if (edf) {
-		sprintf(ebuf, "\"%s\", parameter %d: %%s", edf->df_idf->id_text, parno);
+		sprint(ebuf, "\"%s\", parameter %d: %%s", edf->df_idf->id_text, parno);
 	}
 	else sprint(ebuf, "parameter %d: %%s", parno);
 

lang/m2/comp/walk.c

@@ -704,7 +704,8 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
 }
 
 DoAssign(left, right)
-	register struct node *left, *right;
+	register struct node *left;
+	struct node *right;
 {
 	/* May we do it in this order (expression first) ???
 	   The reference manual sais nothing about it, but the book does:
@@ -712,30 +713,29 @@ DoAssign(left, right)
 	   DAMN THE BOOK!
 	*/
 	register struct desig *dsr;
-	register struct type *rtp, *ltp;
+	register struct type *tp;
-	struct node *rht = right;
 
 	if (! (ChkExpression(right) & ChkVariable(left))) return;
-	rtp = right->nd_type;
+	tp = left->nd_type;
-	ltp = left->nd_type;
 
-	if (right->nd_symb == STRING) TryToString(right, ltp);
+	if (right->nd_symb == STRING) TryToString(right, tp);
 
-	if (! ChkAssCompat(&rht, ltp, "assignment")) {
+	if (! ChkAssCompat(&right, tp, "assignment")) {
 		return;
 	}
 	dsr = new_desig();
 
 #define StackNeededFor(ds)	((ds)->dsg_kind == DSG_PLOADED \
 				  || (ds)->dsg_kind == DSG_INDEXED)
-	CodeExpr(rht, dsr, NO_LABEL, NO_LABEL);
+	CodeExpr(right, dsr, NO_LABEL, NO_LABEL);
-	if (complex(rtp)) {
+	tp = right->nd_type;
+	if (complex(tp)) {
 		if (StackNeededFor(dsr)) CodeAddress(dsr);
 	}
 	else {
-		CodeValue(dsr, rtp);
+		CodeValue(dsr, tp);
 	}
-	CodeMove(dsr, left, rtp);
+	CodeMove(dsr, left, tp);
 	free_desig(dsr);
 }