sets now allowed for all subranges

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index b944a3b..2c25981 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/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

diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
index 1753ad1..76eb494 100644 (file)
--- a/lang/m2/comp/Parameters
+++ b/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 */
 

diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c
index 88c50dc..ff5e11d 100644 (file)
--- a/lang/m2/comp/Version.c
+++ b/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";

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index a7048bf..a0eafba 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/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;

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index df1f4d3..3ce4feb 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/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);
        }

diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index 27b67ae..0c6a06a 100644 (file)
--- a/lang/m2/comp/cstoper.c
+++ b/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 &&

diff --git a/lang/m2/comp/em_m2.6 b/lang/m2/comp/em_m2.6
index 622eedc..e572f5c 100644 (file)
--- a/lang/m2/comp/em_m2.6
+++ b/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

diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index c81405f..7854a3a 100644 (file)
--- a/lang/m2/comp/options.c
+++ b/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) {

diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index a295187..d89d587 100644 (file)
--- a/lang/m2/comp/type.H
+++ b/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;
 };
 

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 3a46718..862c1f5 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/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;
 }