From b66881035150b78da6247c72f401ea1a20a5036e Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 28 Oct 1987 16:03:56 +0000 Subject: [PATCH] sets now allowed for all subranges --- lang/m2/comp/Makefile | 4 ++-- lang/m2/comp/Parameters | 5 ----- lang/m2/comp/Version.c | 2 +- lang/m2/comp/chk_expr.c | 14 ++++++++------ lang/m2/comp/code.c | 9 ++++++++- lang/m2/comp/cstoper.c | 1 + lang/m2/comp/em_m2.6 | 3 --- lang/m2/comp/options.c | 13 ------------- lang/m2/comp/type.H | 6 ++++++ lang/m2/comp/type.c | 17 ++++++++++------- 10 files changed, 36 insertions(+), 38 deletions(-) diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index b944a3b73..2c25981a4 100644 --- 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 1753ad15e..76eb4946d 100644 --- 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 88c50dce4..ff5e11d27 100644 --- 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 a7048bfaa..a0eafbaf3 100644 --- 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 df1f4d35c..3ce4feb74 100644 --- 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 27b67ae42..0c6a06a60 100644 --- 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 622eedc5d..e572f5c6c 100644 --- 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 c81405f07..7854a3ab1 100644 --- 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"); - } - 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 a29518768..d89d58772 100644 --- 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 3a46718cd..862c1f533 100644 --- 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 #include @@ -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; } -- 2.34.1