too many changes: some cosmetic; some for 2/4; some for added options

lang/m2/comp/modula-2.1

@@ -84,9 +84,6 @@ make all procedure names global, so that \fIadb\fR(1) understands them.
 make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
 This is useful for interpreters that use the "real" MIN(INTEGER) to
 indicate "undefined".
-.IP \fB\-Xi\fR\fIn\fR
-set maximum number of bits in a set to \fIn\fP.
-When not used, a default value is retained.
 .LP
 .SH SEE ALSO
 \fIack\fR(1), \fIem_m2\fR(6)

lang/m2/comp/options.c

@@ -21,6 +21,8 @@
 #include	"warning.h"
 #include	"nostrict.h"
 #include	"nocross.h"
+#include	"class.h"
+#include	"squeeze.h"
 
 #define	MINIDFSIZE	14
 
@@ -42,8 +44,14 @@ DoOption(text)
 		options[*text]++;	/* debug options etc.	*/
 		break;
 
+	case 'U':	/* allow underscores in identifiers */
+		inidf['_'] = 1;
+		break;
 	case 'L':	/* no fil/lin */
 	case 'R':	/* no range checks */
+	case 'A':	/* extra array bound checks, for machines that do not
+			   implement it in AAR/LAR/SAR
+			*/
 	case 'n':	/* no register messages */
 	case 'x':	/* every name global */
 	case 's':	/* symmetric: MIN(INTEGER) = -MAX(INTEGER) */
@@ -98,6 +106,7 @@ DoOption(text)
 		break;
 
 	case 'M': {	/* maximum identifier length */
+#ifndef SQUEEZE
 		char *t = text;		/* because &text is illegal */
 
 		idfsize = txt2int(&t);
@@ -111,6 +120,7 @@ DoOption(text)
 			warning(W_ORDINARY, "minimum identifier length is %d", MINIDFSIZE);
 			idfsize = MINIDFSIZE;
 		}
+#endif
 		}
 		break;
 
@@ -223,6 +233,7 @@ DoOption(text)
 	}
 }
 
+#if (!SQUEEZE) | (!NOCROSS)
 int
 txt2int(tp)
 	register char **tp;
@@ -239,3 +250,4 @@ txt2int(tp)
 	}
 	return val;
 }
+#endif

lang/m2/comp/type.H

@@ -45,9 +45,13 @@ struct array {
 	struct type *ar_elem;	/* type of elements */
 	label ar_descr;		/* label of array descriptor */
 	arith ar_elsize;	/* size of elements */
+	arith ar_low;		/* lower bound of index */
+	arith ar_high;		/* upper bound of index */
 #define arr_elem	tp_value.tp_arr->ar_elem
 #define arr_descr	tp_value.tp_arr->ar_descr
 #define arr_elsize	tp_value.tp_arr->ar_elsize
+#define arr_low		tp_value.tp_arr->ar_low
+#define arr_high	tp_value.tp_arr->ar_high
 };
 
 /* ALLOCDEF "array" 5 */
@@ -117,6 +121,7 @@ extern t_type
 	*int_type,
 	*card_type,
 	*longint_type,
+	*longcard_type,
 	*real_type,
 	*longreal_type,
 	*word_type,

lang/m2/comp/type.c

@@ -58,6 +58,7 @@ t_type
 	*int_type,
 	*card_type,
 	*longint_type,
+	*longcard_type,
 	*real_type,
 	*longreal_type,
 	*word_type,
@@ -92,7 +93,7 @@ construct_type(fund, tp)
 
 	case T_ARRAY:
 		dtp->tp_value.tp_arr = new_array();
-		if (tp) dtp->tp_align = tp->tp_align;
+		dtp->tp_align = struct_align;
 		break;
 
 	case T_SUBRANGE:
@@ -151,13 +152,8 @@ InitTypes()
 		fatal("integer size not equal to word size");
 	}
 
-	if ((int) int_size != (int) pointer_size) {
+	if ((int) long_size < (int) int_size) {
-		fatal("cardinal size not equal to pointer size");
+		fatal("long integer size smaller than integer size");
-	}
-
-	if ((int) long_size < (int) int_size ||
-	    (int) long_size % (int) word_size != 0) {
-		fatal("illegal long integer size");
 	}
 
 	if ((int) double_size < (int) float_size) {
@@ -179,6 +175,7 @@ InitTypes()
 	*/
 	int_type = standard_type(T_INTEGER, int_align, int_size);
 	longint_type = standard_type(T_INTEGER, long_align, long_size);
+	longcard_type = standard_type(T_CARDINAL, long_align, long_size);
 	card_type = standard_type(T_CARDINAL, int_align, int_size);
 	intorcard_type = standard_type(T_INTORCARD, int_align, int_size);
 
@@ -402,6 +399,9 @@ proc_type(result_type, parameters, n_bytes_params)
 	if (! fit(n_bytes_params, (int) word_size)) {
 		error("maximum parameter byte count exceeded");
 	}
+	if (result_type && ! fit(WA(result_type->tp_size), (int) word_size)) {
+		error("maximum return value size exceeded");
+	}
 	return tp;
 }
 
@@ -496,7 +496,6 @@ set_type(tp)
 	return tp;
 }
 
-arith
 ArrayElSize(tp)
 	register t_type *tp;
 {
@@ -505,16 +504,23 @@ ArrayElSize(tp)
 	   or a multiple of it.
 	*/
 	register arith algn;
+	register t_type *elem_type = tp->arr_elem;
 
-	if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
+	if (elem_type->tp_fund == T_ARRAY) ArraySizes(elem_type);
-	algn = align(tp->tp_size, tp->tp_align);
+	algn = align(elem_type->tp_size, elem_type->tp_align);
 	if (word_size % algn != 0) {
 		/* algn is not a dividor of the word size, so make sure it
 		   is a multiple
 		*/
-		return WA(algn);
+		algn = WA(algn);
+	}
+	if (! fit(algn, (int) word_size)) {
+		error("element size of array too large");
+	}
+	tp->arr_elsize = algn;
+	if (tp->tp_align < elem_type->tp_align) {
+		tp->tp_align = elem_type->tp_align;
 	}
-	return algn;
 }
 
 ArraySizes(tp)
@@ -523,25 +529,29 @@ ArraySizes(tp)
 	/*	Assign sizes to an array type, and check index type
 	*/
 	register t_type *index_type = IndexType(tp);
-	register t_type *elem_type = tp->arr_elem;
 	arith lo, hi, diff;
 
-	tp->arr_elsize = ArrayElSize(elem_type);
+	ArrayElSize(tp);
-	tp->tp_align = elem_type->tp_align;
 
 	/* check index type
 	*/
-	if (! bounded(index_type)) {
+	if (index_type->tp_size > word_size || ! bounded(index_type)) {
 		error("illegal index type");
 		tp->tp_size = tp->arr_elsize;
 		return;
 	}
 
 	getbounds(index_type, &lo, &hi);
+	tp->arr_low = lo;
+	tp->arr_high = hi;
 	diff = hi - lo;
 
-	tp->tp_size = (diff + 1) * tp->arr_elsize;
+	if (! fit(diff, (int) int_size)) {
-	if (! fit(tp->tp_size, (int) word_size)) {
+		error("too many elements in array");
+	}
+
+	tp->tp_size = align((diff + 1) * tp->arr_elsize, tp->tp_align);
+	if (! ufit(tp->tp_size, (int) pointer_size)) {
 		error("array too large");
 	}
 
@@ -549,7 +559,7 @@ ArraySizes(tp)
 	*/
 	tp->arr_descr = ++data_label;
 	C_df_dlb(tp->arr_descr);
-	C_rom_cst(lo);
+	C_rom_cst((arith) 0);
 	C_rom_cst(diff);
 	C_rom_cst(tp->arr_elsize);
 }

lang/m2/comp/typequiv.c

@@ -146,8 +146,8 @@ TstAssCompat(tp1, tp2)
 	tp1 = BaseType(tp1);
 	tp2 = BaseType(tp2);
 
-	if ((tp1->tp_fund & T_INTORCARD) &&
+	if (((tp1->tp_fund & T_INTORCARD) || tp1 == address_type) &&
-	    (tp2->tp_fund & T_INTORCARD)) return 1;
+	    ((tp2->tp_fund & T_INTORCARD) || tp2 == address_type)) return 1;
 
 	if ((tp1->tp_fund == T_REAL) &&
 	    (tp2->tp_fund == T_REAL)) return 1;

lang/m2/comp/walk.c

@@ -297,7 +297,8 @@ WalkProcedure(procedure)
 					}
 					StackAdjustment = NewPtr();
 					C_lor((arith) 1);
-					C_stl(StackAdjustment);
+					C_lal(StackAdjustment);
+					C_sti(pointer_size);
 				}
 				/* First compute new stackpointer */
 				C_lal(param->par_def->var_off);
@@ -306,11 +307,12 @@ WalkProcedure(procedure)
 				C_lfr(pointer_size);
 				C_str((arith) 1);
 						/* adjusted stack pointer */
-				C_lol(param->par_def->var_off);
+				C_lal(param->par_def->var_off);
+				C_loi(pointer_size);
 						/* push source address */
 				C_cal("_copy_array");
 						/* copy */
-				C_asp(word_size);
+				C_asp(pointer_size);
 			}
 		}
 	}
@@ -334,7 +336,8 @@ WalkProcedure(procedure)
 		if (StackAdjustment) {
 			/* Remove copies of conformant arrays
 			*/
-			C_lol(StackAdjustment);
+			C_lal(StackAdjustment);
+			C_loi(pointer_size);
 			C_str((arith) 1);
 		}
 		c_lae_dlb(func_res_label);
@@ -349,7 +352,8 @@ WalkProcedure(procedure)
 			C_lal(retsav);
 			C_sti(func_res_size);
 		}
-		C_lol(StackAdjustment);
+		C_lal(StackAdjustment);
+		C_loi(pointer_size);
 		C_str((arith) 1);
 		if (func_type) {
 			C_lal(retsav);