From c839c01680f0b22a3c10ad29cda65584264b573d Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Thu, 18 Jun 1987 15:46:08 +0000
Subject: [PATCH] some fixes, and changed priority of unary minus

---
 lang/m2/comp/LLlex.c      |  8 ++---
 lang/m2/comp/Makefile     |  1 +
 lang/m2/comp/chk_expr.c   | 17 ++++++----
 lang/m2/comp/code.c       | 12 +++++--
 lang/m2/comp/cstoper.c    |  1 +
 lang/m2/comp/declar.g     |  2 +-
 lang/m2/comp/def.H        |  2 +-
 lang/m2/comp/defmodule.c  |  5 +++
 lang/m2/comp/expression.g | 71 +++++++++++++++++++++++++++++----------
 lang/m2/comp/program.g    |  2 +-
 lang/m2/comp/type.H       |  2 +-
 lang/m2/comp/type.c       |  3 ++
 lang/m2/comp/walk.c       |  3 +-
 13 files changed, 94 insertions(+), 35 deletions(-)

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 95098c97d..eced01075 100644
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -24,6 +24,7 @@
 #include	"Lpars.h"
 #include	"class.h"
 #include	"idf.h"
+#include	"def.h"
 #include	"type.h"
 #include	"LLlex.h"
 #include	"const.h"
@@ -62,7 +63,7 @@ SkipComment()
 			   of the names. Also, don't generate call to
 			   initialization routine.
 			*/
-			ForeignFlag = 1;
+			ForeignFlag = D_FOREIGN;
 			break;
 		}
 	}
@@ -231,8 +232,6 @@ LLlex()
 		return tk->tk_symb;
 	}
 
-	tk->tk_lineno = LineNumber;
-
 again1:
 	if (eofseen) {
 		eofseen = 0;
@@ -247,6 +246,8 @@ again:
 		}
 	}
 
+	tk->tk_lineno = LineNumber;
+
 	switch (class(ch))	{
 
 	case STNL:
@@ -254,7 +255,6 @@ again:
 #ifdef DEBUG
 		cntlines++;
 #endif
-		tk->tk_lineno++;
 		CheckForLineDirective();
 		goto again1;
 
diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index fb1d9ee1a..ab5dc3701 100644
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -158,6 +158,7 @@ LLlex.o: class.h
 LLlex.o: const.h
 LLlex.o: debug.h
 LLlex.o: debugcst.h
+LLlex.o: def.h
 LLlex.o: f_info.h
 LLlex.o: idf.h
 LLlex.o: idfsize.h
diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 9da7a7132..6c8a7c99f 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -758,6 +758,10 @@ ChkBinOper(expp)
 	   - The IN-operator has as right-hand-size operand a set.
 	*/
 	if (expp->nd_symb == IN) {
+		if (tpr->tp_fund != T_SET) {
+			node_error(expp, "\"IN\": right operand must be a set");
+			return 0;
+		}
 		if (!TstAssCompat(tpl, ElementType(tpr))) {
 			/* Assignment compatible ???
 			   I don't know! Should we be allowed to check
@@ -831,12 +835,13 @@ ChkUnOper(expp)
 
 	switch(expp->nd_symb) {
 	case '+':
-		if (tpr->tp_fund & T_NUMERIC) {
-			*expp = *right;
-			free_node(right);
-			return 1;
-		}
-		break;
+		if (!(tpr->tp_fund & T_NUMERIC)) break;
+		/* fall through */
+
+	case '(':
+		*expp = *right;
+		free_node(right);
+		return 1;
 
 	case '-':
 		if (tpr->tp_fund & T_INTORCARD) {
diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index ed6062bd1..a620468d7 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -396,8 +396,14 @@ CodeParameters(param, arg)
 		return;
 	}
 	CodePExpr(left);
-	RangeCheck(tp, left_type);
-	CodeCoercion(left_type, tp);
+	CodeCheckExpr(left, tp);
+}
+
+CodeCheckExpr(tp1, tp2)
+	struct type *tp1, *tp2;
+{
+	CodeCoercion(tp1, tp2);
+	RangeCheck(tp2, tp1);
 }
 
 CodePString(nd, tp)
@@ -749,6 +755,7 @@ CodeOper(expr, true_label, false_label)
 				C_dup(2*tp->tp_size);
 				C_asp(tp->tp_size);
 				C_ior(tp->tp_size);
+				expr->nd_symb = '=';
 			}
 			else if (expr->nd_symb == LESSEQUAL) {
 				/* A <= B is the same as A - B = {}
@@ -756,6 +763,7 @@ CodeOper(expr, true_label, false_label)
 				C_com(tp->tp_size);
 				C_and(tp->tp_size);
 				C_zer(tp->tp_size);
+				expr->nd_symb = '=';
 			}
 			C_cms(tp->tp_size);
 			break;
diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index a2f182f6b..22b453b37 100644
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -262,6 +262,7 @@ cstset(expp)
 		expp->nd_INT = (i >= 0 && i < setsize * wrd_bits &&
 		    (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
 		free((char *) set2);
+		expp->nd_symb = INTEGER;
 	}
 	else {
 		set1 = expp->nd_left->nd_set;
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 3a67f1a62..ff256dcc1 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -169,7 +169,7 @@ SimpleType(register struct type **ptp;)
 		/* The subrange type is given a base type by the
 		   qualident (this is new modula-2).
 		*/
-			{ chk_basesubrange(tp, *ptp); }
+			{ chk_basesubrange(tp, *ptp); *ptp = tp; }
 	]
 |
 	enumeration(ptp)
diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index e50947d96..15111f434 100644
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -33,7 +33,7 @@ struct constant {
 };
 
 struct enumval {
-	unsigned int en_val;	/* value of this enumeration literal */
+	arith en_val;	/* value of this enumeration literal */
 	struct def *en_next;	/* next enumeration literal */
 #define enm_val		df_value.df_enum.en_val
 #define enm_next	df_value.df_enum.en_next
diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 0bbe2e04e..35815a122 100644
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -92,6 +92,8 @@ GetDefinitionModule(id, incr)
 	register struct def *df;
 	static int level;
 	struct scopelist *vis;
+	char *fn = FileName;
+	int ln = LineNumber;
 
 	level += incr;
 	df = lookup(id, GlobalScope, 1);
@@ -109,6 +111,7 @@ GetDefinitionModule(id, incr)
 			ForeignFlag = 0;
 			open_scope(CLOSEDSCOPE);
 			if (!is_anon_idf(id) && GetFile(id->id_text)) {
+
 				DefModule();
 				df = lookup(id, GlobalScope, 1);
 				if (level == 1 &&
@@ -152,6 +155,8 @@ GetDefinitionModule(id, incr)
 		error("cannot import from currently defined module");
 		df->df_kind = D_ERROR;
 	}
+	FileName = fn;
+	LineNumber = ln;
 	assert(df);
 	level -= incr;
 	return df;
diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index 92cc725dc..7a89fde1b 100644
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -29,6 +29,7 @@
 extern char	options[];
 }
 
+/* inline, we need room for pdp/11
 number(struct node **p;) :
 [
 	%default
@@ -39,6 +40,7 @@ number(struct node **p;) :
 			  (*p)->nd_type = toktype;
 			}
 ;
+*/
 
 qualident(struct node **p;)
 {
@@ -112,21 +114,28 @@ relation:
 
 SimpleExpression(struct node **pnd;)
 {
+	register struct node *nd = 0;
 } :
 	[
 		[ '+' | '-' ]
-			{ *pnd = MkLeaf(Uoper, &dot);
-			  pnd = &((*pnd)->nd_right);
+			{ nd = MkLeaf(Uoper, &dot);
 			  /* priority of unary operator ??? */
 			}
 	]?
 	term(pnd)
+			{ if (nd) {
+				nd->nd_right = *pnd;
+				*pnd = nd;
+			  }
+			  nd = *pnd;
+			}
 	[
 		/* AddOperator */
 		[ '+' | '-' | OR ]
-			{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
-		term(&((*pnd)->nd_right))
+			{ nd = MkNode(Oper, nd, NULLNODE, &dot); }
+		term(&(nd->nd_right))
 	]*
+			{ *pnd = nd; }
 ;
 
 /* Inline in "SimpleExpression"
@@ -171,13 +180,35 @@ factor(register struct node **p;)
 |
 	bare_set(p)
 | %default
-	number(p)
+	[
+		%default
+		INTEGER
+	|
+		REAL
+	|
+		STRING
+	]		{ *p = MkLeaf(Value, &dot);
+			  (*p)->nd_type = toktype;
+			}
 |
-	STRING	{ *p = MkLeaf(Value, &dot);
-		  (*p)->nd_type = toktype;
+	'(' 	{ nd = MkLeaf(Uoper, &dot); }
+	expression(p)
+		{ /*	In some cases we must leave the '(' as an unary
+			operator, because otherwise we cannot see that the
+			factor was not a designator
+		  */
+		  register int class = (*p)->nd_class;
+
+		  if (class == Arrsel ||
+		      class == Arrow ||
+		      class == Name ||
+		      class == Link) {
+			nd->nd_right = *p;
+			*p = nd;
+		  }
+		  else free_node(nd);
 		}
-|
-	'(' expression(p) ')'
+	')'
 |
 	NOT		{ *p = MkLeaf(Uoper, &dot); }
 	factor(&((*p)->nd_right))
@@ -204,7 +235,7 @@ ActualParameters(struct node **pnd;):
 	'(' ExpList(pnd)? ')'
 ;
 
-element(struct node *nd;)
+element(register struct node *nd;)
 {
 	struct node *nd1;
 } :
@@ -235,17 +266,23 @@ designator_tail(struct node **pnd;):
 	]*
 ;
 
-visible_designator_tail(register struct node **pnd;):
-	'['		{ *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); }
-		expression(&((*pnd)->nd_right))
+visible_designator_tail(struct node **pnd;)
+{
+	register struct node *nd = *pnd;
+}:
+[
+	'['		{ nd = MkNode(Arrsel, nd, NULLNODE, &dot); }
+		expression(&(nd->nd_right))
 		[
 			','
-			{ *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot);
-			  (*pnd)->nd_symb = '[';
+			{ nd = MkNode(Arrsel, nd, NULLNODE, &dot);
+			  nd->nd_symb = '[';
 			}
-			expression(&((*pnd)->nd_right))
+			expression(&(nd->nd_right))
 		]*
 	']'
 |
-	'^'		{ *pnd = MkNode(Arrow, NULLNODE, *pnd, &dot); }
+	'^'		{ nd = MkNode(Arrow, NULLNODE, nd, &dot); }
+]
+			{ *pnd = nd; }
 ;
diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index e6852401a..5588ae6af 100644
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -129,7 +129,7 @@ DefinitionModule
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
 			  df->df_flags |= D_BUSY;
-			  if (ForeignFlag) df->df_flags |= D_FOREIGN;
+			  df->df_flags |= ForeignFlag;
 			  if (!Defined) Defined = df;
 		  	  CurrentScope->sc_definedby = df;
 			  if (df->df_idf != DefId) {
diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index da40e3b0b..028a0e431 100644
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -20,7 +20,7 @@ struct paramlist {		/* structure for parameterlist of a PROCEDURE */
 
 struct enume {
 	struct def *en_enums;	/* Definitions of enumeration literals */
-	unsigned int en_ncst;	/* Number of constants */
+	arith en_ncst;		/* Number of constants */
 	label en_rck;		/* Label of range check descriptor */
 #define enm_enums	tp_value.tp_enum.en_enums
 #define enm_ncst	tp_value.tp_enum.en_ncst
diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 431218c5e..3f6bd0ea0 100644
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -231,6 +231,9 @@ enum_type(EnumList)
 		standard_type(T_ENUMERATION, int_align, int_size);
 
 	EnterEnumList(EnumList, tp);
+	if (! fit(tp->enm_ncst, (int) int_size)) {
+		node_error(EnumList, "too many enumeration literals");
+	}
 	u_small(tp, (arith) (tp->enm_ncst-1));
 	return tp;
 }
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index ad0bae8fc..d186f2712 100644
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -760,8 +760,7 @@ DoAssign(nd, left, right)
 	}
 	else {
 		CodeValue(&dsr, rtp->tp_size, rtp->tp_align);
-		CodeCoercion(rtp, ltp);
-		RangeCheck(ltp, rtp);
+		CodeCheckExpr(rtp, ltp);
 	}
 	CodeMove(&dsr, left, rtp);
 }
-- 
2.34.1