Ver código fonte

Changes to make node structure smaller, and cleaned up a bit

ceriel 33 anos atrás
pai
commit
925d52f416

+ 0 - 1
lang/m2/comp/.distr

@@ -13,7 +13,6 @@ chk_expr.c
 chk_expr.h
 class.h
 code.c
-const.h
 cstoper.c
 debug.h
 declar.g

+ 0 - 1
lang/m2/comp/LLlex.c

@@ -27,7 +27,6 @@
 #include	"idf.h"
 #include	"def.h"
 #include	"type.h"
-#include	"const.h"
 #include	"warning.h"
 
 extern long str2long();

+ 32 - 16
lang/m2/comp/LLlex.h

@@ -18,31 +18,47 @@ struct string {
 	char *s_str;			/* the string itself */
 };
 
+union tk_attr {
+	struct string *tk_str;
+	arith tk_int;
+	struct real *tk_real;
+	struct {
+		union {
+			arith *tky_set;
+			struct idf *tky_idf;
+			struct def *tky_def;
+		} tk_yy;
+		struct node *tky_next;
+	} tk_y;
+	struct {
+		struct node *tkx_left, *tkx_right;
+	} tk_x;
+};
+#define tk_left	tk_x.tkx_left
+#define tk_right tk_x.tkx_right
+#define tk_next	tk_y.tky_next
+#define tk_idf	tk_y.tk_yy.tky_idf
+#define tk_def	tk_y.tk_yy.tky_def
+#define tk_set	tk_y.tk_yy.tky_set
+
 /* Token structure. Keep it small, as it is part of a parse-tree node
 */
 struct token	{
 	short tk_symb;			/* token itself	*/
 	unsigned short tk_lineno;	/* linenumber on which it occurred */
-	union {
-		struct idf *tk_idf;	/* IDENT	*/
-		struct string *tk_str;	/* STRING	*/
-		arith tk_int;		/* INTEGER	*/
-		struct real *tk_real;	/* REAL		*/
-		arith *tk_set;		/* only used in parse tree node */
-		struct def *tk_def;	/* only used in parse tree node */
-	} tk_data;
+	union tk_attr tk_data;
 };
 
 typedef struct token	t_token;
 
-#define TOK_IDF	tk_data.tk_idf
-#define TOK_SSTR tk_data.tk_str
-#define TOK_STR	tk_data.tk_str->s_str
-#define TOK_SLE tk_data.tk_str->s_length
-#define TOK_INT	tk_data.tk_int
-#define TOK_REAL tk_data.tk_real
-#define TOK_RSTR tk_data.tk_real->r_real
-#define TOK_RVAL tk_data.tk_real->r_val
+#define TOK_IDF		tk_data.tk_idf
+#define TOK_SSTR	tk_data.tk_str
+#define TOK_STR		tk_data.tk_str->s_str
+#define TOK_SLE		tk_data.tk_str->s_length
+#define TOK_INT		tk_data.tk_int
+#define TOK_REAL	tk_data.tk_real
+#define TOK_RSTR	tk_data.tk_real->r_real
+#define TOK_RVAL	tk_data.tk_real->r_val
 
 extern t_token dot, aside;
 extern struct type *toktype;

+ 1 - 7
lang/m2/comp/Makefile

@@ -79,7 +79,7 @@ GENH =	errout.h \
 	def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h real.h \
 	use_insert.h dbsymtab.h
 HFILES =LLlex.h \
-	chk_expr.h class.h const.h debug.h f_info.h idf.h \
+	chk_expr.h class.h debug.h f_info.h idf.h \
 	input.h main.h misc.h scope.h standards.h tokenname.h \
 	walk.h warning.h SYSTEM.h $(GENH)
 #
@@ -212,7 +212,6 @@ LLlex.o: LLlex.h
 LLlex.o: Lpars.h
 LLlex.o: bigparam.h
 LLlex.o: class.h
-LLlex.o: const.h
 LLlex.o: dbsymtab.h
 LLlex.o: debug.h
 LLlex.o: debugcst.h
@@ -278,7 +277,6 @@ input.o: inputtype.h
 type.o: LLlex.h
 type.o: bigparam.h
 type.o: chk_expr.h
-type.o: const.h
 type.o: dbsymtab.h
 type.o: debug.h
 type.o: debugcst.h
@@ -381,7 +379,6 @@ node.o: type.h
 cstoper.o: LLlex.h
 cstoper.o: Lpars.h
 cstoper.o: bigparam.h
-cstoper.o: const.h
 cstoper.o: dbsymtab.h
 cstoper.o: debug.h
 cstoper.o: debugcst.h
@@ -397,7 +394,6 @@ chk_expr.o: LLlex.h
 chk_expr.o: Lpars.h
 chk_expr.o: bigparam.h
 chk_expr.o: chk_expr.h
-chk_expr.o: const.h
 chk_expr.o: dbsymtab.h
 chk_expr.o: debug.h
 chk_expr.o: debugcst.h
@@ -502,7 +498,6 @@ lookup.o: target_sizes.h
 lookup.o: type.h
 stab.o: LLlex.h
 stab.o: bigparam.h
-stab.o: const.h
 stab.o: dbsymtab.h
 stab.o: def.h
 stab.o: idf.h
@@ -556,7 +551,6 @@ expression.o: LLlex.h
 expression.o: Lpars.h
 expression.o: bigparam.h
 expression.o: chk_expr.h
-expression.o: const.h
 expression.o: dbsymtab.h
 expression.o: debug.h
 expression.o: debugcst.h

+ 18 - 18
lang/m2/comp/casestat.C

@@ -97,25 +97,25 @@ CaseCode(nd, exitlabel, end_reached)
 
 	assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
 
-	if (ChkExpression(pnode->nd_left)) {
-		MkCoercion(&(pnode->nd_left),BaseType(pnode->nd_left->nd_type));
-		CodePExpr(pnode->nd_left);
+	if (ChkExpression(&(pnode->nd_LEFT))) {
+		MkCoercion(&(pnode->nd_LEFT),BaseType(pnode->nd_LEFT->nd_type));
+		CodePExpr(pnode->nd_LEFT);
 	}
-	sh->sh_type = pnode->nd_left->nd_type;
+	sh->sh_type = pnode->nd_LEFT->nd_type;
 	sh->sh_break = ++text_label;
 
 	/* Now, create case label list
 	*/
-	while (pnode = pnode->nd_right) {
+	while (pnode = pnode->nd_RIGHT) {
 		if (pnode->nd_class == Link && pnode->nd_symb == '|') {
-			if (pnode->nd_left) {
+			if (pnode->nd_LEFT) {
 				/* non-empty case
 				*/
-				pnode->nd_left->nd_lab = ++text_label;
+				pnode->nd_LEFT->nd_lab = ++text_label;
 				AddCases(sh, /* to descriptor */
-					 pnode->nd_left->nd_left,
+					 pnode->nd_LEFT->nd_LEFT,
 					     /* of case labels */
-					 (label) pnode->nd_left->nd_lab
+					 (label) pnode->nd_LEFT->nd_lab
 					     /* and code label */
 					      );
 			}
@@ -192,11 +192,11 @@ CaseCode(nd, exitlabel, end_reached)
 	*/
 	pnode = nd;
 	rval = 0;
-	while (pnode = pnode->nd_right) {
+	while (pnode = pnode->nd_RIGHT) {
 		if (pnode->nd_class == Link && pnode->nd_symb == '|') {
-			if (pnode->nd_left) {
-				rval |= LblWalkNode((label) pnode->nd_left->nd_lab,
-					    pnode->nd_left->nd_right,
+			if (pnode->nd_LEFT) {
+				rval |= LblWalkNode((label) pnode->nd_LEFT->nd_lab,
+					    pnode->nd_LEFT->nd_RIGHT,
 					    exitlabel, end_reached);
 				C_bra(sh->sh_break);
 			}
@@ -245,16 +245,16 @@ AddCases(sh, node, lbl)
 
 	if (node->nd_class == Link) {
 		if (node->nd_symb == UPTO) {
-			assert(node->nd_left->nd_class == Value);
-			assert(node->nd_right->nd_class == Value);
+			assert(node->nd_LEFT->nd_class == Value);
+			assert(node->nd_RIGHT->nd_class == Value);
 
-			AddOneCase(sh, node->nd_left, node->nd_right, lbl);
+			AddOneCase(sh, node->nd_LEFT, node->nd_RIGHT, lbl);
 			return;
 		}
 
 		assert(node->nd_symb == ',');
-		AddCases(sh, node->nd_left, lbl);
-		AddCases(sh, node->nd_right, lbl);
+		AddCases(sh, node->nd_LEFT, lbl);
+		AddCases(sh, node->nd_RIGHT, lbl);
 		return;
 	}
 

Diferenças do arquivo suprimidas por serem muito extensas
+ 258 - 219
lang/m2/comp/chk_expr.c


+ 2 - 3
lang/m2/comp/chk_expr.h

@@ -16,9 +16,8 @@ extern int	(*DesigChkTable[])();	/* table of designator checking
 					   functions, indexed by node class
 					*/
 
-#define	ChkExpression(expp)	((*ExprChkTable[(expp)->nd_class])(expp,D_USED))
-#define ChkDesignator(expp)	((*DesigChkTable[(expp)->nd_class])(expp,0))
-#define ChkDesig(expp, flags)	((*DesigChkTable[(expp)->nd_class])(expp,flags))
+#define	ChkExpression(expp)	((*ExprChkTable[(*expp)->nd_class])(expp,D_USED))
+#define ChkDesig(expp, flags)	((*DesigChkTable[(*expp)->nd_class])(expp,flags))
 
 /* handle reference counts for sets */
 #define inc_refcount(s)		(*((int *)(s) - 1) += 1)

+ 46 - 60
lang/m2/comp/code.c

@@ -38,19 +38,6 @@ extern int	proclevel;
 extern char	options[];
 int		fp_used;
 
-STATIC char *
-NameOfProc(df)
-	register t_def *df;
-{
-
-	assert(df->df_kind & (D_PROCHEAD|D_PROCEDURE));
-
-	if (df->df_kind == D_PROCEDURE) {
-		return df->prc_vis->sc_scope->sc_name;
-	}
-	return df->for_name;
-}
-
 CodeConst(cst, size)
 	arith cst;
 	int size;
@@ -100,7 +87,7 @@ CodeExpr(nd, ds, true_label, false_label)
 	switch(nd->nd_class) {
 	case Def:
 		if (nd->nd_def->df_kind & (D_PROCEDURE|D_PROCHEAD)) {
-			C_lpi(NameOfProc(nd->nd_def));
+			C_lpi(nd->nd_def->prc_name);
 			ds->dsg_kind = DSG_LOADED;
 			break;
 		}
@@ -317,7 +304,7 @@ CodeCall(nd)
 	/*	Generate code for a procedure call. Checking of parameters
 		and result is already done.
 	*/
-	register t_node *left = nd->nd_left;
+	register t_node *left = nd->nd_LEFT;
 	t_type *result_tp;
 	int needs_fn;
 
@@ -335,8 +322,8 @@ CodeCall(nd)
 	}
 #endif
 
-	if (nd->nd_right) {
-		CodeParameters(ParamList(left->nd_type), nd->nd_right);
+	if (nd->nd_RIGHT) {
+		CodeParameters(ParamList(left->nd_type), nd->nd_RIGHT);
 	}
 
 	switch(left->nd_class) {
@@ -353,7 +340,7 @@ CodeCall(nd)
 				C_lxl((arith) (proclevel - level));
 			}
 			needs_fn = df->df_scope->sc_defmodule;
-			C_cal(NameOfProc(df));
+			C_cal(df->prc_name);
 			break;
 		}}
 		/* Fall through */
@@ -379,32 +366,31 @@ CodeCall(nd)
 
 CodeParameters(param, arg)
 	t_param *param;
-	t_node *arg;
+	register t_node *arg;
 {
 	register t_type *tp;
-	register t_node *left;
-	register t_type *left_type;
+	register t_type *arg_type;
 
 	assert(param != 0 && arg != 0);
 
 	if (param->par_next) {
-		CodeParameters(param->par_next, arg->nd_right);
+		CodeParameters(param->par_next, arg->nd_RIGHT);
 	}
 
 	tp = TypeOfParam(param);
-	left = arg->nd_left;
-	left_type = left->nd_type;
+	arg = arg->nd_LEFT;
+	arg_type = arg->nd_type;
 	if (IsConformantArray(tp)) {
 		register t_type *elem = tp->arr_elem;
 
 		C_loc(tp->arr_elsize);
-		if (IsConformantArray(left_type)) {
-			DoHIGH(left->nd_def);
-			if (elem->tp_size != left_type->arr_elem->tp_size) {
+		if (IsConformantArray(arg_type)) {
+			DoHIGH(arg->nd_def);
+			if (elem->tp_size != arg_type->arr_elem->tp_size) {
 				/* This can only happen if the formal type is
 				   ARRAY OF (WORD|BYTE)
 				*/
-				C_loc(left_type->arr_elem->tp_size);
+				C_loc(arg_type->arr_elem->tp_size);
 				C_mli(word_size);
 				if (elem == word_type) {
 					c_loc((int) word_size - 1);
@@ -417,47 +403,47 @@ CodeParameters(param, arg)
 				}
 			}
 		}
-		else if (left->nd_symb == STRING) {
-			C_loc((arith)(left->nd_SLE - 1));
+		else if (arg->nd_symb == STRING) {
+			C_loc((arith)(arg->nd_SLE - 1));
 		}
 		else if (elem == word_type) {
-			C_loc((left_type->tp_size+word_size-1) / word_size - 1);
+			C_loc((arg_type->tp_size+word_size-1) / word_size - 1);
 		}
 		else if (elem == byte_type) {
-			C_loc(left_type->tp_size - 1);
+			C_loc(arg_type->tp_size - 1);
 		}
 		else {
-			C_loc(left_type->arr_high - left_type->arr_low);
+			C_loc(arg_type->arr_high - arg_type->arr_low);
 		}
 		c_loc(0);
 	}
 	if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) {
-		if (left->nd_symb == STRING) {
-			CodeString(left);
+		if (arg->nd_symb == STRING) {
+			CodeString(arg);
 		}
-		else switch(left->nd_class) {
+		else switch(arg->nd_class) {
 		case Arrsel:
 		case Arrow:
 		case Def:
-			CodeDAddress(left, IsVarParam(param));
+			CodeDAddress(arg, IsVarParam(param));
 			break;
 		default:{
 			arith tmp, TmpSpace();
 
-			CodePExpr(left);
-			tmp = TmpSpace(left->nd_type->tp_size, left->nd_type->tp_align);
-			STL(tmp, WA(left->nd_type->tp_size));
+			CodePExpr(arg);
+			tmp = TmpSpace(arg->nd_type->tp_size, arg->nd_type->tp_align);
+			STL(tmp, WA(arg->nd_type->tp_size));
 			C_lal(tmp);
 			}
 			break;
 		}
 		return;
 	}
-	if (left_type->tp_fund == T_STRING) {
-		CodePString(left, tp);
+	if (arg_type->tp_fund == T_STRING) {
+		CodePString(arg, tp);
 		return;
 	}
-	CodePExpr(left);
+	CodePExpr(arg);
 }
 
 CodePString(nd, tp)
@@ -499,15 +485,15 @@ addu(sz)
 CodeStd(nd)
 	t_node *nd;
 {
-	register t_node *arg = nd->nd_right;
+	register t_node *arg = nd->nd_RIGHT;
 	register t_node *left = 0;
 	register t_type *tp = 0;
-	int std = nd->nd_left->nd_def->df_value.df_stdname;
+	int std = nd->nd_LEFT->nd_def->df_value.df_stdname;
 
 	if (arg) {
-		left = arg->nd_left;
+		left = arg->nd_LEFT;
 		tp = BaseType(left->nd_type);
-		arg = arg->nd_right;
+		arg = arg->nd_RIGHT;
 	}
 
 	switch(std) {
@@ -573,8 +559,8 @@ CodeStd(nd)
 		CodePExpr(left);
 		CodeCoercion(left->nd_type, tp);
 		if (arg) {
-			CodePExpr(arg->nd_left);
-			CodeCoercion(arg->nd_left->nd_type, tp);
+			CodePExpr(arg->nd_LEFT);
+			CodeCoercion(arg->nd_LEFT->nd_type, tp);
 		}
 		else	{
 			c_loc(1);
@@ -603,7 +589,7 @@ CodeStd(nd)
 	case S_INCL:
 	case S_EXCL:
 		CodePExpr(left);
-		CodePExpr(arg->nd_left);
+		CodePExpr(arg->nd_LEFT);
 		C_loc(tp->set_low);
 		C_sbi(word_size);
 		C_set(tp->tp_size);
@@ -668,8 +654,8 @@ Operands(nd)
 	register t_node *nd;
 {
 
-	CodePExpr(nd->nd_left);
-	CodePExpr(nd->nd_right);
+	CodePExpr(nd->nd_LEFT);
+	CodePExpr(nd->nd_RIGHT);
 	DoLineno(nd);
 }
 
@@ -678,8 +664,8 @@ CodeOper(expr, true_label, false_label)
 	label true_label;
 	label false_label;	/* labels to jump to in logical expr's	*/
 {
-	register t_node *leftop = expr->nd_left;
-	register t_node *rightop = expr->nd_right;
+	register t_node *leftop = expr->nd_LEFT;
+	register t_node *rightop = expr->nd_RIGHT;
 	register t_type *tp = expr->nd_type;
 
 	switch (expr->nd_symb)	{
@@ -991,7 +977,7 @@ CodeUoper(nd)
 {
 	register t_type *tp = nd->nd_type;
 
-	CodePExpr(nd->nd_right);
+	CodePExpr(nd->nd_RIGHT);
 	switch(nd->nd_symb) {
 	case NOT:
 		C_teq();
@@ -1010,8 +996,8 @@ CodeUoper(nd)
 		}
 		break;
 	case COERCION:
-		CodeCoercion(nd->nd_right->nd_type, tp);
-		RangeCheck(tp, nd->nd_right->nd_type);
+		CodeCoercion(nd->nd_RIGHT->nd_type, tp);
+		RangeCheck(tp, nd->nd_RIGHT->nd_type);
 		break;
 	case CAST:
 		break;
@@ -1025,12 +1011,12 @@ CodeSet(nd)
 {
 	register t_type *tp = nd->nd_type;
 
-	nd = nd->nd_right;
+	nd = nd->nd_NEXT;
 	while (nd) {
 		assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-		if (nd->nd_left) CodeEl(nd->nd_left, tp);
-		nd = nd->nd_right;
+		if (nd->nd_LEFT) CodeEl(nd->nd_LEFT, tp);
+		nd = nd->nd_RIGHT;
 	}
 }
 

+ 150 - 125
lang/m2/comp/cstoper.c

@@ -24,16 +24,19 @@
 #include	"Lpars.h"
 #include	"standards.h"
 #include	"warning.h"
-#include	"const.h"
 
 extern char	*symbol2str();
 
+#define arith_sign	((arith) (1L << (sizeof(arith) * 8 - 1)))
+
 arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
 arith max_int[MAXSIZE];	/* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
 arith min_int[MAXSIZE];	/* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
 			   ...
 			*/
+#ifndef NOCROSS
 unsigned int wrd_bits;	/* number of bits in a word */
+#endif
 
 extern char options[];
 
@@ -55,24 +58,28 @@ underflow(expp)
 
 STATIC
 commonbin(expp)
-	register t_node *expp;
+	register t_node **expp;
 {
-	expp->nd_class = Value;
-	expp->nd_token = expp->nd_right->nd_token;
-	CutSize(expp);
-	FreeLR(expp);
+	register t_type *tp = (*expp)->nd_type;
+	register t_node *right = (*expp)->nd_RIGHT;
+	
+	(*expp)->nd_RIGHT = 0;
+	FreeNode(*expp);
+	*expp = right;
+	right->nd_type = tp;
 }
 
 cstunary(expp)
-	register t_node *expp;
+	t_node **expp;
 {
 	/*	The unary operation in "expp" is performed on the constant
 		expression below it, and the result restored in expp.
 	*/
-	register t_node *right = expp->nd_right;
+	register t_node *exp = *expp;
+	register t_node *right = exp->nd_RIGHT;
 	register arith o1 = right->nd_INT;
 
-	switch(expp->nd_symb) {
+	switch(exp->nd_symb) {
 	/* Should not get here
 	case '+':
 		break;
@@ -80,7 +87,7 @@ cstunary(expp)
 
 	case '-':
 		if (o1 == min_int[(int)(right->nd_type->tp_size)]) {
-			overflow(expp);
+			overflow(exp);
 		}
 		o1 = -o1;
 		break;
@@ -95,7 +102,8 @@ cstunary(expp)
 	}
 
 	commonbin(expp);
-	expp->nd_INT = o1;
+	(*expp)->nd_INT = o1;
+	CutSize(*expp);
 }
 
 STATIC
@@ -149,41 +157,42 @@ divide(pdiv, prem)
 }
 
 cstibin(expp)
-	register t_node *expp;
+	t_node **expp;
 {
 	/*	The binary operation in "expp" is performed on the constant
 		expressions below it, and the result restored in expp.
 		This version is for INTEGER expressions.
 	*/
-	register arith o1 = expp->nd_left->nd_INT;
-	register arith o2 = expp->nd_right->nd_INT;
-	register int sz = expp->nd_type->tp_size;
+	register t_node *exp = *expp;
+	register arith o1 = exp->nd_LEFT->nd_INT;
+	register arith o2 = exp->nd_RIGHT->nd_INT;
+	register int sz = exp->nd_type->tp_size;
 
-	assert(expp->nd_class == Oper);
-	assert(expp->nd_left->nd_class == Value);
-	assert(expp->nd_right->nd_class == Value);
+	assert(exp->nd_class == Oper);
+	assert(exp->nd_LEFT->nd_class == Value);
+	assert(exp->nd_RIGHT->nd_class == Value);
 
-	switch (expp->nd_symb)	{
+	switch (exp->nd_symb)	{
 	case '*':
 		if (o1 > 0 && o2 > 0) {
-			if (max_int[sz] / o1 < o2) overflow(expp);
+			if (max_int[sz] / o1 < o2) overflow(exp);
 		}
 		else if (o1 < 0 && o2 < 0) {
 			if (o1 == min_int[sz] || o2 == min_int[sz] ||
-			    max_int[sz] / (-o1) < (-o2)) overflow(expp);
+			    max_int[sz] / (-o1) < (-o2)) overflow(exp);
 		}
 		else if (o1 > 0) {
-			if (min_int[sz] / o1 > o2) overflow(expp);
+			if (min_int[sz] / o1 > o2) overflow(exp);
 		}
 		else if (o2 > 0) {
-			if (min_int[sz] / o2 > o1) overflow(expp);
+			if (min_int[sz] / o2 > o1) overflow(exp);
 		}
 		o1 *= o2;
 		break;
 
 	case DIV:
 		if (o2 == 0)	{
-			node_error(expp, "division by 0");
+			node_error(exp, "division by 0");
 			return;
 		}
 		if ((o1 < 0) != (o2 < 0)) {
@@ -197,7 +206,7 @@ cstibin(expp)
 		break;
 	case MOD:
 		if (o2 == 0)	{
-			node_error(expp, "modulo by 0");
+			node_error(exp, "modulo by 0");
 			return;
 		}
 		if ((o1 < 0) != (o2 < 0)) {
@@ -212,20 +221,20 @@ cstibin(expp)
 
 	case '+':
 		if (o1 > 0 && o2 > 0) {
-			if (max_int[sz] - o1 < o2) overflow(expp);
+			if (max_int[sz] - o1 < o2) overflow(exp);
 		}
 		else if (o1 < 0 && o2 < 0) {
-			if (min_int[sz] - o1 > o2) overflow(expp);
+			if (min_int[sz] - o1 > o2) overflow(exp);
 		}
 		o1 += o2;
 		break;
 
 	case '-':
 		if (o1 >= 0 && o2 < 0) {
-			if (max_int[sz] + o2 < o1) overflow(expp);
+			if (max_int[sz] + o2 < o1) overflow(exp);
 		}
 		else if (o1 < 0 && o2 >= 0) {
-			if (min_int[sz] + o2 > o1) overflow(expp);
+			if (min_int[sz] + o2 > o1) overflow(exp);
 		}
 		o1 -= o2;
 		break;
@@ -259,27 +268,29 @@ cstibin(expp)
 	}
 
 	commonbin(expp);
-	expp->nd_INT = o1;
+	(*expp)->nd_INT = o1;
+	CutSize(*expp);
 }
 
 cstfbin(expp)
-	register t_node *expp;
+	t_node **expp;
 {
 	/*	The binary operation in "expp" is performed on the constant
 		expressions below it, and the result restored in expp.
 		This version is for REAL expressions.
 	*/
-	register struct real *p = expp->nd_left->nd_REAL;
+	register t_node *exp = *expp;
+	register struct real *p = exp->nd_LEFT->nd_REAL;
 	register flt_arith *o1 = &p->r_val;
-	register flt_arith *o2 = &expp->nd_right->nd_RVAL;
+	register flt_arith *o2 = &exp->nd_RIGHT->nd_RVAL;
 	int compar = 0;
 	int cmpval = 0;
 
-	assert(expp->nd_class == Oper);
-	assert(expp->nd_left->nd_class == Value);
-	assert(expp->nd_right->nd_class == Value);
+	assert(exp->nd_class == Oper);
+	assert(exp->nd_LEFT->nd_class == Value);
+	assert(exp->nd_RIGHT->nd_class == Value);
 
-	switch (expp->nd_symb)	{
+	switch (exp->nd_symb)	{
 	case '*':
 		flt_mul(o1, o2, o1);
 		break;
@@ -304,7 +315,7 @@ cstfbin(expp)
 	case '#':
 		compar++;
 		cmpval = flt_cmp(o1, o2);
-		switch(expp->nd_symb) {
+		switch(exp->nd_symb) {
 		case '<':		cmpval = (cmpval < 0); break;
 		case '>':		cmpval = (cmpval > 0); break;
 		case LESSEQUAL:		cmpval = (cmpval <= 0); break;
@@ -312,8 +323,8 @@ cstfbin(expp)
 		case '=':		cmpval = (cmpval == 0); break;
 		case '#':		cmpval = (cmpval != 0); break;
 		}
-		if (expp->nd_right->nd_RSTR) free(expp->nd_right->nd_RSTR);
-		free_real(expp->nd_right->nd_REAL);
+		if (exp->nd_RIGHT->nd_RSTR) free(exp->nd_RIGHT->nd_RSTR);
+		free_real(exp->nd_RIGHT->nd_REAL);
 		break;
 
 	default:
@@ -322,11 +333,11 @@ cstfbin(expp)
 
 	switch(flt_status) {
 	case FLT_OVFL:
-		node_warning(expp, "floating point overflow on %s", 
-				symbol2str(expp->nd_symb));
+		node_warning(exp, "floating point overflow on %s", 
+				symbol2str(exp->nd_symb));
 		break;
 	case FLT_DIV0:
-		node_error(expp, "division by 0.0");
+		node_error(exp, "division by 0.0");
 		break;
 	}
 
@@ -338,32 +349,35 @@ cstfbin(expp)
 		free_real(p);
 	}
 	commonbin(expp);
+	exp = *expp;
 	if (compar) {
-		expp->nd_symb = INTEGER;
-		expp->nd_INT = cmpval;
+		exp->nd_symb = INTEGER;
+		exp->nd_INT = cmpval;
 	}
 	else {
-		expp->nd_REAL = p;
+		exp->nd_REAL = p;
 	}
+	CutSize(exp);
 }
 
 cstubin(expp)
-	register t_node *expp;
+	t_node **expp;
 {
 	/*	The binary operation in "expp" is performed on the constant
 		expressions below it, and the result restored in
 		expp.
 	*/
-	arith o1 = expp->nd_left->nd_INT;
-	arith o2 = expp->nd_right->nd_INT;
-	register int sz = expp->nd_type->tp_size;
+	register t_node *exp = *expp;
+	arith o1 = exp->nd_LEFT->nd_INT;
+	arith o2 = exp->nd_RIGHT->nd_INT;
+	register int sz = exp->nd_type->tp_size;
 	arith tmp1, tmp2;
 
-	assert(expp->nd_class == Oper);
-	assert(expp->nd_left->nd_class == Value);
-	assert(expp->nd_right->nd_class == Value);
+	assert(exp->nd_class == Oper);
+	assert(exp->nd_LEFT->nd_class == Value);
+	assert(exp->nd_RIGHT->nd_class == Value);
 
-	switch (expp->nd_symb)	{
+	switch (exp->nd_symb)	{
 	case '*':
 		if (o1 == 0 || o2 == 0) {
 			o1 = 0;
@@ -372,13 +386,13 @@ cstubin(expp)
 		tmp1 = full_mask[sz];
 		tmp2 = o2;
 		divide(&tmp1, &tmp2);
-		if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(expp);
+		if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(exp);
 		o1 *= o2;
 		break;
 
 	case DIV:
 		if (o2 == 0)	{
-			node_error(expp, "division by 0");
+			node_error(exp, "division by 0");
 			return;
 		}
 		divide(&o1, &o2);
@@ -386,7 +400,7 @@ cstubin(expp)
 
 	case MOD:
 		if (o2 == 0)	{
-			node_error(expp, "modulo by 0");
+			node_error(exp, "modulo by 0");
 			return;
 		}
 		divide(&o1, &o2);
@@ -395,20 +409,20 @@ cstubin(expp)
 
 	case '+':
 		if (! chk_bounds(o2, full_mask[sz] - o1, T_CARDINAL)) {
-			overflow(expp);
+			overflow(exp);
 		}
 		o1 += o2;
 		break;
 
 	case '-':
 		if (! chk_bounds(o2, o1, T_CARDINAL)) {
-			if (expp->nd_type->tp_fund == T_INTORCARD) {
-				expp->nd_type = int_type;
+			if (exp->nd_type->tp_fund == T_INTORCARD) {
+				exp->nd_type = int_type;
 				if (! chk_bounds(min_int[sz], o1 - o2, T_CARDINAL)) {
-					underflow(expp);
+					underflow(exp);
 				}
 			}
-			else	underflow(expp);
+			else	underflow(exp);
 		}
 		o1 -= o2;
 		break;
@@ -451,75 +465,81 @@ cstubin(expp)
 	}
 
 	commonbin(expp);
-	expp->nd_INT = o1;
-	if (expp->nd_type == bool_type) expp->nd_symb = INTEGER;
+	exp = *expp;
+	exp->nd_INT = o1;
+	if (exp->nd_type == bool_type) exp->nd_symb = INTEGER;
+	CutSize(exp);
 }
 
 cstset(expp)
-	register t_node *expp;
+	t_node **expp;
 {
 	extern arith *MkSet();
-	register arith *set1, *set2;
-	register arith *resultset;
+	register t_node *exp = *expp;
+	register arith *set1, *set2, *set3;
 	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);
+	assert(exp->nd_RIGHT->nd_class == Set);
+	assert(exp->nd_symb == IN || exp->nd_LEFT->nd_class == Set);
 
-	set2 = expp->nd_right->nd_set;
-	setsize = (unsigned) (expp->nd_right->nd_type->tp_size) / (unsigned) word_size;
+	set2 = exp->nd_RIGHT->nd_set;
+	setsize = (unsigned) (exp->nd_RIGHT->nd_type->tp_size) / (unsigned) word_size;
 
-	if (expp->nd_symb == IN) {
+	if (exp->nd_symb == IN) {
 		/*	The setsize must fit in an unsigned, as it is
 			allocated with Malloc, so we can do the arithmetic
 			in an unsigned too.
 		*/
 		unsigned i;
 
-		assert(expp->nd_left->nd_class == Value);
+		assert(exp->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;
-		/*	Careful here; use expp->nd_left->nd_INT to see if
+		exp->nd_LEFT->nd_INT -= exp->nd_RIGHT->nd_type->set_low;
+		i = exp->nd_LEFT->nd_INT;
+		/*	Careful here; use exp->nd_LEFT->nd_INT to see if
 			it falls in the range of the set. Do not use i
 			for this, as i may be truncated.
 		*/
-		expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&
-				expp->nd_left->nd_INT < setsize * wrd_bits &&
+		i = (exp->nd_LEFT->nd_INT >= 0 &&
+		     exp->nd_LEFT->nd_INT < setsize * wrd_bits &&
 		    (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
 		FreeSet(set2);
-		expp->nd_symb = INTEGER;
-		FreeLR(expp);
+		exp = getnode(Value);
+		exp->nd_symb = INTEGER;
+		exp->nd_lineno = (*expp)->nd_lineno;
+		exp->nd_INT = i;
+		exp->nd_type = bool_type;
+		FreeNode(*expp);
+		*expp = exp;
 		return;
 	}
 
-	set1 = expp->nd_left->nd_set;
-	switch(expp->nd_symb) {
+	set1 = exp->nd_LEFT->nd_set;
+	*expp = MkLeaf(Set, &(exp->nd_RIGHT->nd_token));
+	(*expp)->nd_type = exp->nd_type;
+	switch(exp->nd_symb) {
 	case '+': /* Set union */
 	case '-': /* Set difference */
 	case '*': /* Set intersection */
 	case '/': /* Symmetric set difference */
-		expp->nd_set = resultset = MkSet(expp->nd_type->set_sz);
+		(*expp)->nd_set = set3 = MkSet(exp->nd_type->set_sz);
 		for (j = 0; j < setsize; j++) {
-			switch(expp->nd_symb) {
+			switch(exp->nd_symb) {
 			case '+':
-				*resultset = *set1++ | *set2++;
+				*set3++ = *set1++ | *set2++;
 				break;
 			case '-':
-				*resultset = *set1++ & ~*set2++;
+				*set3++ = *set1++ & ~*set2++;
 				break;
 			case '*':
-				*resultset = *set1++ & *set2++;
+				*set3++ = *set1++ & *set2++;
 				break;
 			case '/':
-				*resultset = *set1++ ^ *set2++;
+				*set3++ = *set1++ ^ *set2++;
 				break;
 			}
-			resultset++;
 		}
-		expp->nd_class = Set;
 		break;
 
 	case GREATEREQUAL:
@@ -529,7 +549,7 @@ cstset(expp)
 		/* Constant set comparisons
 		*/
 		for (j = 0; j < setsize; j++) {
-			switch(expp->nd_symb) {
+			switch(exp->nd_symb) {
 			case GREATEREQUAL:
 				if ((*set1 | *set2++) != *set1) break;
 				set1++;
@@ -546,24 +566,27 @@ cstset(expp)
 			break;
 		}
 		if (j < setsize) {
-			expp->nd_INT = expp->nd_symb == '#';
+			j = exp->nd_symb == '#';
 		}
 		else {
-			expp->nd_INT = expp->nd_symb != '#';
+			j = exp->nd_symb != '#';
 		}
-		expp->nd_class = Value;
-		expp->nd_symb = INTEGER;
+		*expp = getnode(Value);
+		(*expp)->nd_symb = INTEGER;
+		(*expp)->nd_INT = j;
+		(*expp)->nd_type = bool_type;
+		(*expp)->nd_lineno = (*expp)->nd_lineno;
 		break;
 	default:
 		crash("(cstset)");
 	}
-	FreeSet(expp->nd_left->nd_set);
-	FreeSet(expp->nd_right->nd_set);
-	FreeLR(expp);
+	FreeSet(exp->nd_LEFT->nd_set);
+	FreeSet(exp->nd_RIGHT->nd_set);
+	FreeNode(exp);
 }
 
 cstcall(expp, call)
-	register t_node *expp;
+	t_node **expp;
 {
 	/*	a standard procedure call is found that can be evaluated
 		compile time, so do so.
@@ -571,69 +594,69 @@ cstcall(expp, call)
 	register t_node *expr;
 	register t_type *tp;
 
-	assert(expp->nd_class == Call);
-
-	expr = expp->nd_right->nd_left;
+	assert((*expp)->nd_class == Call);
+	expr = (*expp)->nd_RIGHT->nd_LEFT;
 	tp = expr->nd_type;
+	expr->nd_type = (*expp)->nd_type;
 
-	expp->nd_class = Value;
-	expp->nd_symb = INTEGER;
-	expp->nd_INT = expr->nd_INT;
+	(*expp)->nd_RIGHT->nd_LEFT = 0;
+	FreeNode(*expp);
+	*expp = expr;
+	expr->nd_symb = INTEGER;
+	expr->nd_class = Value;
 	switch(call) {
 	case S_ABS:
-		if (expp->nd_INT < 0) {
-			if (expp->nd_INT <= min_int[(int)(tp->tp_size)]) {
+		if (expr->nd_INT < 0) {
+			if (expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
 				overflow(expr);
 			}
-			expp->nd_INT = - expp->nd_INT;
+			expr->nd_INT = - expr->nd_INT;
 		}
-		CutSize(expp);
+		CutSize(expr);
 		break;
 
 	case S_CAP:
-		if (expp->nd_INT >= 'a' && expp->nd_INT <= 'z') {
-			expp->nd_INT += ('A' - 'a');
+		if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') {
+			expr->nd_INT += ('A' - 'a');
 		}
 		break;
 
+	case S_HIGH:
 	case S_MAX:
 		if (tp->tp_fund == T_INTEGER) {
-			expp->nd_INT = max_int[(int)(tp->tp_size)];
+			expr->nd_INT = max_int[(int)(tp->tp_size)];
 		}
 		else if (tp == card_type) {
-			expp->nd_INT = full_mask[(int)(int_size)];
+			expr->nd_INT = full_mask[(int)(int_size)];
 		}
 		else if (tp->tp_fund == T_SUBRANGE) {
-			expp->nd_INT = tp->sub_ub;
+			expr->nd_INT = tp->sub_ub;
 		}
-		else	expp->nd_INT = tp->enm_ncst - 1;
+		else	expr->nd_INT = tp->enm_ncst - 1;
 		break;
 
 	case S_MIN:
 		if (tp->tp_fund == T_INTEGER) {
-			expp->nd_INT = min_int[(int)(tp->tp_size)];
+			expr->nd_INT = min_int[(int)(tp->tp_size)];
 		}
 		else if (tp->tp_fund == T_SUBRANGE) {
-			expp->nd_INT = tp->sub_lb;
+			expr->nd_INT = tp->sub_lb;
 		}
-		else	expp->nd_INT = 0;
+		else	expr->nd_INT = 0;
 		break;
 
 	case S_ODD:
-		expp->nd_INT &= 1;
+		expr->nd_INT &= 1;
 		break;
 
+	case S_TSIZE:
 	case S_SIZE:
-		expp->nd_INT = tp->tp_size;
+		expr->nd_INT = tp->tp_size;
 		break;
 
 	default:
 		crash("(cstcall)");
 	}
-	expp->nd_right = 0;		/* don't deallocate, for further
-					   argument checking
-					*/
-	FreeLR(expp);
 }
 
 CutSize(expr)
@@ -675,5 +698,7 @@ InitCst()
 		fatal("sizeof (arith) insufficient on this machine");
 	}
 
+#ifndef NOCROSS
 	wrd_bits = 8 * (int) word_size;
+#endif
 }

+ 18 - 18
lang/m2/comp/declar.g

@@ -236,14 +236,13 @@ IdentList(t_node **p;)
 {
 	register t_node *q;
 } :
-	IDENT		{ *p = q = dot2leaf(Value); }
+	IDENT		{ *p = q = dot2leaf(Select); }
 	[ %persistent
 		',' IDENT
-			{ q->nd_left = dot2leaf(Value);
-			  q = q->nd_left;
+			{ q->nd_NEXT = dot2leaf(Select);
+			  q = q->nd_NEXT;
 			}
 	]*
-			{ q->nd_left = 0; }
 ;
 
 SubrangeType(t_type **ptp;)
@@ -360,7 +359,7 @@ FieldList(t_scope *scope; arith *cnt; int *palign;)
 			  else
 #endif
 			  error("':' missing");
-			  tp = qualified_type(nd);
+			  tp = qualified_type(&nd);
 			}
 	  ]
 	| ':' qualtype(&tp)
@@ -405,8 +404,8 @@ CaseLabelList(t_type **ptp; t_node **pnd;):
 	CaseLabels(ptp, pnd)
 	[	
 			{ *pnd = dot2node(Link, *pnd, NULLNODE); }
-		',' CaseLabels(ptp, &((*pnd)->nd_right))
-			{ pnd = &((*pnd)->nd_right); }
+		',' CaseLabels(ptp, &((*pnd)->nd_RIGHT))
+			{ pnd = &((*pnd)->nd_RIGHT); }
 	]*
 ;
 
@@ -431,15 +430,15 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
 			}
 	[
 		UPTO	{ *pnd = nd = dot2node(Link,nd,NULLNODE);
-			  nd->nd_type = nd->nd_left->nd_type;
+			  nd->nd_type = nd->nd_LEFT->nd_type;
 			}
-		ConstExpression(&(*pnd)->nd_right)
-			{ if (!ChkCompat(&((*pnd)->nd_right), nd->nd_type,
+		ConstExpression(&(*pnd)->nd_RIGHT)
+			{ if (!ChkCompat(&((*pnd)->nd_RIGHT), nd->nd_type,
 					 "case label")) {
 			  	nd->nd_type = error_type;
 			  }
-			  else if (! chk_bounds(nd->nd_left->nd_INT,
-						nd->nd_right->nd_INT,
+			  else if (! chk_bounds(nd->nd_LEFT->nd_INT,
+						nd->nd_RIGHT->nd_INT,
 						nd->nd_type->tp_fund)) {
 			    node_error(nd,
 			   "lower bound exceeds upper bound in case label range");
@@ -482,7 +481,7 @@ qualtype(t_type **ptp;)
 	t_node *nd;
 } :
 	qualident(&nd)
-		{ *ptp = qualified_type(nd); }
+		{ *ptp = qualified_type(&nd); }
 ;
 
 ProcedureType(t_type **ptp;)
@@ -559,8 +558,8 @@ VariableDeclaration
 	IdentAddr(&VarList)
 			{ nd = VarList; }
 	[ %persistent
-		',' IdentAddr(&(nd->nd_right))
-			{ nd = nd->nd_right; }
+		',' IdentAddr(&(nd->nd_RIGHT))
+			{ nd = nd->nd_RIGHT; }
 	]*
 	':' type(&tp)
 			{ EnterVarList(VarList, tp, proclevel > 0); }
@@ -570,11 +569,12 @@ IdentAddr(t_node **pnd;)
 {
 	register t_node *nd;
 } :
-	IDENT		{ nd = dot2leaf(Name); }
+	IDENT		{ nd = dot2leaf(Name);
+			  *pnd = dot2node(Link, nd, NULLNODE);
+			}
 	[	'['
-		ConstExpression(&(nd->nd_left))
+		ConstExpression(&(nd->nd_NEXT))
 		']'
 	|
 	]
-			{ *pnd = nd; }
 ;

+ 4 - 10
lang/m2/comp/def.H

@@ -48,13 +48,6 @@ struct field {
 #define fld_variant	df_value.df_field.fd_variant
 };
 
-struct dfproc {
-	struct scopelist *pr_vis; /* scope of procedure */
-	struct node *pr_body;	/* body of this procedure */
-#define prc_vis		df_value.df_proc.pr_vis
-#define prc_body	df_value.df_proc.pr_body
-};
-
 struct import {
 	struct def *im_def;	/* imported definition */
 #define imp_def		df_value.df_import.im_def
@@ -66,7 +59,9 @@ struct dforward {
 	char *fo_name;
 #define for_node	df_value.df_forward.fo_node
 #define for_vis		df_value.df_forward.fo_vis
-#define for_name	df_value.df_forward.fo_name
+#define prc_vis		df_value.df_forward.fo_vis
+#define prc_body	df_value.df_forward.fo_node
+#define prc_name	df_value.df_forward.fo_name
 };
 
 struct forwtype {
@@ -128,8 +123,7 @@ struct def	{		/* list of definitions for a name */
 		struct enumval df_enum;
 		struct field df_field;
 		struct import df_import;
-		struct dfproc df_proc;
-		struct dforward df_forward;
+		struct dforward df_forward;	/* also used for proc */
 		struct forwtype df_fortype;
 		int df_stdname;	/* define for standard name */
 	} df_value;

+ 5 - 8
lang/m2/comp/def.c

@@ -259,40 +259,37 @@ DeclProc(type, id)
 		df->for_node = dot2leaf(Name);
 		df->df_flags |= D_USED | D_DEFINED;
 		if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) {
-			df->for_name = id->id_text;
+			df->prc_name = id->id_text;
 		}
 		else {
 			sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
-			df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
+			df->prc_name = Salloc(buf, (unsigned) (strlen(buf)+1));
 		}
 		if (CurrVis == Defined->mod_vis) {
 			/* The current module will define this routine.
 			   make sure the name is exported.
 			*/
-			C_exp(df->for_name);
+			C_exp(df->prc_name);
 		}
 	}
 	else {
-		char *name;
-
 		df = lookup(id, CurrentScope, D_IMPORTED, 0);
 		if (df && df->df_kind == D_PROCHEAD) {
 			/* C_exp already generated when we saw the definition
 			   in the definition module
 			*/
-			name = df->for_name;
 			DefInFront(df);
 		}
 		else {
 			df = define(id, CurrentScope, type);
 			sprint(buf,"_%d_%s",++nmcount,id->id_text);
-			name = Salloc(buf, (unsigned)(strlen(buf)+1));
+			df->prc_name = Salloc(buf, (unsigned)(strlen(buf)+1));
 			internal(buf);
 			df->df_flags |= D_DEFINED;
 		}
 		open_scope(OPENSCOPE);
 		scope = CurrentScope;
-		scope->sc_name = name;
+		scope->sc_name = df->prc_name;
 		scope->sc_definedby = df;
 	}
 	df->prc_vis = CurrVis;

+ 1 - 1
lang/m2/comp/defmodule.c

@@ -131,7 +131,7 @@ GetDefinitionModule(id, incr)
 
 					n = dot2leaf(Def);
 					n->nd_def = newsc->sc_definedby;
-					if (nd_end) nd_end->nd_left = n;
+					if (nd_end) nd_end->nd_NEXT = n;
 					else Modules = n;
 					nd_end = n;
 				}

+ 5 - 5
lang/m2/comp/desig.c

@@ -629,7 +629,7 @@ CodeDesig(nd, ds)
 	switch(nd->nd_class) {	/* Divide */
 	case Def:
 		df = nd->nd_def;
-		if (nd->nd_left) CodeDesig(nd->nd_left, ds);
+		if (nd->nd_NEXT) CodeDesig(nd->nd_NEXT, ds);
 
 		switch(df->df_kind) {
 		case D_FIELD:
@@ -648,10 +648,10 @@ CodeDesig(nd, ds)
 	case Arrsel:
 		assert(nd->nd_symb == '[' || nd->nd_symb == ',');
 
-		CodeDesig(nd->nd_left, ds);
+		CodeDesig(nd->nd_LEFT, ds);
 		CodeAddress(ds);
-		CodePExpr(nd->nd_right);
-		nd = nd->nd_left;
+		CodePExpr(nd->nd_RIGHT);
+		nd = nd->nd_LEFT;
 
 		/* Now load address of descriptor
 		*/
@@ -681,7 +681,7 @@ CodeDesig(nd, ds)
 	case Arrow:
 		assert(nd->nd_symb == '^');
 
-		nd = nd->nd_right;
+		nd = nd->nd_RIGHT;
 		CodeDesig(nd, ds);
 		switch(ds->dsg_kind) {
 		case DSG_LOADED:

+ 12 - 12
lang/m2/comp/enter.c

@@ -75,7 +75,7 @@ EnterEnumList(Idlist, type)
 	register t_node *idlist = Idlist;
 
 	type->enm_ncst = 0;
-	for (; idlist; idlist = idlist->nd_left) {
+	for (; idlist; idlist = idlist->nd_NEXT) {
 		df = define(idlist->nd_IDF, CurrentScope, D_ENUM);
 		df->df_type = type;
 		df->enm_val = (type->enm_ncst)++;
@@ -102,7 +102,7 @@ EnterFieldList(Idlist, type, scope, addr)
 	register t_def *df;
 	register t_node *idlist = Idlist;
 
-	for (; idlist; idlist = idlist->nd_left) {
+	for (; idlist; idlist = idlist->nd_NEXT) {
 		df = define(idlist->nd_IDF, scope, D_FIELD);
 		df->df_type = type;
 		df->df_flags |= D_QEXPORTED;
@@ -134,20 +134,20 @@ EnterVarList(Idlist, type, local)
 		while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc);
 	}
 
-	for (; idlist; idlist = idlist->nd_right) {
-		df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
+	for (; idlist; idlist = idlist->nd_RIGHT) {
+		df = define(idlist->nd_LEFT->nd_IDF, CurrentScope, D_VARIABLE);
 		df->df_type = type;
-		if (idlist->nd_left) {
+		if (idlist->nd_LEFT->nd_NEXT) {
 			/* An address was supplied
 			*/
-			register t_type *tp = idlist->nd_left->nd_type;
+			register t_type *tp = idlist->nd_LEFT->nd_NEXT->nd_type;
 
 			df->df_flags |= D_ADDRGIVEN | D_NOREG;
 			if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){
-				node_error(idlist->nd_left,
+				node_error(idlist->nd_LEFT->nd_NEXT,
 					   "illegal type for address");
 			}
-			df->var_off = idlist->nd_left->nd_INT;
+			df->var_off = idlist->nd_LEFT->nd_NEXT->nd_INT;
 		}
 		else if (local) {
 			/* subtract aligned size of variable to the offset,
@@ -211,7 +211,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
 		/* Can only happen when a procedure type is defined */
 		dummy = Idlist = idlist = dot2leaf(Name);
 	}
-	for ( ; idlist; idlist = idlist->nd_left) {
+	for ( ; idlist; idlist = idlist->nd_NEXT) {
 		pr = new_paramlist();
 		pr->par_next = 0;
 		if (!*ppr) *ppr = pr;
@@ -378,7 +378,7 @@ EnterExportList(Idlist, qualified)
 	register t_node *idlist = Idlist;
 	register t_def *df, *df1;
 
-	for (;idlist; idlist = idlist->nd_left) {
+	for (;idlist; idlist = idlist->nd_NEXT) {
 		df = lookup(idlist->nd_IDF, CurrentScope, 0, 0);
 
 		if (!df) {
@@ -508,7 +508,7 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
 		return;
 	}
 
-	for (; idlist; idlist = idlist->nd_left) {
+	for (; idlist; idlist = idlist->nd_NEXT) {
 		if (! (df = lookup(idlist->nd_IDF, sc, 0, 0))) {
 			if (! is_anon_idf(idlist->nd_IDF)) {
 				node_error(idlist,
@@ -544,7 +544,7 @@ EnterImportList(idlist, local, sc)
 	
 	f = file_info;
 
-	for (; idlist; idlist = idlist->nd_left) {
+	for (; idlist; idlist = idlist->nd_NEXT) {
 		if (! DoImport(local ?
 			   ForwDef(idlist, sc) :
 			   GetDefinitionModule(idlist->nd_IDF, 1), 

+ 33 - 33
lang/m2/comp/expression.g

@@ -21,7 +21,6 @@
 #include	"idf.h"
 #include	"def.h"
 #include	"node.h"
-#include	"const.h"
 #include	"type.h"
 #include	"chk_expr.h"
 #include	"warning.h"
@@ -51,8 +50,10 @@ qualident(t_node **p;)
 	]*
 ;
 
-selector(register t_node **pnd;):
-	'.'	{ *pnd = dot2node(Link,*pnd,NULLNODE); }
+selector(register t_node **pnd;)
+{ t_node *nd;
+} :
+	'.'	{ nd = dot2leaf(Select); nd->nd_NEXT = *pnd; *pnd = nd; }
 	IDENT	{ (*pnd)->nd_IDF = dot.TOK_IDF; }
 ;
 
@@ -64,35 +65,34 @@ ExpList(t_node **pnd;)
 				  nd->nd_symb = ',';
 				}
 	[
-		','		{ nd->nd_right = dot2leaf(Link);
-				  nd = nd->nd_right;
+		','		{ nd->nd_RIGHT = dot2leaf(Link);
+				  nd = nd->nd_RIGHT;
 				}
-		expression(&(nd->nd_left))
+		expression(&(nd->nd_LEFT))
 	]*
 ;
 
-ConstExpression(t_node **pnd;)
+ConstExpression(register t_node **pnd;)
 {
-	register t_node *nd;
 }:
 	expression(pnd)
 	/*
 	 * Changed rule in new Modula-2.
 	 * Check that the expression is a constant expression and evaluate!
 	 */
-		{ nd = *pnd;
+		{
 		  DO_DEBUG(options['C'], print("CONSTANT EXPRESSION\n"));
-		  DO_DEBUG(options['C'], PrNode(nd, 0));
+		  DO_DEBUG(options['C'], PrNode(*pnd, 0));
 
-		  if (ChkExpression(nd) &&
-		      nd->nd_class != Set &&
-		      nd->nd_class != Value &&
-		      ! (options['l'] && nd->nd_class == Def && IsProc(nd))) {
+		  if (ChkExpression(pnd) &&
+		      (*pnd)->nd_class != Set &&
+		      (*pnd)->nd_class != Value &&
+		      ! (options['l'] && (*pnd)->nd_class == Def && IsProc((*pnd)))) {
 			error("constant expression expected");
 		  }
 
 		  DO_DEBUG(options['C'], print("RESULTS IN\n"));
-		  DO_DEBUG(options['C'], PrNode(nd, 0));
+		  DO_DEBUG(options['C'], PrNode(*pnd, 0));
 		}
 ;
 
@@ -104,7 +104,7 @@ expression(register t_node **pnd;)
 		/* relation */
 		[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
 			{ *pnd = dot2node(Oper, *pnd, NULLNODE); }
-		SimpleExpression(&((*pnd)->nd_right))
+		SimpleExpression(&((*pnd)->nd_RIGHT))
 	|
 	]
 ;
@@ -128,7 +128,7 @@ SimpleExpression(register t_node **pnd;)
 	]
 	term(pnd)
 			{ if (nd) {
-				nd->nd_right = *pnd;
+				nd->nd_RIGHT = *pnd;
 				*pnd = nd;
 			  }
 			  nd = *pnd;
@@ -137,7 +137,7 @@ SimpleExpression(register t_node **pnd;)
 		/* AddOperator */
 		[ '+' | '-' | OR ]
 			{ nd = dot2node(Oper, nd, NULLNODE); }
-		term(&(nd->nd_right))
+		term(&(nd->nd_RIGHT))
 	]*
 			{ *pnd = nd; }
 ;
@@ -157,7 +157,7 @@ term(t_node **pnd;)
 		/* MulOperator */
 		[ '*' | '/' | DIV | MOD | AND ]
 			{ nd = dot2node(Oper, nd, NULLNODE); }
-		factor(&(nd->nd_right))
+		factor(&(nd->nd_RIGHT))
 	]*
 			{ *pnd = nd; }
 ;
@@ -178,12 +178,12 @@ factor(register t_node **p;)
 		designator_tail(p)
 		[
 			{ *p = dot2node(Call, *p, NULLNODE); }
-			ActualParameters(&((*p)->nd_right))
+			ActualParameters(&((*p)->nd_RIGHT))
 		|
 		]
 	|
 		bare_set(&nd1)
-			{ nd = nd1; nd->nd_left = *p; *p = nd; }
+			{ nd = nd1; nd->nd_LEFT = *p; *p = nd; }
 	]
 |
 	bare_set(p)
@@ -210,8 +210,8 @@ factor(register t_node **p;)
 		  if (class == Arrsel ||
 		      class == Arrow ||
 		      class == Name ||
-		      class == Link) {
-			nd->nd_right = *p;
+		      class == Select) {
+			nd->nd_RIGHT = *p;
 			*p = nd;
 		  }
 		  else FreeNode(nd);
@@ -219,20 +219,20 @@ factor(register t_node **p;)
 	')'
 |
 	NOT		{ *p = dot2leaf(Uoper); }
-	factor(&((*p)->nd_right))
+	factor(&((*p)->nd_RIGHT))
 ;
 
 bare_set(t_node **pnd;)
 {
 	register t_node *nd;
 } :
-	'{'		{ dot.tk_symb = SET;
+	'{'		{ DOT = SET;
 			  *pnd = nd = dot2leaf(Xset);
 			  nd->nd_type = bitset_type;
 			}
 	[
 		element(nd)
-		[	{ nd = nd->nd_right; }
+		[	{ nd = nd->nd_RIGHT; }
 			',' element(nd)
 		]*
 	|
@@ -245,15 +245,15 @@ ActualParameters(t_node **pnd;):
 ;
 
 element(register t_node *nd;) :
-	expression(&(nd->nd_right))
+	expression(&(nd->nd_RIGHT))
 	[
 		UPTO
-			{ nd->nd_right = dot2node(Link, nd->nd_right, NULLNODE);}
-		expression(&(nd->nd_right->nd_right))
+			{ nd->nd_RIGHT = dot2node(Link, nd->nd_RIGHT, NULLNODE);}
+		expression(&(nd->nd_RIGHT->nd_RIGHT))
 	|
 	]
-			{ nd->nd_right = dot2node(Link, nd->nd_right, NULLNODE);
-			  nd->nd_right->nd_symb = ',';
+			{ nd->nd_RIGHT = dot2node(Link, nd->nd_RIGHT, NULLNODE);
+			  nd->nd_RIGHT->nd_symb = ',';
 			}
 ;
 
@@ -279,12 +279,12 @@ visible_designator_tail(t_node **pnd;)
 	register t_node *nd = *pnd;
 }:
 	'['		{ nd = dot2node(Arrsel, nd, NULLNODE); }
-		expression(&(nd->nd_right))
+		expression(&(nd->nd_RIGHT))
 		[
 			','
 			{ nd = dot2node(Arrsel, nd, NULLNODE);
 			}
-			expression(&(nd->nd_right))
+			expression(&(nd->nd_RIGHT))
 		]*
 	']'
 			{ *pnd = nd; }

+ 3 - 3
lang/m2/comp/main.c

@@ -45,7 +45,7 @@ int		pass_1 = 1;
 t_def	 	*Defined;
 extern int 	err_occurred;
 extern int	fp_used;		/* set if floating point used */
-static t_node	_emptystat = { NULLNODE, NULLNODE, Stat, 0, NULLTYPE, { ';' }};
+static t_node	_emptystat = { Stat, 0, NULLTYPE, { ';' }};
 t_node		*EmptyStatement = &_emptystat;
 
 main(argc, argv)
@@ -66,9 +66,9 @@ main(argc, argv)
 	Nargv[Nargc] = 0;	/* terminate the arg vector	*/
 	if (Nargc < 2) {
 		fprint(STDERR, "%s: Use a file argument\n", ProgName);
-		exit(1);
+		sys_stop(S_EXIT);
 	}
-	exit(!Compile(Nargv[1], Nargv[2]));
+	sys_stop(Compile(Nargv[1], Nargv[2]) ? S_END : S_EXIT);
 	/*NOTREACHED*/
 }
 

+ 6 - 4
lang/m2/comp/node.H

@@ -10,8 +10,6 @@
 /* $Header$ */
 
 struct node {
-	struct node *nd_left;
-	struct node *nd_right;
 	char nd_class;		/* kind of node */
 #define Value	0		/* constant */
 #define Arrsel  1		/* array selection */
@@ -24,7 +22,8 @@ struct node {
 #define Xset	8		/* a set */
 #define Def	9		/* an identified name */
 #define Stat	10		/* a statement */
-#define Link	11
+#define Select	11		/* a '.' selection */
+#define Link	12
 				/* do NOT change the order or the numbers!!! */
 	char nd_flags;		/* options */
 #define ROPTION	1
@@ -33,6 +32,9 @@ struct node {
 	struct token nd_token;
 #define nd_set		nd_token.tk_data.tk_set
 #define nd_def		nd_token.tk_data.tk_def
+#define nd_LEFT		nd_token.tk_data.tk_left
+#define nd_RIGHT	nd_token.tk_data.tk_right
+#define nd_NEXT		nd_token.tk_data.tk_next
 #define nd_symb		nd_token.tk_symb
 #define nd_lineno	nd_token.tk_lineno
 #define nd_IDF		nd_token.TOK_IDF
@@ -49,7 +51,7 @@ typedef struct node	t_node;
 
 /* ALLOCDEF "node" 50 */
 
-extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf();
+extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(), *getnode();
 
 #define NULLNODE ((t_node *) 0)
 

+ 69 - 13
lang/m2/comp/node.c

@@ -22,6 +22,33 @@
 #include	"node.h"
 #include	"main.h"
 
+static int	nsubnodes[] = {
+	0,
+	2,
+	2,
+	2,
+	2,
+	2,
+	1,
+	1,
+	2,
+	1,
+	2,
+	1,
+	2
+};
+
+t_node *
+getnode(class)
+{
+	register t_node *nd = new_node();
+
+	if (options['R']) nd->nd_flags |= ROPTION;
+	if (options['A']) nd->nd_flags |= AOPTION;
+	nd->nd_class = class;
+	return nd;
+}
+
 t_node *
 MkNode(class, left, right, token)
 	t_node *left, *right;
@@ -29,14 +56,11 @@ MkNode(class, left, right, token)
 {
 	/*	Create a node and initialize it with the given parameters
 	*/
-	register t_node *nd = new_node();
+	register t_node *nd = getnode(class);
 
-	nd->nd_left = left;
-	nd->nd_right = right;
 	nd->nd_token = *token;
-	nd->nd_class = class;
-	if (options['R']) nd->nd_flags |= ROPTION;
-	if (options['A']) nd->nd_flags |= AOPTION;
+	nd->nd_LEFT = left;
+	nd->nd_RIGHT = right;
 	return nd;
 }
 
@@ -51,21 +75,40 @@ t_node *
 MkLeaf(class, token)
 	t_token *token;
 {
-	return MkNode(class, NULLNODE, NULLNODE, token);
+	register t_node *nd = getnode(class);
+	nd->nd_token = *token;
+	switch(nsubnodes[class]) {
+	case 1:
+		nd->nd_NEXT = 0;
+		break;
+	case 2:
+		nd->nd_LEFT = 0;
+		nd->nd_RIGHT = 0;
+		break;
+	}
+	return nd;
 }
 
 t_node *
 dot2leaf(class)
 {
-	return MkNode(class, NULLNODE, NULLNODE, &dot);
+	return MkLeaf(class, &dot);
 }
 
 FreeLR(nd)
 	register t_node *nd;
 {
-	FreeNode(nd->nd_left);
-	FreeNode(nd->nd_right);
-	nd->nd_left = nd->nd_right = 0;
+	switch(nsubnodes[nd->nd_class]) {
+	case 2:
+		FreeNode(nd->nd_LEFT);
+		FreeNode(nd->nd_RIGHT);
+		nd->nd_LEFT = nd->nd_RIGHT = 0;
+		break;
+	case 1:
+		FreeNode(nd->nd_NEXT);
+		nd->nd_NEXT = 0;
+		break;
+	}
 }
 
 FreeNode(nd)
@@ -85,6 +128,12 @@ NodeCrash(expp)
 	crash("Illegal node %d", expp->nd_class);
 }
 
+PNodeCrash(expp)
+	t_node **expp;
+{
+	crash("Illegal node %d", (*expp)->nd_class);
+}
+
 #ifdef DEBUG
 
 extern char *symbol2str();
@@ -117,7 +166,14 @@ PrNode(nd, lvl)
 		return;
 	}
 	printnode(nd, lvl);
-	PrNode(nd->nd_left, lvl + 1);
-	PrNode(nd->nd_right, lvl + 1);
+	switch(nsubnodes[nd->nd_class]) {
+	case 1:
+		PrNode(nd->nd_LEFT, lvl + 1);
+		PrNode(nd->nd_RIGHT, lvl + 1);
+		break;
+	case 2:
+		PrNode(nd->nd_NEXT, lvl + 1);
+		break;
+	}
 }
 #endif DEBUG

+ 1 - 1
lang/m2/comp/program.g

@@ -191,7 +191,7 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
 	definition* END IDENT
 			{ end_definition_list(&(currscope->sc_def));
 			  DefinitionModule--;
-			  match_id(df->df_idf, dot.TOK_IDF);
+			  match_id(dot.TOK_IDF, df->df_idf);
 			  df->df_flags &= ~D_BUSY;
 			}
 	'.'

+ 3 - 3
lang/m2/comp/stab.c

@@ -24,13 +24,13 @@
 #include	"def.h"
 #include	"type.h"
 #include	"idf.h"
-#include	"const.h"
 #include	"scope.h"
 #include	"main.h"
 
 #define INCR_SIZE	64
 
 extern int	proclevel;
+extern char	*sprint();
 
 static struct db_str {
 	unsigned	sz;
@@ -276,11 +276,11 @@ stb_string(df, kind)
 		break;
 	case D_END:
 		adds_db_str(sprint(buf, "E%d;", df->mod_vis->sc_count));
-		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0);
+		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
 		break;
 	case D_PEND:
 		adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count));
-		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0);
+		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
 		break;
 	case D_VARIABLE:
 		if (DefinitionModule && CurrVis != Defined->mod_vis) break;

+ 50 - 45
lang/m2/comp/statement.g

@@ -40,7 +40,7 @@ statement(register t_node **pnd;)
 				  nd->nd_symb = '(';
 				  nd->nd_lineno = (*pnd)->nd_lineno;
 				}
-		ActualParameters(&(nd->nd_right))?
+		ActualParameters(&(nd->nd_RIGHT))?
 	|
 		[ BECOMES	
 		| '='		{ error("':=' expected instead of '='");
@@ -48,7 +48,7 @@ statement(register t_node **pnd;)
 				}
 		]
 				{ nd = dot2node(Stat, *pnd, NULLNODE); }
-		expression(&(nd->nd_right))
+		expression(&(nd->nd_RIGHT))
 	]
 				{ *pnd = nd; }
 	/*
@@ -60,19 +60,19 @@ statement(register t_node **pnd;)
 	CaseStatement(pnd)
 |
 	WHILE		{ *pnd = nd = dot2leaf(Stat); }
-	expression(&(nd->nd_left))
+	expression(&(nd->nd_LEFT))
 	DO
-	StatementSequence(&(nd->nd_right))
+	StatementSequence(&(nd->nd_RIGHT))
 	END
 |
 	REPEAT		{ *pnd = nd = dot2leaf(Stat); }
-	StatementSequence(&(nd->nd_left))
+	StatementSequence(&(nd->nd_LEFT))
 	UNTIL
-	expression(&(nd->nd_right))
+	expression(&(nd->nd_RIGHT))
 |
 			{ loopcount++; }
 	LOOP		{ *pnd = nd = dot2leaf(Stat); }
-	StatementSequence(&((*pnd)->nd_right))
+	StatementSequence(&((*pnd)->nd_RIGHT))
 	END
 			{ loopcount--; }
 |
@@ -116,7 +116,7 @@ StatementSequence(register t_node **pnd;)
 			  	nd1 = dot2node(Link, *pnd, nd);
 			  	*pnd = nd1;
 			  	nd1->nd_symb = ';';
-			  	pnd = &(nd1->nd_right);
+			  	pnd = &(nd1->nd_RIGHT);
 			  }
 			}
 	]*
@@ -129,25 +129,25 @@ IfStatement(t_node **pnd;)
 	IF		{ nd = dot2leaf(Stat);
 			  *pnd = nd;
 			}
-	expression(&(nd->nd_left))
-	THEN		{ nd->nd_right = dot2leaf(Link);
-			  nd = nd->nd_right;
+	expression(&(nd->nd_LEFT))
+	THEN		{ nd->nd_RIGHT = dot2leaf(Link);
+			  nd = nd->nd_RIGHT;
 			}
-	StatementSequence(&(nd->nd_left))
+	StatementSequence(&(nd->nd_LEFT))
 	[
-		ELSIF	{ nd->nd_right = dot2leaf(Stat);
-			  nd = nd->nd_right;
+		ELSIF	{ nd->nd_RIGHT = dot2leaf(Stat);
+			  nd = nd->nd_RIGHT;
 			  nd->nd_symb = IF;
 			}
-		expression(&(nd->nd_left))
-		THEN	{ nd->nd_right = dot2leaf(Link);
-			  nd = nd->nd_right;
+		expression(&(nd->nd_LEFT))
+		THEN	{ nd->nd_RIGHT = dot2leaf(Link);
+			  nd = nd->nd_RIGHT;
 			}
-		StatementSequence(&(nd->nd_left))
+		StatementSequence(&(nd->nd_LEFT))
 	]*
 	[
 		ELSE
-		StatementSequence(&(nd->nd_right))
+		StatementSequence(&(nd->nd_RIGHT))
 	|
 	]
 	END
@@ -159,16 +159,16 @@ CaseStatement(t_node **pnd;)
 	t_type *tp = 0;
 } :
 	CASE		{ *pnd = nd = dot2leaf(Stat); }
-	expression(&(nd->nd_left))
+	expression(&(nd->nd_LEFT))
 	OF
-	case(&(nd->nd_right), &tp)
-			{ nd = nd->nd_right; }
+	case(&(nd->nd_RIGHT), &tp)
+			{ nd = nd->nd_RIGHT; }
 	[
 		'|'
-		case(&(nd->nd_right), &tp)
-			{ nd = nd->nd_right; }
+		case(&(nd->nd_RIGHT), &tp)
+			{ nd = nd->nd_RIGHT; }
 	]*
-	[ ELSE StatementSequence(&(nd->nd_right))
+	[ ELSE StatementSequence(&(nd->nd_RIGHT))
 	|
 	]
 	END
@@ -177,7 +177,7 @@ CaseStatement(t_node **pnd;)
 case(t_node **pnd; t_type **ptp;) :
 	[ CaseLabelList(ptp, pnd)
 	  ':'		{ *pnd = dot2node(Link, *pnd, NULLNODE); }
-	  StatementSequence(&((*pnd)->nd_right))
+	  StatementSequence(&((*pnd)->nd_RIGHT))
 	|
 	]
 			{ *pnd = dot2node(Link, *pnd, NULLNODE);
@@ -191,9 +191,9 @@ WhileStatement(t_node **pnd;)
 	register t_node *nd;
 }:
 	WHILE		{ *pnd = nd = dot2leaf(Stat); }
-	expression(&(nd->nd_left))
+	expression(&(nd->nd_LEFT))
 	DO
-	StatementSequence(&(nd->nd_right))
+	StatementSequence(&(nd->nd_RIGHT))
 	END
 ;
 
@@ -202,44 +202,49 @@ RepeatStatement(t_node **pnd;)
 	register t_node *nd;
 }:
 	REPEAT		{ *pnd = nd = dot2leaf(Stat); }
-	StatementSequence(&(nd->nd_left))
+	StatementSequence(&(nd->nd_LEFT))
 	UNTIL
-	expression(&(nd->nd_right))
+	expression(&(nd->nd_RIGHT))
 ;
 */
 
 ForStatement(t_node **pnd;)
 {
 	register t_node *nd, *nd1;
-	t_node *dummy;
 }:
 	FOR		{ *pnd = nd = dot2leaf(Stat); }
-	IDENT		{ nd->nd_IDF = dot.TOK_IDF; }
-	BECOMES		{ nd->nd_left = nd1 = dot2leaf(Stat); }
-	expression(&(nd1->nd_left))
+	IDENT		{ nd1 = dot2leaf(Name); }
+	BECOMES		{ nd->nd_LEFT = dot2node(Stat, nd1, dot2leaf(Link));
+			  nd1 = nd->nd_LEFT->nd_RIGHT;
+			  nd1->nd_symb = TO;
+			}
+	expression(&(nd1->nd_LEFT))
 	TO
-	expression(&(nd1->nd_right))
+	expression(&(nd1->nd_RIGHT))
+			{ nd->nd_RIGHT = nd1 = dot2leaf(Link); 
+			  nd1->nd_symb = BY;
+			}
 	[
 		BY
-		ConstExpression(&dummy)
-			{ if (!(dummy->nd_type->tp_fund & T_INTORCARD)) {
+		ConstExpression(&(nd1->nd_LEFT))
+			{ if (!(nd1->nd_LEFT->nd_type->tp_fund & T_INTORCARD)) {
 				error("illegal type in BY clause");
 			  }
-			  nd1->nd_INT = dummy->nd_INT;
-			  FreeNode(dummy);
 			}
 	|
-			{ nd1->nd_INT = 1; }
+			{ nd1->nd_LEFT = dot2leaf(Value);
+			  nd1->nd_LEFT->nd_INT = 1;
+			}
 	]
 	DO
-	StatementSequence(&(nd->nd_right))
+	StatementSequence(&(nd1->nd_RIGHT))
 	END
 ;
 
 /* inline in Statement; lack of space
 LoopStatement(t_node **pnd;):
 	LOOP		{ *pnd = dot2leaf(Stat); }
-	StatementSequence(&((*pnd)->nd_right))
+	StatementSequence(&((*pnd)->nd_RIGHT))
 	END
 ;
 */
@@ -249,9 +254,9 @@ WithStatement(t_node **pnd;)
 	register t_node *nd;
 }:
 	WITH		{ *pnd = nd = dot2leaf(Stat); }
-	designator(&(nd->nd_left))
+	designator(&(nd->nd_LEFT))
 	DO
-	StatementSequence(&(nd->nd_right))
+	StatementSequence(&(nd->nd_RIGHT))
 	END
 ;
 
@@ -264,7 +269,7 @@ ReturnStatement(t_node **pnd;)
 
 	RETURN		{ *pnd = nd = dot2leaf(Stat); }
 	[
-		expression(&(nd->nd_right))
+		expression(&(nd->nd_RIGHT))
 			{ if (scopeclosed(CurrentScope)) {
 error("a module body cannot return a value");
 			  }

+ 5 - 0
lang/m2/comp/type.H

@@ -161,6 +161,8 @@ extern t_type
 #define	float_size	(SZ_FLOAT)
 #define	double_size	(SZ_DOUBLE)
 #define	pointer_size	(SZ_POINTER)
+
+#define wrd_bits	(8*(int)word_size)
 #else NOCROSS
 
 extern int
@@ -182,6 +184,9 @@ extern arith
 	float_size,
 	double_size,
 	pointer_size;		/* All from type.c */
+
+extern unsigned int
+	wrd_bits;		/* from cstoper.c */
 #endif NOCROSS
 
 extern arith

+ 11 - 9
lang/m2/comp/type.c

@@ -23,7 +23,6 @@
 #include	"type.h"
 #include	"idf.h"
 #include	"node.h"
-#include	"const.h"
 #include	"scope.h"
 #include	"walk.h"
 #include	"chk_expr.h"
@@ -52,6 +51,8 @@ arith
 	pointer_size = SZ_POINTER;
 #endif
 
+#define arith_sign	((arith) (1L << (sizeof(arith) * 8 - 1)))
+
 arith	ret_area_size;
 
 t_type
@@ -255,12 +256,13 @@ enum_type(EnumList)
 }
 
 t_type *
-qualified_type(nd)
-	register t_node *nd;
+qualified_type(pnd)
+	t_node **pnd;
 {
 	register t_def *df;
 
-	if (ChkDesig(nd, D_USED)) {
+	if (ChkDesig(pnd, D_USED)) {
+		register t_node *nd = *pnd;
 		if (nd->nd_class != Def) {
 			node_error(nd, "type expected");
 			FreeNode(nd);
@@ -284,9 +286,9 @@ node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
 			}
 		   	return df->df_type;
 		}
-node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
+node_error(nd, "identifier \"%s\" is not a type", df->df_idf->id_text);
 	}
-	FreeNode(nd);
+	FreeNode(*pnd);
 	return error_type;
 }
 
@@ -681,7 +683,7 @@ SolveForwardTypeRefs(df)
 		df->df_kind = D_TYPE;
 		while (nd) {
 			nd->nd_type->tp_next = df->df_type;
-			nd = nd->nd_right;
+			nd = nd->nd_RIGHT;
 		}
 		FreeNode(df->df_forw_node);
 	}
@@ -750,7 +752,7 @@ type_or_forward(tp)
 			df1->df_forw_node = 0;
 			/* Fall through */
 		case D_FORWTYPE:
-			nd = dot2node(0, NULLNODE, df1->df_forw_node);
+			nd = dot2node(Link, NULLNODE, df1->df_forw_node);
 			df1->df_forw_node = nd;
 			nd->nd_type = tp;
 			return 0;
@@ -758,7 +760,7 @@ type_or_forward(tp)
 			return 1;
 		}
 	}
-	nd = dot2leaf(0);
+	nd = dot2leaf(Name);
 	if ((df1 = lookfor(nd, CurrVis, 0, D_USED))->df_kind == D_MODULE) {
 		/* A Modulename in one of the enclosing scopes.
 		   It is not clear from the language definition that

+ 88 - 89
lang/m2/comp/walk.c

@@ -72,7 +72,7 @@ static int		UseWarnings();
 int
 LblWalkNode(lbl, nd, exit, reach)
 	label lbl, exit;
-	register t_node *nd;
+	t_node *nd;
 {
 	/*	Generate code for node "nd", after generating instruction
 		label "lbl". "exit" is the exit label for the closest
@@ -134,8 +134,8 @@ DoLineno(nd)
 			static int	ms_lineno;
 
 			if (ms_lineno != nd->nd_lineno) {
-				C_ms_std((char *) 0, N_SLINE, nd->nd_lineno);
 				ms_lineno = nd->nd_lineno;
+				C_ms_std((char *) 0, N_SLINE, ms_lineno);
 			}
 		}
 #endif /* DBSYMTAB */
@@ -218,7 +218,7 @@ WalkModule(module)
 			C_cal("killbss");
 		}
 
-		for (; nd; nd = nd->nd_left) {
+		for (; nd; nd = nd->nd_NEXT) {
 			C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
 		}
 		DoFilename(1);
@@ -578,8 +578,8 @@ WalkLink(nd, exit_label, end_reached)
 	*/
 
 	while (nd && nd->nd_class == Link) {	 /* statement list */
-		end_reached = WalkNode(nd->nd_left, exit_label, end_reached);
-		nd = nd->nd_right;
+		end_reached = WalkNode(nd->nd_LEFT, exit_label, end_reached);
+		nd = nd->nd_RIGHT;
 	}
 
 	return WalkNode(nd, exit_label, end_reached);
@@ -602,8 +602,8 @@ WalkStat(nd, exit_label, end_reached)
 {
 	/*	Walk through a statement, generating code for it.
 	*/
-	register t_node *left = nd->nd_left;
-	register t_node *right = nd->nd_right;
+	register t_node *left = nd->nd_LEFT;
+	register t_node *right = nd->nd_RIGHT;
 
 	assert(nd->nd_class == Stat);
 
@@ -620,33 +620,36 @@ WalkStat(nd, exit_label, end_reached)
 	options['R'] = (nd->nd_flags & ROPTION);
 	options['A'] = (nd->nd_flags & AOPTION);
 	switch(nd->nd_symb) {
-	case '(':
-		if (ChkCall(nd)) {
+	case '(': {
+		t_node *nd1 = nd;
+		if (ChkCall(&nd1)) {
+			assert(nd == nd1);
 			if (nd->nd_type != 0) {
 				node_error(nd, "procedure call expected instead of function call");
 				break;
 			}
 			CodeCall(nd);
 		}
+		}
 		break;
 
 	case BECOMES:
-		DoAssign(left, right);
+		DoAssign(nd);
 		break;
 
 	case IF:
 		{	label l1 = ++text_label, l3 = ++text_label;
 			int end_r;
 
-			ExpectBool(left, l3, l1);
+			ExpectBool(&(nd->nd_LEFT), l3, l1);
 			assert(right->nd_symb == THEN);
-			end_r = LblWalkNode(l3, right->nd_left, exit_label, end_reached);
+			end_r = LblWalkNode(l3, right->nd_LEFT, exit_label, end_reached);
 
-			if (right->nd_right) {	/* ELSE part */
+			if (right->nd_RIGHT) {	/* ELSE part */
 				label l2 = ++text_label;
 
 				C_bra(l2);
-				end_reached = end_r | LblWalkNode(l1, right->nd_right, exit_label, end_reached);
+				end_reached = end_r | LblWalkNode(l1, right->nd_RIGHT, exit_label, end_reached);
 				l1 = l2;
 			}
 			else	end_reached |= end_r;
@@ -666,7 +669,7 @@ WalkStat(nd, exit_label, end_reached)
 			C_bra(dummy);
 			end_reached |= LblWalkNode(loop, right, exit_label, end_reached);
 			def_ilb(dummy);
-			ExpectBool(left, loop, exit);
+			ExpectBool(&(nd->nd_LEFT), loop, exit);
 			def_ilb(exit);
 			break;
 		}
@@ -675,7 +678,7 @@ WalkStat(nd, exit_label, end_reached)
 		{	label loop = ++text_label, exit = ++text_label;
 
 			end_reached = LblWalkNode(loop, left, exit_label, end_reached);
-			ExpectBool(right, exit, loop);
+			ExpectBool(&(nd->nd_RIGHT), exit, loop);
 			def_ilb(exit);
 			break;
 		}
@@ -696,44 +699,45 @@ WalkStat(nd, exit_label, end_reached)
 		{
 			arith tmp = NewInt();
 			arith tmp2 = NewInt();
-			register t_node *fnd;
 			int good_forvar;
 			label l1 = ++text_label;
 			label l2 = ++text_label;
 			int uns = 0;
 			arith stepsize;
 			t_type *bstp;
+			t_node *loopid;
 
-			good_forvar = DoForInit(nd);
-			if ((stepsize = left->nd_INT) == 0) {
-				node_warning(left,
+			good_forvar = DoForInit(left);
+			loopid = left->nd_LEFT;
+			if ((stepsize = right->nd_LEFT->nd_INT) == 0) {
+				node_warning(right->nd_LEFT,
 					     W_ORDINARY,
 					     "zero stepsize in FOR loop");
 			}
-			fnd = left->nd_right;
 			if (good_forvar) {
-				bstp = BaseType(nd->nd_type);
+				bstp = BaseType(loopid->nd_type);
 				uns = bstp->tp_fund != T_INTEGER;
-				CodePExpr(fnd);
+				CodePExpr(left->nd_RIGHT->nd_RIGHT);
 				C_stl(tmp);
-				CodePExpr(left->nd_left);
+				CodePExpr(left->nd_RIGHT->nd_LEFT);
 				C_dup(int_size);
 				C_stl(tmp2);
 				C_lol(tmp);
 				if (uns) C_cmu(int_size);
 				else C_cmi(int_size);
-				if (left->nd_INT >= 0) C_zgt(l2);
+				if (stepsize >= 0) C_zgt(l2);
 				else C_zlt(l2);
 				C_lol(tmp2);
-				RangeCheck(nd->nd_type, left->nd_left->nd_type);
-				CodeDStore(nd);
-				if (left->nd_INT >= 0) {
+				RangeCheck(loopid->nd_type,
+					   left->nd_RIGHT->nd_LEFT->nd_type);
+				CodeDStore(loopid);
+				if (stepsize >= 0) {
 					C_lol(tmp);
-					ForLoopVarExpr(nd);
+					ForLoopVarExpr(loopid);
 				}
 				else {
 					stepsize = -stepsize;
-					ForLoopVarExpr(nd);
+					ForLoopVarExpr(loopid);
 					C_lol(tmp);
 				}
 				C_sbu(int_size);
@@ -742,23 +746,23 @@ WalkStat(nd, exit_label, end_reached)
 					C_dvu(int_size);
 				}
 				C_stl(tmp);
-				nd->nd_def->df_flags |= D_FORLOOP;
+				loopid->nd_def->df_flags |= D_FORLOOP;
 				def_ilb(l1);
 				if (! options['R']) {
 					label x = ++text_label;
 
-					ForLoopVarExpr(nd);
+					ForLoopVarExpr(loopid);
 					C_stl(tmp2);
-					end_reached |= WalkNode(right, exit_label, end_reached);
+					end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
 					C_lol(tmp2);
-					ForLoopVarExpr(nd);
+					ForLoopVarExpr(loopid);
 					C_beq(x);
 					c_loc(M2_FORCH);
 					C_trp();
 					def_ilb(x);
 				}
-				else	end_reached |= WalkNode(right, exit_label, end_reached);
-				nd->nd_def->df_flags &= ~D_FORLOOP;
+				else	end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
+				loopid->nd_def->df_flags &= ~D_FORLOOP;
 				FreeInt(tmp2);
 				if (stepsize) {
 					C_lol(tmp);
@@ -767,24 +771,20 @@ WalkStat(nd, exit_label, end_reached)
 					c_loc(1);
 					C_sbu(int_size);
 					C_stl(tmp);
-					C_loc(left->nd_INT);
-					ForLoopVarExpr(nd);
+					C_loc(right->nd_LEFT->nd_INT);
+					ForLoopVarExpr(loopid);
 					C_adu(int_size);
-					RangeCheck(nd->nd_type, bstp);
-					CodeDStore(nd);
+					RangeCheck(loopid->nd_type, bstp);
+					CodeDStore(loopid);
 				}
 			}
 			else {
-				end_reached |= WalkNode(right, exit_label, end_reached);
-				nd->nd_def->df_flags &= ~D_FORLOOP;
+				end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
+				loopid->nd_def->df_flags &= ~D_FORLOOP;
 			}
 			C_bra(l1);
 			def_ilb(l2);
 			FreeInt(tmp);
-#ifdef DEBUG
-			nd->nd_left = left;
-			nd->nd_right = right;
-#endif
 		}
 		break;
 
@@ -794,7 +794,8 @@ WalkStat(nd, exit_label, end_reached)
 			struct withdesig wds;
 			t_desig ds;
 
-			if (! WalkDesignator(left, &ds, D_USED)) break;
+			if (! WalkDesignator(&(nd->nd_LEFT), &ds, D_USED)) break;
+			left = nd->nd_LEFT;
 			if (left->nd_type->tp_fund != T_RECORD) {
 				node_error(left, "record variable expected");
 				break;
@@ -821,7 +822,7 @@ WalkStat(nd, exit_label, end_reached)
 			CurrVis = link.sc_next;
 			WithDesigs = wds.w_next;
 			FreePtr(ds.dsg_offset);
-			ChkDesig(left, wds.w_flags & (D_USED|D_DEFINED));
+			ChkDesig(&(nd->nd_LEFT), wds.w_flags & (D_USED|D_DEFINED));
 			break;
 		}
 
@@ -835,15 +836,15 @@ WalkStat(nd, exit_label, end_reached)
 	case RETURN:
 		end_reached &= ~REACH_FLAG;
 		if (right) {
-			if (! ChkExpression(right)) break;
+			if (! ChkExpression(&(nd->nd_RIGHT))) break;
 			/* The type of the return-expression must be
 			   assignment compatible with the result type of the
 			   function procedure (See Rep. 9.11).
 			*/
-			if (!ChkAssCompat(&(nd->nd_right), func_type, "RETURN")) {
+			if (!ChkAssCompat(&(nd->nd_RIGHT), func_type, "RETURN")) {
 				break;
 			}
-			right = nd->nd_right;
+			right = nd->nd_RIGHT;
 			if (right->nd_type->tp_fund == T_STRING) {
 				CodePString(right, func_type);
 			}
@@ -872,60 +873,58 @@ int (*WalkTable[])() = {
 	NodeCrash,
 	NodeCrash,
 	WalkStat,
+	NodeCrash,
 	WalkLink,
 };
 
-ExpectBool(nd, true_label, false_label)
-	register t_node *nd;
+ExpectBool(pnd, true_label, false_label)
+	register t_node **pnd;
 	label true_label, false_label;
 {
-	/*	"nd" must indicate a boolean expression. Check this and
+	/*	"pnd" must indicate a boolean expression. Check this and
 		generate code to evaluate the expression.
 	*/
 	register t_desig *ds = new_desig();
 
-	if (ChkExpression(nd)) {
-		if (nd->nd_type != bool_type && nd->nd_type != error_type) {
-			node_error(nd, "boolean expression expected");
+	if (ChkExpression(pnd)) {
+		if ((*pnd)->nd_type != bool_type &&
+		    (*pnd)->nd_type != error_type) {
+			node_error(*pnd, "boolean expression expected");
 		}
 
-		CodeExpr(nd, ds,  true_label, false_label);
+		CodeExpr(*pnd, ds,  true_label, false_label);
 	}
 	free_desig(ds);
 }
 
 int
-WalkDesignator(nd, ds, flags)
-	t_node *nd;
+WalkDesignator(pnd, ds, flags)
+	t_node **pnd;
 	t_desig *ds;
 {
 	/*	Check designator and generate code for it
 	*/
 
-	if (! ChkVariable(nd, flags)) return 0;
+	if (! ChkVariable(pnd, flags)) return 0;
 
 	clear((char *) ds, sizeof(t_desig));
-	CodeDesig(nd, ds);
+	CodeDesig(*pnd, ds);
 	return 1;
 }
 
 DoForInit(nd)
-	register t_node *nd;
+	t_node *nd;
 {
-	register t_node *left = nd->nd_left;
+	register t_node *right = nd->nd_RIGHT;
 	register t_def *df;
-	register t_type *base_tp;
+	t_type *base_tp;
 	t_type *tpl, *tpr;
 
-	nd->nd_left = nd->nd_right = 0;
-	nd->nd_class = Name;
-	nd->nd_symb = IDENT;
+	if (!( ChkVariable(&(nd->nd_LEFT), D_USED|D_DEFINED) &
+	       ChkExpression(&(right->nd_LEFT)) &
+	       ChkExpression(&(right->nd_RIGHT)))) return 0;
 
-	if (!( ChkVariable(nd, D_USED|D_DEFINED) &
-	       ChkExpression(left->nd_left) &
-	       ChkExpression(left->nd_right))) return 0;
-
-	df = nd->nd_def;
+	df = nd->nd_LEFT->nd_def;
 	if (df->df_kind == D_FIELD) {
 		node_error(nd,
 			   "FOR-loop variable may not be a field of a record");
@@ -958,12 +957,12 @@ DoForInit(nd)
 	}
 
 	base_tp = BaseType(df->df_type);
-	tpl = left->nd_left->nd_type;
-	tpr = left->nd_right->nd_type;
+	tpl = right->nd_LEFT->nd_type;
+	tpr = right->nd_RIGHT->nd_type;
 #ifndef STRICT_3RD_ED
 	if (! options['3']) {
-	  if (!ChkAssCompat(&(left->nd_left), base_tp, "FOR statement") ||
-	      !ChkAssCompat(&(left->nd_right), base_tp, "FOR statement")) {
+	  if (!ChkAssCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
+	      !ChkAssCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
 		return 1;
 	  }
 	  if (!TstCompat(df->df_type, tpl) ||
@@ -972,17 +971,16 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
 	  }
 	} else
 #endif
-	if (!ChkCompat(&(left->nd_left), base_tp, "FOR statement") ||
-	    !ChkCompat(&(left->nd_right), base_tp, "FOR statement")) {
+	if (!ChkCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
+	    !ChkCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
 		return 1;
 	}
 
 	return 1;
 }
 
-DoAssign(left, right)
-	register t_node *left;
-	t_node *right;
+DoAssign(nd)
+	register t_node *nd;
 {
 	/* May we do it in this order (expression first) ???
 	   The reference manual sais nothing about it, but the book does:
@@ -992,27 +990,28 @@ DoAssign(left, right)
 	register t_desig *dsr;
 	register t_type *tp;
 
-	if (! (ChkExpression(right) & ChkVariable(left, D_DEFINED))) return;
-	tp = left->nd_type;
+	if (! (ChkExpression(&(nd->nd_RIGHT)) &
+	       ChkVariable(&(nd->nd_LEFT), D_DEFINED))) return;
+	tp = nd->nd_LEFT->nd_type;
 
-	if (right->nd_symb == STRING) TryToString(right, tp);
+	if (nd->nd_RIGHT->nd_symb == STRING) TryToString(nd->nd_RIGHT, tp);
 
-	if (! ChkAssCompat(&right, tp, "assignment")) {
+	if (! ChkAssCompat(&(nd->nd_RIGHT), tp, "assignment")) {
 		return;
 	}
 	dsr = new_desig();
 
 #define StackNeededFor(ds)	((ds)->dsg_kind == DSG_PLOADED \
 				  || (ds)->dsg_kind == DSG_INDEXED)
-	CodeExpr(right, dsr, NO_LABEL, NO_LABEL);
-	tp = right->nd_type;
+	CodeExpr(nd->nd_RIGHT, dsr, NO_LABEL, NO_LABEL);
+	tp = nd->nd_RIGHT->nd_type;
 	if (complex(tp)) {
 		if (StackNeededFor(dsr)) CodeAddress(dsr);
 	}
 	else {
 		CodeValue(dsr, tp);
 	}
-	CodeMove(dsr, left, tp);
+	CodeMove(dsr, nd->nd_LEFT, tp);
 	free_desig(dsr);
 }
 

Alguns arquivos não foram mostrados porque muitos arquivos mudaram nesse diff