Added the possibility to disable range-checks

lang/m2/comp/LLlex.c

@@ -42,6 +42,7 @@ extern int	cntlines;
 #endif
 
 static int	eofseen;
+extern char	options[];
 
 STATIC
 SkipComment()
@@ -65,6 +66,21 @@ SkipComment()
 			*/
 			ForeignFlag = D_FOREIGN;
 			break;
+		case 'R':
+			/* Range checks, on or off */
+			LoadChar(ch);
+			if (ch == '-') {
+				options['R'] = 1;
+				break;
+			}
+			if (ch == '+') {
+				options['R'] = 0;
+				break;
+			}
+			/* fall through */
+		default:
+			PushBack();
+			break;
 		}
 	}
 	for (;;) {

lang/m2/comp/chk_expr.c

@@ -1330,5 +1330,5 @@ int (*DesigChkTable[])() = {
 	done_before,
 	NodeCrash,
 	ChkLinkOrName,
-	done_before
+	NodeCrash
 };

lang/m2/comp/code.c

@@ -34,6 +34,7 @@
 extern char	*long2str();
 extern char	*symbol2str();
 extern int	proclevel;
+extern char	options[];
 int		fp_used;
 
 CodeConst(cst, size)
@@ -263,21 +264,21 @@ CodeCoercion(t1, t2)
 			C_cfi();
 			break;
 		case T_CARDINAL:
-		{
-			label lb = ++text_label;
+			if (! options['R']) {
+				label lb = ++text_label;
 
-			C_dup(t1->tp_size);
-			C_zrf(t1->tp_size);
-			C_cmf(t1->tp_size);
-			C_zge(lb);
-			C_loc((arith) ECONV);
-			C_trp();
-			C_df_ilb(lb);
+				C_dup(t1->tp_size);
+				C_zrf(t1->tp_size);
+				C_cmf(t1->tp_size);
+				C_zge(lb);
+				C_loc((arith) ECONV);
+				C_trp();
+				C_df_ilb(lb);
+			}
 			C_loc(t1->tp_size);
 			C_loc(t2->tp_size);
 			C_cfu();
 			break;
-		}
 		default:
 			crash("Funny REAL conversion");
 		}
@@ -583,6 +584,8 @@ RangeCheck(tpl, tpr)
 
 	arith llo, lhi, rlo, rhi;
 
+	if (options['R']) return;
+
 	if (bounded(tpl)) {
 		/* in this case we might need a range check */
 		if (!bounded(tpr)) {

lang/m2/comp/main.c

@@ -39,6 +39,7 @@ int		nDEF, mDEF;
 int		pass_1;
 struct def 	*Defined;
 extern int 	err_occurred;
+extern int 	Roption;
 extern int	fp_used;		/* set if floating point used */
 struct node	*EmptyStatement;
 
@@ -89,6 +90,7 @@ Compile(src, dst)
 	AddStandards();
 	EmptyStatement = dot2leaf(Stat);
 	EmptyStatement->nd_symb = ';';
+	Roption = options['R'];
 #ifdef DEBUG
 	if (options['l']) {
 		LexScan();

lang/m2/comp/node.H

@@ -25,7 +25,7 @@ struct node {
 #define Def	9		/* an identified name */
 #define Stat	10		/* a statement */
 #define Link	11
-#define LinkDef	12
+#define Option	12
 				/* do NOT change the order or the numbers!!! */
 	struct type *nd_type;	/* type of this node */
 	struct token nd_token;
@@ -51,5 +51,5 @@ extern struct node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf();
 #define VARIABLE	004
 #define VALUE		010
 
-#define	IsCast(lnd)	(((lnd)->nd_class == Def || (lnd)->nd_class == LinkDef)  && is_type((lnd)->nd_def))
+#define	IsCast(lnd)	((lnd)->nd_class == Def && is_type((lnd)->nd_def))
 #define	IsProcCall(lnd)	((lnd)->nd_type->tp_fund == T_PROCEDURE)

lang/m2/comp/options.c

@@ -40,6 +40,7 @@ DoOption(text)
 		break;
 
 	case 'L':	/* no fil/lin */
+	case 'R':	/* no range checks */
 	case 'p':	/* call procentry/procexit */
 	case 'n':	/* no register messages */
 	case 'x':	/* every name global */

lang/m2/comp/statement.g

@@ -22,6 +22,8 @@
 #include	"node.h"
 
 static int	loopcount = 0;	/* Count nested loops */
+int		Roption;
+extern char	options[];
 extern struct node *EmptyStatement;
 }
 
@@ -30,6 +32,23 @@ statement(register struct node **pnd;)
 	register struct node *nd;
 	extern int return_occurred;
 } :
+	/* We need some method for making sure lookahead is done, so ...
+	*/
+	[	PROGRAM
+		/* LLlex never returns this */
+	| %default
+				{ if (options['R'] != Roption) {
+					Roption = options['R'];
+					nd = dot2leaf(Option);
+					nd->nd_symb = 'R';
+					*pnd = nd =
+					    dot2node(Link, nd, NULLNODE);
+					nd->nd_symb = ';';
+					pnd = &(nd->nd_right);
+				  }
+				}
+	]
+[
 	/*
 	 * This part is not in the reference grammar. The reference grammar
 	 * states : assignment | ProcedureCall | ...
@@ -88,6 +107,7 @@ statement(register struct node **pnd;)
 			{ return_occurred = 1; }
 |
 	/* empty */	{ *pnd = EmptyStatement; }
+]
 ;
 
 /*
@@ -105,12 +125,13 @@ ProcedureCall:
 StatementSequence(register struct node **pnd;)
 {
 	struct node *nd;
+	register struct node *nd1;
 } :
 	statement(pnd)
 	[ %persistent
-		';' statement(&nd)
-			{ register struct node *nd1 = dot2node(Link, *pnd, nd);
-
+		';'
+		statement(&nd)
+			{ nd1 = dot2node(Link, *pnd, nd);
 			  *pnd = nd1;
 			  nd1->nd_symb = ';';
 			  pnd = &(nd1->nd_right);

lang/m2/comp/walk.c

@@ -417,7 +417,7 @@ WalkStat(nd, exit_label)
 
 	assert(nd->nd_class == Stat);
 
-	if (! options['L']) C_lin((arith) nd->nd_lineno);
+	if (! options['L'] && nd->nd_lineno) C_lin((arith) nd->nd_lineno);
 	switch(nd->nd_symb) {
 	case ';':
 		break;
@@ -630,6 +630,16 @@ WalkStat(nd, exit_label)
 
 extern int	NodeCrash();
 
+STATIC
+WalkOption(nd)
+	struct node *nd;
+{
+	/* Toggle option indicated by node "nd"
+	*/
+
+	options[nd->nd_symb] = ! options[nd->nd_symb];
+}
+
 int (*WalkTable[])() = {
 	NodeCrash,
 	NodeCrash,
@@ -643,7 +653,7 @@ int (*WalkTable[])() = {
 	NodeCrash,
 	WalkStat,
 	WalkLink,
-	NodeCrash
+	WalkOption
 };
 
 ExpectBool(nd, true_label, false_label)