fixes, changes to make smaller on PDP

lang/m2/comp/chk_expr.c

@@ -45,8 +45,9 @@ Xerror(nd, mess, edf)
 		if (edf->df_kind != D_ERROR)  {
 			node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess);
 		}
+		return;
 	}
-	else	node_error(nd, "%s", mess);
+	node_error(nd, "%s", mess);
 }
 
 int
@@ -277,9 +278,24 @@ node_error(expp, "standard or local procedures may not be assigned");
 }
 
 STATIC int
-ChkElement(expp, tp, set, level)
+ChkEl(expr, tp)
+	register struct node *expr;
+	struct type *tp;
+{
+	if (!ChkExpression(expr)) return 0;
+
+	if (!TstCompat(tp, expr->nd_type)) {
+		node_error(expr, "set element has incompatible type");
+		return 0;
+	}
+
+	return 1;
+}
+
+STATIC int
+ChkElement(expp, tp, set)
 	struct node **expp;
-	register struct type *tp;
+	struct type *tp;
 	arith **set;
 {
 	/*	Check elements of a set. This routine may call itself
@@ -289,66 +305,50 @@ ChkElement(expp, tp, set, level)
 	register struct node *expr = *expp;
 	register struct node *left = expr->nd_left;
 	register struct node *right = expr->nd_right;
-	register arith i;
+	register unsigned int i;
+	arith lo, hi, low, high;
 
 	if (expr->nd_class == Link && expr->nd_symb == UPTO) {
 		/* { ... , expr1 .. expr2,  ... }
 		   First check expr1 and expr2, and try to compute them.
 		*/
-		if (!ChkElement(&(expr->nd_left), tp, set, 1) ||
+		if (! (ChkEl(left, tp) & ChkEl(right, tp))) {
-		    !ChkElement(&(expr->nd_right), tp, set, 1)) {
 			return 0;
 		}
 
-		if (left->nd_class == Value && right->nd_class == Value) {
+		if (!(left->nd_class == Value && right->nd_class == Value)) {
-			/* We have a constant range. Put all elements in the
+			return 1;
-			   set
-			*/
-
-		    	if (left->nd_INT > right->nd_INT) {
-node_error(expr, "lower bound exceeds upper bound in range");
-				return 0;
-			}
-
-			for (i=left->nd_INT; i<=right->nd_INT; i++) {
-				(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
-			}
-			FreeNode(expr);
-			*expp = 0;
 		}
+		/* We have a constant range. Put all elements in the
+		  set
+		*/
 
-		return 1;
+		low = left->nd_INT;
+		high = right->nd_INT;
 	}
-
+	else {
-	/* Here, a single element is checked
+		if (! ChkEl(expr, tp)) return 0;
-	*/
+		if (expr->nd_class != Value) {
-	if (!ChkExpression(expr)) return 0;
+			return 1;
-
+		}
-	if (!TstCompat(tp, expr->nd_type)) {
+		low = high = expr->nd_INT;
-		node_error(expr, "set element has incompatible type");
+	}
+	if (low > high) {
+		node_error(expr, "lower bound exceeds upper bound in range");
 		return 0;
 	}
 
-	if (expr->nd_class == Value) {
+	getbounds(tp, &lo, &hi);
-		/* a constant element
+	if (low < lo || high > hi) {
-		*/
+		node_error(expr, "set element out of range");
-		arith low, high;
+		return 0;
-
-		i = expr->nd_INT;
-		getbounds(tp, &low, &high);
-
-	    	if (i < low || i > high) {
-			node_error(expr, "set element out of range");
-			return 0;
-		}
-
-		if (! level) {
-			(*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
-			FreeNode(expr);
-			*expp = 0;
-		}
 	}
 
+	for (i=(unsigned)low; i<= (unsigned)high; i++) {
+		(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
+	}
+	FreeNode(expr);
+	*expp = 0;
 	return 1;
 }
 
@@ -407,7 +407,7 @@ ChkSet(expp)
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
 
 		if (!ChkElement(&(nd->nd_left), ElementType(tp),
-						&(expp->nd_set), 0)) {
+						&(expp->nd_set))) {
 			retval = 0;
 		}
 		if (nd->nd_left) expp->nd_class = Xset;
@@ -1172,6 +1172,7 @@ ChkCast(expp, left)
 		is no problem as such values take a word on the EM stack
 		anyway.
 	*/
+	register struct type *lefttype = left->nd_type;
 	register struct node *arg = expp->nd_right;
 
 	if ((! arg) || arg->nd_right) {
@@ -1182,23 +1183,21 @@ ChkCast(expp, left)
 	arg = arg->nd_left;
 	if (! ChkExpression(arg)) return 0;
 
-	if (arg->nd_type->tp_size != left->nd_type->tp_size &&
+	if (arg->nd_type->tp_size != lefttype->tp_size &&
 	    (arg->nd_type->tp_size > word_size ||
-	     left->nd_type->tp_size > word_size)) {
+	     lefttype->tp_size > word_size)) {
 		Xerror(expp, "unequal sizes in type cast", left->nd_def);
 	}
 
 	if (arg->nd_class == Value) {
-		struct type *tp = left->nd_type;
-
 		FreeNode(left);
 		expp->nd_right->nd_left = 0;
 		FreeNode(expp->nd_right);
 		expp->nd_left = expp->nd_right = 0;
 		*expp = *arg;
-		expp->nd_type = tp;
+		expp->nd_type = lefttype;
 	}
-	else expp->nd_type = left->nd_type;
+	else expp->nd_type = lefttype;
 
 	return 1;
 }

lang/m2/comp/code.c

@@ -36,24 +36,25 @@ extern int	proclevel;
 int		fp_used;
 
 CodeConst(cst, size)
-	arith cst, size;
+	arith cst;
+	int size;
 {
 	/*	Generate code to push constant "cst" with size "size"
 	*/
 
-	if (size <= word_size) {
+	if (size <= (int) word_size) {
 		C_loc(cst);
 	}
-	else if (size == dword_size) {
+	else if (size == (int) dword_size) {
 		C_ldc(cst);
 	}
 	else {
 		crash("(CodeConst)");
 /*
 		C_df_dlb(++data_label);
-		C_rom_icon(long2str((long) cst), size);
+		C_rom_icon(long2str((long) cst), (arith) size);
 		C_lae_dlb(data_label, (arith) 0);
-		C_loi(size);
+		C_loi((arith) size);
 */
 	}
 }
@@ -64,12 +65,11 @@ CodeString(nd)
 	if (nd->nd_type->tp_fund != T_STRING) {
 		/* Character constant */
 		C_loc(nd->nd_INT);
+		return;
 	}
-	else {
+	C_df_dlb(++data_label);
-		C_df_dlb(++data_label);
+	C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
-		C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
+	C_lae_dlb(data_label, (arith) 0);
-		C_lae_dlb(data_label, (arith) 0);
-	}
 }
 
 CodeExpr(nd, ds, true_label, false_label)
@@ -111,15 +111,15 @@ CodeExpr(nd, ds, true_label, false_label)
 		switch(nd->nd_symb) {
 		case REAL:
 			C_df_dlb(++data_label);
-			C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
+			C_rom_fcon(nd->nd_REL, tp->tp_size);
 			C_lae_dlb(data_label, (arith) 0);
-			C_loi(nd->nd_type->tp_size);
+			C_loi(tp->tp_size);
 			break;
 		case STRING:
 			CodeString(nd);
 			break;
 		case INTEGER:
-			CodeConst(nd->nd_INT, tp->tp_size);
+			CodeConst(nd->nd_INT, (int) (tp->tp_size));
 			break;
 		default:
 			crash("Value error");
@@ -134,11 +134,11 @@ CodeExpr(nd, ds, true_label, false_label)
 
 	case Xset:
 	case Set: {
-		register int i = tp->tp_size / word_size;
+		register unsigned i = (unsigned) (tp->tp_size) / (int) word_size;
 		register arith *st = nd->nd_set + i;
 
 		ds->dsg_kind = DSG_LOADED;
-		for (; i > 0; i--) { 
+		for (; i; i--) { 
 			C_loc(*--st);
 		}
 		CodeSet(nd);
@@ -282,6 +282,7 @@ CodeCall(nd)
 		and result is already done.
 	*/
 	register struct node *left = nd->nd_left;
+	register struct def *df;
 	register struct node *right = nd->nd_right;
 	register struct type *result_tp;
 
@@ -307,7 +308,7 @@ CodeCall(nd)
 
 	switch(left->nd_class) {
 	case Def: {
-		register struct def *df = left->nd_def;
+		df = left->nd_def;
 
 		if (df->df_kind == D_PROCEDURE) {
 			int level = df->df_scope->sc_level;
@@ -516,9 +517,28 @@ CodeStd(nd)
 		CodePExpr(left);
 		break;
 
-	case S_TRUNCD:
-	case S_TRUNC:
 	case S_FLOAT:
+		CodePExpr(left);
+		RangeCheck(card_type, left->nd_type);
+		CodeCoercion(tp, nd->nd_type);
+		break;
+
+	case S_TRUNC: {
+		label lb = ++text_label;
+
+		CodePExpr(left);
+		C_dup(tp->tp_size);
+		C_zrf(tp->tp_size);
+		C_cmf(tp->tp_size);
+		C_zge(lb);
+		C_loc((arith) ECONV);
+		C_trp();
+		C_df_ilb(lb);
+		CodeCoercion(tp, nd->nd_type);
+		}
+		break;
+
+	case S_TRUNCD:
 	case S_FLOATD:
 	case S_LONG:
 	case S_SHORT:
@@ -816,11 +836,11 @@ CodeOper(expr, true_label, false_label)
 		if (true_label != NO_LABEL)	{
 			compare(expr->nd_symb, true_label);
 			C_bra(false_label);
+			break;
 		}
-		else	{
+		truthvalue(expr->nd_symb);
-			truthvalue(expr->nd_symb);
-		}
 		break;
+
 	case IN:
 		/* In this case, evaluate right hand side first! The
 		   INN instruction expects the bit number on top of the

lang/m2/comp/const.h

@@ -16,5 +16,6 @@ extern int
 extern arith
 	max_int,	/* maximum integer on target machine	*/
 	max_unsigned, 	/* maximum unsigned on target machine	*/
-	max_longint,	/* maximum longint on target machine	*/
+	max_longint;	/* maximum longint on target machine	*/
+extern unsigned int
 	wrd_bits;	/* Number of bits in a word */

lang/m2/comp/cstoper.c

@@ -30,7 +30,7 @@ long full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
 arith max_int;		/* maximum integer on target machine	*/
 arith max_unsigned;	/* maximum unsigned on target machine	*/
 arith max_longint;	/* maximum longint on target machine	*/
-arith wrd_bits;		/* number of bits in a word */
+unsigned int wrd_bits;	/* number of bits in a word */
 
 extern char options[];
 
@@ -42,7 +42,7 @@ cstunary(expp)
 	/*	The unary operation in "expp" is performed on the constant
 		expression below it, and the result restored in expp.
 	*/
-	register arith o1 = expp->nd_right->nd_INT;
+	register struct node *right = expp->nd_right;
 
 	switch(expp->nd_symb) {
 	/* Should not get here
@@ -51,7 +51,7 @@ cstunary(expp)
 	*/
 
 	case '-':
-		o1 = -o1;
+		expp->nd_INT = -right->nd_INT;
 		if (expp->nd_type->tp_fund == T_INTORCARD) {
 			expp->nd_type = int_type;
 		}
@@ -59,7 +59,7 @@ cstunary(expp)
 
 	case NOT:
 	case '~':
-		o1 = !o1;
+		expp->nd_INT = !right->nd_INT;
 		break;
 
 	default:
@@ -67,10 +67,9 @@ cstunary(expp)
 	}
 
 	expp->nd_class = Value;
-	expp->nd_token = expp->nd_right->nd_token;
+	expp->nd_symb = right->nd_symb;
-	expp->nd_INT = o1;
 	CutSize(expp);
-	FreeNode(expp->nd_right);
+	FreeNode(right);
 	expp->nd_right = 0;
 }
 
@@ -247,21 +246,23 @@ cstset(expp)
 {
 	register arith *set1, *set2;
 	arith *resultset = 0;
-	register int setsize, j;
+	register unsigned int setsize;
+	register int j;
 
 	assert(expp->nd_right->nd_class == Set);
 	assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
 	set2 = expp->nd_right->nd_set;
-	setsize = expp->nd_right->nd_type->tp_size / word_size;
+	setsize = (unsigned) expp->nd_right->nd_type->tp_size / (unsigned) word_size;
 
 	if (expp->nd_symb == IN) {
-		arith i;
+		unsigned i;
 
 		assert(expp->nd_left->nd_class == Value);
 
 		i = expp->nd_left->nd_INT;
 		expp->nd_class = Value;
-		expp->nd_INT = (i >= 0 && i < setsize * wrd_bits &&
+		expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&
+				expp->nd_left->nd_INT < setsize * wrd_bits &&
 		    (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
 		free((char *) set2);
 		expp->nd_symb = INTEGER;
@@ -531,5 +532,5 @@ InitCst()
 	max_int = full_mask[int_size] & ~(1L << (int_size * 8 - 1));
 	max_unsigned = full_mask[int_size];
 	max_longint = full_mask[long_size] & ~(1L << (long_size * 8 - 1));
-	wrd_bits = 8 * word_size;
+	wrd_bits = 8 * (unsigned) word_size;
 }

lang/m2/comp/desig.c

@@ -33,42 +33,54 @@
 extern int	proclevel;
 struct desig	InitDesig = {DSG_INIT, 0, 0, 0};
 
-int	C_ste_dnam(), C_sde_dnam(), C_loe_dnam(), C_lde_dnam();
-int	C_stl(), C_sdl(), C_lol(), C_ldl();
-
-#define WRD	0
-#define DWRD	1
-#define LD	0
-#define STR	1
-
-static int (*lcl_ld_and_str[2][2])() = {
-{ C_lol, C_stl },
-{ C_ldl, C_sdl }
-};
-
-static int (*ext_ld_and_str[2][2])() = {
-{ C_loe_dnam, C_ste_dnam },
-{ C_lde_dnam, C_sde_dnam }
-};
-
 int
-DoLoadOrStore(ds, size, LoadOrStoreFlag)
+WordOrDouble(ds, size)
 	register struct desig *ds;
 	arith size;
 {
-	int sz;
+	return ((int) (ds->dsg_offset) % (int) word_size == 0 &&
-
+		( (int) size == (int) word_size ||
-	if (ds->dsg_offset % word_size != 0) return 0;
+		  (int) size == (int) dword_size));
-
+}
-	if (size == word_size) sz = WRD;
-	else if (size == dword_size) sz = DWRD;
-	else return 0;
 
+int
+DoLoad(ds, size)
+	register struct desig *ds;
+	arith size;
+{
+	if (! WordOrDouble(ds, size)) return 0;
 	if (ds->dsg_name) {
-		(*(ext_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_name, ds->dsg_offset);
+		if ((int) size == (int) word_size) {
+			C_loe_dnam(ds->dsg_name, ds->dsg_offset);
+		}
+		else	C_lde_dnam(ds->dsg_name, ds->dsg_offset);
 	}
 	else {
-		(*(lcl_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_offset);
+		if ((int) size == (int) word_size) {
+			C_lol(ds->dsg_offset);
+		}
+		else	C_ldl(ds->dsg_offset);
+	}
+	return 1;
+}
+
+int
+DoStore(ds, size)
+	register struct desig *ds;
+	arith size;
+{
+	if (! WordOrDouble(ds, size)) return 0;
+	if (ds->dsg_name) {
+		if ((int) size == (int) word_size) {
+			C_ste_dnam(ds->dsg_name, ds->dsg_offset);
+		}
+		else	C_sde_dnam(ds->dsg_name, ds->dsg_offset);
+	}
+	else {
+		if ((int) size == (int) word_size) {
+			C_stl(ds->dsg_offset);
+		}
+		else	C_sdl(ds->dsg_offset);
 	}
 	return 1;
 }
@@ -88,15 +100,15 @@ properly(ds, size, al)
 		  with DSG_FIXED.
 	*/
 
-	arith szmodword = size % word_size;	/* 0 if multiple of wordsize */
+	int szmodword = (int) size % (int) word_size;	/* 0 if multiple of wordsize */
-	arith wordmodsz = word_size % size;	/* 0 if dividor of wordsize */
+	int wordmodsz = word_size % size;	/* 0 if dividor of wordsize */
 
 	if (szmodword && wordmodsz) return 0;
 	if (al >= word_align) return 1;
 	if (szmodword && al >= szmodword) return 1;
 
 	return ds->dsg_kind == DSG_FIXED &&
-	       ((! szmodword && ds->dsg_offset % word_align == 0) ||
+	       ((! szmodword && (int) (ds->dsg_offset) % word_align == 0) ||
 		(! wordmodsz && ds->dsg_offset % size == 0));
 }
 
@@ -114,7 +126,7 @@ CodeValue(ds, tp)
 		break;
 
 	case DSG_FIXED:
-		if (DoLoadOrStore(ds, tp->tp_size, LD)) break;
+		if (DoLoad(ds, tp->tp_size)) break;
 		/* Fall through */
 	case DSG_PLOADED:
 	case DSG_PFIXED:
@@ -167,7 +179,7 @@ CodeStore(ds, tp)
 	save = *ds;
 	switch(ds->dsg_kind) {
 	case DSG_FIXED:
-		if (DoLoadOrStore(ds, tp->tp_size, STR)) break;
+		if (DoStore(ds, tp->tp_size)) break;
 		/* Fall through */
 	case DSG_PLOADED:
 	case DSG_PFIXED:
@@ -242,7 +254,8 @@ CodeMove(rhs, left, rtp)
 	case DSG_PLOADED:
 	case DSG_PFIXED:
 		CodeAddress(rhs);
-		if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) {
+		if ((int) (tp->tp_size) % (int) word_size == 0 &&
+		    tp->tp_align >= (int) word_size) {
 			CodeDesig(left, lhs);
 			CodeAddress(lhs);
 			C_blm(tp->tp_size);
@@ -254,12 +267,13 @@ CodeMove(rhs, left, rtp)
 	case DSG_FIXED:
 		CodeDesig(left, lhs);
 		if (lhs->dsg_kind == DSG_FIXED &&
-		    lhs->dsg_offset % word_size ==
+		    (int) (lhs->dsg_offset) % (int) word_size ==
-		    rhs->dsg_offset % word_size) {
+		    (int) (rhs->dsg_offset) % (int) word_size) {
 			register int sz;
 			arith size = tp->tp_size;
 
-			while (size && (sz = (lhs->dsg_offset % word_size))) {
+			while (size &&
+			       (sz = ((int)(lhs->dsg_offset) % (int)word_size))) {
 				/*	First copy up to word-aligned
 					boundaries
 				*/
@@ -282,7 +296,7 @@ CodeMove(rhs, left, rtp)
 				lhs->dsg_offset += sz;
 				size -= sz;
 			}
-			else for (sz = dword_size; sz; sz -= word_size) {
+			else for (sz = (int) dword_size; sz; sz -= (int) word_size) {
 				while (size >= sz) {
 					/*	Then copy dwords, words.
 						Depend on peephole optimizer
@@ -306,7 +320,8 @@ CodeMove(rhs, left, rtp)
 			CodeAddress(lhs);
 			loadedflag = 1;
 		}
-		if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) {
+		if ((int)(tp->tp_size) % (int) word_size == 0 &&
+		    tp->tp_align >= word_size) {
 			CodeAddress(rhs);
 			if (loadedflag) C_exg(pointer_size);
 			else CodeAddress(lhs);
@@ -359,7 +374,7 @@ CodeAddress(ds)
 		break;
 		
 	case DSG_PFIXED:
-		DoLoadOrStore(ds, word_size, LD);
+		DoLoad(ds, word_size);
 		break;
 
 	case DSG_INDEXED:
@@ -445,7 +460,7 @@ CodeVarDesig(df, ds)
 		/* the programmer specified an address in the declaration of
 		   the variable. Generate code to push the address.
 		*/
-		CodeConst(df->var_off, pointer_size);
+		CodeConst(df->var_off, (int) pointer_size);
 		ds->dsg_kind = DSG_PLOADED;
 		ds->dsg_offset = 0;
 		return;

lang/m2/comp/options.c

@@ -80,19 +80,22 @@ DoOption(text)
 		break;
 
 	case 'W':
-		while (*text) {
+		if (*text) {
-			switch(*text++) {
+			while (*text) {
-			case 'O':
+				switch(*text++) {
-				warning_classes |= W_OLDFASHIONED;
+				case 'O':
-				break;
+					warning_classes |= W_OLDFASHIONED;
-			case 'R':
+					break;
-				warning_classes |= W_STRICT;
+				case 'R':
-				break;
+					warning_classes |= W_STRICT;
-			case 'W':
+					break;
-				warning_classes |= W_ORDINARY;
+				case 'W':
-				break;
+					warning_classes |= W_ORDINARY;
+					break;
+				}
 			}
 		}
+		else warning_classes = W_OLDFASHIONED|W_STRICT|W_ORDINARY;
 		break;
 
 	case 'M': {	/* maximum identifier length */

lang/m2/comp/type.c

@@ -452,7 +452,7 @@ set_type(tp)
 
 	getbounds(tp, &lb, &ub);
 
-	if (lb < 0 || ub > maxset-1) {
+	if (lb < 0 || ub > maxset-1 || (sizeof(int)==2 && ub > 65535)) {
 		error("set type limits exceeded");
 		return error_type;
 	}