Some bug fixes

lang/m2/comp/chk_expr.c

@@ -183,6 +183,7 @@ df->df_idf->id_text);
 	assert(expp->nd_class == Def);
 
 	df = expp->nd_def;
+	if (df == ill_df) return 0;
 
 	if (df->df_kind & (D_ENUM | D_CONST)) {
 		if (df->df_kind == D_ENUM) {
@@ -431,6 +432,10 @@ getarg(argp, bases, designator)
 		return 0;
 	}
 
+	if (designator && left->nd_class == Def) {
+		left->nd_def->df_flags |= D_NOREG;
+	}
+
 	tp = BaseType(left->nd_type);
 
 	if (bases && !(tp->tp_fund & bases)) {
@@ -836,8 +841,9 @@ ChkStandard(expp, left)
 		if (!(left = getarg(&arg, T_ARRAY, 0))) return 0;
 		if (IsConformantArray(left->nd_type)) {
 			/* A conformant array has no explicit index type
+			   ??? So, what can we use as index-type ???
 			*/
-			expp->nd_type = card_type;
+			expp->nd_type = intorcard_type;
 		}
 		else {
 			expp->nd_type = IndexType(left->nd_type);

lang/m2/comp/cstoper.c

@@ -467,7 +467,7 @@ cstcall(expp, call)
 		break;
 
 	case S_SIZE:
-		expp->nd_INT = WA(expr->nd_type->tp_size) / word_size;
+		expp->nd_INT = WA(expr->nd_type->tp_size);
 		break;
 
 	case S_VAL:

lang/m2/comp/declar.g

@@ -181,6 +181,13 @@ error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
 				   referring to the hidden type.
 				*/
 				*(df->df_type) = *tp;
+				if (! tp->next) {
+					/* It also contains a forward
+					   reference, so update the forward-
+					   list
+					*/
+					ChForward(tp, df->df_type);
+				}
 				free_type(tp);
 			  }
 			  else	df->df_type = tp;
@@ -457,7 +464,7 @@ PointerType(struct type **ptp;)
 	        df->df_kind == D_MODULE)
 		type(&((*ptp)->next))
 	|
-		IDENT	{ Forward(&dot, &((*ptp)->next)); }
+		IDENT	{ Forward(&dot, (*ptp)); }
 	]
 ;
 

lang/m2/comp/scope.C

@@ -68,14 +68,14 @@ InitScope()
 struct forwards {
 	struct forwards *next;
 	struct node fo_tok;
-	struct type **fo_ptyp;
+	struct type *fo_ptyp;
 };
 
 /* STATICALLOCDEF "forwards" */
 
 Forward(tk, ptp)
 	struct token *tk;
-	struct type **ptp;
+	struct type *ptp;
 {
 	/*	Enter a forward reference into a list belonging to the
 		current scope. This is used for POINTER declarations, which
@@ -90,6 +90,19 @@ Forward(tk, ptp)
 	CurrentScope->sc_forw = f;
 }
 
+ChForward(was, becomes)
+	struct type *was, *becomes;
+{
+	/*	The declaration of a hidden type had a forward reference.
+		In this case, the "forwards" list must be adapted.
+	*/
+	register struct forwards *f = CurrentScope->sc_forw;
+
+	while (f && f->fo_ptyp != was) f = f->next;
+	assert(f != 0);
+	f->fo_ptyp = becomes;
+}
+
 STATIC
 chk_proc(df)
 	register struct def *df;
@@ -168,7 +181,7 @@ rem_forwards(fo)
 			node_error(&(f->fo_tok), "identifier \"%s\" not a type",
 			      df->df_idf->id_text);
 		}
-		*(f->fo_ptyp) = df->df_type;
+		f->fo_ptyp->next = df->df_type;
 		fo = f->next;
 		free_forwards(f);
 	}

lang/m2/comp/typequiv.c

@@ -144,6 +144,11 @@ TstAssCompat(tp1, tp2)
 	if ((tp1->tp_fund & T_INTORCARD) &&
 	    (tp2->tp_fund & T_INTORCARD)) return 1;
 
+	if (tp1->tp_fund == T_PROCEDURE &&
+	    tp2->tp_fund == T_PROCEDURE) {
+		return TstProcEquiv(tp1, tp2);
+	}
+
 	if (tp1->tp_fund == T_ARRAY) {
 		/* check for string
 		*/

lang/m2/comp/walk.c

@@ -84,7 +84,7 @@ WalkModule(module)
 		   Call initialization routines of imported modules.
 		   Also prevent recursive calls of this one.
 		*/
-		register struct node *nd;
+		register struct node *nd = Modules;
 
 		if (state == IMPLEMENTATION) {
 			label l1 = ++data_label;
@@ -97,9 +97,14 @@ WalkModule(module)
 			C_zne((label) 1);
 			C_loc((arith) 1);
 			C_ste_dlb(l1, (arith) 0);
+			/* Prevent this module from calling its own
+			   initialization routine
+			*/
+			assert(nd->nd_IDF == module->df_idf);
+			nd = nd->next;
 		}
 
-		for (nd = Modules; nd; nd = nd->next) {
+		for (; nd; nd = nd->next) {
 			C_cal(nd->nd_IDF->id_text);
 		}
 	}
@@ -571,7 +576,7 @@ DoAssign(nd, left, right)
 	/* May we do it in this order (expression first) ??? */
 	struct desig dsl, dsr;
 
-	if (!ChkExpression(right)) return;
+	if (! ChkExpression(right)) return;
 	if (! ChkVariable(left)) return;
 	TryToString(right, left->nd_type);
 	dsr = InitDesig;