sets now allowed for all subranges

lang/m2/comp/Makefile

@@ -39,7 +39,7 @@ OBJ =	$(COBJ) $(LOBJ) Lpars.o
 
 GENH=	errout.h\
 	idfsize.h numsize.h strsize.h target_sizes.h \
-	inputtype.h maxset.h density.h squeeze.h \
+	inputtype.h density.h squeeze.h \
 	def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h
 HFILES=		LLlex.h\
 	chk_expr.h class.h const.h debug.h f_info.h idf.h\
@@ -214,13 +214,13 @@ type.o: debug.h
 type.o: debugcst.h
 type.o: def.h
 type.o: idf.h
-type.o: maxset.h
 type.o: node.h
 type.o: scope.h
 type.o: squeeze.h
 type.o: target_sizes.h
 type.o: type.h
 type.o: walk.h
+type.o: warning.h
 def.o: LLlex.h
 def.o: Lpars.h
 def.o: debug.h

lang/m2/comp/Parameters

@@ -52,11 +52,6 @@
 #define INP_READ_IN_ONE	1	/* read input file in one	*/
 
 
-!File: maxset.h
-#define MAXSET	1024		/* maximum number of elements in a set,
-				   but what is a reasonable choice ???
-				*/
-
 !File: density.h
 #define DENSITY	3		/* see casestat.C for an explanation */
 

lang/m2/comp/Version.c

@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.23";
+static char Version[] = "ACK Modula-2 compiler Version 0.24";

lang/m2/comp/chk_expr.c

@@ -369,6 +369,7 @@ ChkElement(expp, tp, set)
 		Also try to compute the set!
 	*/
 	register t_node *expr = *expp;
+	t_type *el_type = ElementType(tp);
 	register unsigned int i;
 	arith lo, hi, low, high;
 
@@ -376,8 +377,8 @@ ChkElement(expp, tp, set)
 		/* { ... , expr1 .. expr2,  ... }
 		   First check expr1 and expr2, and try to compute them.
 		*/
-		if (! (ChkEl(&(expr->nd_left), tp) & 
-		       ChkEl(&(expr->nd_right), tp))) {
+		if (! (ChkEl(&(expr->nd_left), el_type) & 
+		       ChkEl(&(expr->nd_right), el_type))) {
 			return 0;
 		}
 
@@ -393,7 +394,7 @@ ChkElement(expp, tp, set)
 		high = expr->nd_right->nd_INT;
 	}
 	else {
-		if (! ChkEl(expp, tp)) return 0;
+		if (! ChkEl(expp, el_type)) return 0;
 		expr = *expp;
 		if (expr->nd_class != Value) {
 			return 1;
@@ -405,12 +406,14 @@ ChkElement(expp, tp, set)
 		return 0;
 	}
 
-	getbounds(tp, &lo, &hi);
+	getbounds(el_type, &lo, &hi);
 	if (low < lo || high > hi) {
 		node_error(expr, "set element out of range");
 		return 0;
 	}
 
+	low -= tp->set_low;
+	high -= tp->set_low;
 	for (i=(unsigned)low; i<= (unsigned)high; i++) {
 		set[i/wrd_bits] |= (1<<(i%wrd_bits));
 	}
@@ -494,8 +497,7 @@ ChkSet(expp)
 	while (nd) {
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-		if (!ChkElement(&(nd->nd_left), ElementType(tp),
-						expp->nd_set)) {
+		if (!ChkElement(&(nd->nd_left), tp, expp->nd_set)) {
 			retval = 0;
 		}
 		if (nd->nd_left) SetIsConstant = 0;

lang/m2/comp/code.c

@@ -569,6 +569,8 @@ CodeStd(nd)
 	case S_EXCL:
 		CodePExpr(left);
 		CodePExpr(arg->nd_left);
+		C_loc(tp->set_low);
+		C_sbi(word_size);
 		C_set(tp->tp_size);
 		if (std == S_INCL) {
 			C_ior(tp->tp_size);
@@ -822,6 +824,8 @@ CodeOper(expr, true_label, false_label)
 		*/
 		CodePExpr(rightop);
 		CodePExpr(leftop);
+		C_loc(rightop->nd_type->set_low);
+		C_sbi(word_size);
 		C_inn(rightop->nd_type->tp_size);
 		if (true_label != NO_LABEL) {
 			C_zne(true_label);
@@ -975,6 +979,7 @@ CodeEl(nd, tp)
 	register t_type *eltype = ElementType(tp);
 
 	if (nd->nd_class == Link && nd->nd_symb == UPTO) {
+		C_loc(tp->set_low);
 		C_loc(tp->tp_size);	/* push size */
 		if (eltype->tp_fund == T_SUBRANGE) {
 			C_loc(eltype->sub_ub);
@@ -982,10 +987,12 @@ CodeEl(nd, tp)
 		else	C_loc((arith) (eltype->enm_ncst - 1));
 		Operands(nd->nd_left, nd->nd_right);
 		C_cal("_LtoUset");	/* library routine to fill set */
-		C_asp(4 * word_size);
+		C_asp(5 * word_size);
 	}
 	else {
 		CodePExpr(nd);
+		C_loc(tp->set_low);
+		C_sbi(word_size);
 		C_set(tp->tp_size);
 		C_ior(tp->tp_size);
 	}

lang/m2/comp/cstoper.c

@@ -258,6 +258,7 @@ cstset(expp)
 
 		assert(expp->nd_left->nd_class == Value);
 
+		expp->nd_left->nd_INT -= expp->nd_right->nd_type->set_low;
 		i = expp->nd_left->nd_INT;
 		expp->nd_class = Value;
 		expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&

lang/m2/comp/em_m2.6

@@ -62,9 +62,6 @@ By default, warnings in class \fBO\fR and \fBW\fR are given.
 allow for warning messages whose class is a member of \fIclasses\fR.
 .IP \fB\-x\fR
 make all procedure names global, so that \fIadb\fR(1) understands them.
-.IP \fB\-i\fR\fInum\fR
-maximum number of bits in a set. When not used, a default value is
-retained.
 .IP \fB\-s\fR
 make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
 This is useful for interpreters that use the "real" MIN(INTEGER) to

lang/m2/comp/options.c

@@ -51,19 +51,6 @@ DoOption(text)
 		options[text[-1]]++;
 		break;
 
-	case 'i':	/* # of bits in set */
-	{
-		char *t = text;
-		int val;
-		extern int maxset;
-
-		val = txt2int(&t);
-		if (val <= 0 || *t) {
-			error("bad -i flag; use -i<num>");
-		}
-		else	maxset = val;
-		break;
-	}
 	case 'w':
 		if (*text) {
 			while (*text) {

lang/m2/comp/type.H

@@ -65,6 +65,11 @@ struct proc {
 #define prc_nbpar	tp_value.tp_proc.pr_nbpar
 };
 
+struct set {
+	arith st_low;
+#define set_low		tp_value.tp_set.st_low
+};
+
 struct type	{
 	struct type *tp_next;	/* used with ARRAY, PROCEDURE, POINTER, SET,
 				   SUBRANGE, EQUAL
@@ -98,6 +103,7 @@ struct type	{
 	    struct array *tp_arr;
 	    struct record tp_record;
 	    struct proc tp_proc;
+	    struct set tp_set;
 	} tp_value;
 };
 

lang/m2/comp/type.c

@@ -11,7 +11,6 @@
 
 #include	"target_sizes.h"
 #include	"debug.h"
-#include	"maxset.h"
 
 #include	<assert.h>
 #include	<alloc.h>
@@ -29,6 +28,7 @@
 #include	"scope.h"
 #include	"walk.h"
 #include	"chk_expr.h"
+#include	"warning.h"
 
 int
 	word_align = AL_WORD,
@@ -40,9 +40,6 @@ int
 	pointer_align = AL_POINTER,
 	struct_align = AL_STRUCT;
 
-int
-	maxset = MAXSET;
-
 arith
 	word_size = SZ_WORD,
 	dword_size = 2 * SZ_WORD,
@@ -467,7 +464,7 @@ set_type(tp)
 	/*	Construct a set type with base type "tp", but first
 		perform some checks
 	*/
-	arith lb, ub;
+	arith lb, ub, diff;
 
 	if (! bounded(tp)) {
 		error("illegal base type for set");
@@ -476,13 +473,19 @@ set_type(tp)
 
 	getbounds(tp, &lb, &ub);
 
-	if (lb < 0 || ub > maxset-1 || (sizeof(int)==2 && ub > 65535)) {
+	if (lb < 0) {
+		warning(W_STRICT, "base type of set has negative lower bound");
+	}
+
+	diff = ub - lb + 1;
+	if (diff < 0 || (sizeof(int) == 2 && diff > 65535)) {
 		error("set type limits exceeded");
 		return error_type;
 	}
 
 	tp = construct_type(T_SET, tp);
-	tp->tp_size = WA((ub + 8) >> 3);
+	tp->tp_size = WA((diff + 7) >> 3);
+	tp->set_low = lb;
 	return tp;
 }