From befe7be9de5d0bdfc7afc92e0ab7144af1f7e9e6 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Thu, 18 Jun 1987 17:42:47 +0000
Subject: [PATCH] Added a kind of range-check for assignments between cards and
 ints

---
 lang/m2/comp/code.c   | 15 ++++++++++++++-
 lang/m2/comp/declar.g | 32 +++++++++++++++++++++++++++++---
 2 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index a620468d7..f2e846a36 100644
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -17,6 +17,7 @@
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	<em_code.h>
+#include	<em_abs.h>
 #include	<assert.h>
 
 #include	"type.h"
@@ -396,7 +397,7 @@ CodeParameters(param, arg)
 		return;
 	}
 	CodePExpr(left);
-	CodeCheckExpr(left, tp);
+	CodeCheckExpr(left_type, tp);
 }
 
 CodeCheckExpr(tp1, tp2)
@@ -586,6 +587,18 @@ RangeCheck(tpl, tpr)
 			}
 		}
 	}
+	else if (tpl->tp_size <= tpr->tp_size &&
+		 ((tpl->tp_fund == T_INTEGER && tpr == card_type) ||
+		  (tpr->tp_fund == T_INTEGER && tpl == card_type))) {
+		label lb = ++text_label;
+
+		C_dup(word_size);
+		C_zge(lb);
+		C_loc((arith) ECONV);
+		C_trp();
+		C_df_ilb(lb);
+	}
+
 }
 
 Operands(leftop, rightop, tp)
diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index ff256dcc1..0f235d7ce 100644
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -35,6 +35,7 @@ int		return_occurred;	/* set if a return occurs in a block */
 
 }
 
+/* inline in declaration: need space
 ProcedureDeclaration
 {
 	struct def *df;
@@ -47,6 +48,7 @@ ProcedureDeclaration
 				--proclevel;
 			}
 ;
+*/
 
 ProcedureHeading(struct def **pdf; int type;)
 {
@@ -56,7 +58,18 @@ ProcedureHeading(struct def **pdf; int type;)
 } :
 	PROCEDURE IDENT
 			{ *pdf = DeclProc(type, dot.TOK_IDF); }
-	FormalParameters(&pr, &parmaddr, &tp)?
+	[
+		'('
+		[
+			FPSection(&pr, &parmaddr)
+			[
+				';' FPSection(&pr, &parmaddr)
+			]*
+		]?
+		')'
+		[	':' qualtype(&tp)
+		]?
+	]?
 			{ CheckWithDef(*pdf, proc_type(tp, pr, parmaddr));
 			  if (tp && IsConstructed(tp)) {
 warning(W_STRICT, "procedure \"%s\" has a constructed result type",
@@ -77,18 +90,30 @@ block(struct node **pnd;) :
 	END
 ;
 
-declaration:
+declaration
+{
+	struct def *df;
+} :
 	CONST [ ConstantDeclaration ';' ]*
 |
 	TYPE [ TypeDeclaration ';' ]*
 |
 	VAR [ VariableDeclaration ';' ]*
 |
-	ProcedureDeclaration ';'
+			{	++proclevel; }
+	ProcedureHeading(&df, D_PROCEDURE)
+	';'
+	block(&(df->prc_body))
+	IDENT
+			{	EndProc(df, dot.TOK_IDF);
+				--proclevel;
+			}
+	';'
 |
 	ModuleDeclaration ';'
 ;
 
+/* inline in procedureheading: need space
 FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
 	'('
 	[
@@ -101,6 +126,7 @@ FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
 	[	':' qualtype(ptp)
 	]?
 ;
+*/
 
 FPSection(struct paramlist **ppr; arith *parmaddr;)
 {
-- 
2.34.1