newer version

lang/m2/comp/LLlex.c

@@ -121,7 +121,6 @@ LLlex()
 		return tk->tk_symb;
 	}
 	tk->tk_lineno = LineNumber;
-	tk->tk_filename = FileName;
 
 again:
 	LoadChar(ch);

lang/m2/comp/LLlex.h

@@ -8,9 +8,8 @@ struct string {
 };
 
 struct token	{
-	int tk_symb;		/* token itself	*/
-	char *tk_filename;	/* filename in which it occurred */
-	int tk_lineno;		/* linenumber on which it occurred */
+	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	*/

lang/m2/comp/chk_expr.c

@@ -503,15 +503,12 @@ df->df_idf->id_text);
 				expp->nd_symb = INTEGER;
 			}
 			else  {
-				char *fn;
-				int ln;
+				unsigned int ln;
 
 				assert(df->df_kind == D_CONST);
 				ln = expp->nd_lineno;
-				fn = expp->nd_filename;
 				*expp = *(df->con_const);
 				expp->nd_lineno = ln;
-				expp->nd_filename = fn;
 			}
 		}
 

lang/m2/comp/code.c

@@ -51,7 +51,6 @@ CodeConst(cst, size)
 CodeString(nd)
 	struct node *nd;
 {
-	
 	label lab;
 	
 	if (nd->nd_type == charc_type) {
@@ -75,8 +74,8 @@ CodeReal(nd)
 }
 
 CodeExpr(nd, ds, true_label, false_label)
-	struct node *nd;
-	struct desig *ds;
+	register struct node *nd;
+	register struct desig *ds;
 	label true_label, false_label;
 {
 
@@ -135,9 +134,22 @@ CodeExpr(nd, ds, true_label, false_label)
 		ds->dsg_kind = DSG_LOADED;
 		break;
 
+	case Set: {
+		arith *st;
+		int i;
+
+		st = nd->nd_set;
+		for (i = nd->nd_type->tp_size / word_size, st = nd->nd_set + i;
+		     i > 0;
+		     i--) { 
+			C_loc(*--st);
+		}
+		ds->dsg_kind = DSG_LOADED;
+		}
+		break;
+
 	case Xset:
-	case Set:
-		/* ??? */
+		CodeSet(nd);
 		ds->dsg_kind = DSG_LOADED;
 		break;
 		
@@ -160,7 +172,7 @@ CodeCoercion(t1, t2)
 }
 
 CodeCall(nd)
-	struct node *nd;
+	register struct node *nd;
 {
 	/*	Generate code for a procedure call. Checking of parameters
 		and result is already done.
@@ -250,7 +262,7 @@ CodeAssign(nd, dst, dss)
 }
 
 Operands(leftop, rightop)
-	struct node *leftop, *rightop;
+	register struct node *leftop, *rightop;
 {
 	struct desig Des;
 
@@ -514,7 +526,7 @@ CodeOper(expr, true_label, false_label)
 /*	compare() serves as an auxiliary function of CodeOper	*/
 compare(relop, lbl)
 	int relop;
-	label lbl;
+	register label lbl;
 {
 	switch (relop)	{
 	case '<':
@@ -596,3 +608,42 @@ CodeUoper(nd)
 		crash("Bad unary operator");
 	}
 }
+
+CodeSet(nd)
+	register struct node *nd;
+{
+	struct type *tp = nd->nd_type;
+
+	nd = nd->nd_right;
+	while (nd) {
+		assert(nd->nd_class == Link && nd->nd_symb == ',');
+
+		CodeEl(nd->nd_left, tp);
+		nd = nd->nd_right;
+		if (nd) {
+			C_ior(tp->tp_size);
+		}
+	}
+}
+
+CodeEl(nd, tp)
+	register struct node *nd;
+	struct type *tp;
+{
+
+	if (nd->nd_class == Link && nd->nd_symb == UPTO) {
+		C_zer(tp->tp_size);	/* empty set */
+		C_lor((arith) 1);	/* SP: address of set */
+		Operands(nd->nd_left, nd->nd_right);
+		C_cal("_LtoUset");	/* library routine to fill set */
+		C_asp(2 * word_size + pointer_size);
+	}
+	else {
+		struct desig Des;
+
+		Des = InitDesig;
+		CodeExpr(nd, &Des, NO_LABEL, NO_LABEL);
+		CodeValue(nd, word_size);
+		C_set(tp->tp_size);
+	}
+}

lang/m2/comp/def.H

@@ -61,7 +61,6 @@ 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_scopes	df_value.df_forward.fo_scopes
 #define for_name	df_value.df_forward.fo_name
 };
 

lang/m2/comp/desig.c

@@ -329,6 +329,7 @@ CodeDesig(nd, ds)
 
 	case Oper:
 		assert(nd->nd_symb == '[');
+
 		CodeDesig(nd->nd_left, ds);
 		CodeAddress(ds);
 		*ds = InitDesig;
@@ -348,6 +349,7 @@ CodeDesig(nd, ds)
 
 	case Uoper:
 		assert(nd->nd_symb == '^');
+
 		CodeDesig(nd->nd_right, ds);
 		switch(ds->dsg_kind) {
 		case DSG_LOADED:

lang/m2/comp/error.c

@@ -137,9 +137,8 @@ _error(class, node, fmt, argv)
 	static unsigned int last_ln = 0;
 	unsigned int ln = 0;
 	static char * last_fn = 0;
-	char *fn = 0;
 	static int e_seen = 0;
-	char *remark = 0;
+	register char *remark = 0;
 	
 	/*	Since name and number are gathered from different places
 		depending on the class, we first collect the relevant
@@ -185,7 +184,6 @@ _error(class, node, fmt, argv)
 	switch (class)	{	
 	case WARNING:
 	case ERROR:
-		fn = node ? node->nd_filename : dot.tk_filename;
 		ln = node ? node->nd_lineno : dot.tk_lineno;
 		break;
 	case LEXWARNING:
@@ -196,14 +194,13 @@ _error(class, node, fmt, argv)
 	case VDEBUG:
 #endif DEBUG
 		ln = LineNumber;
-		fn = FileName;
 		break;
 	}
 	
 #ifdef DEBUG
 	if (class != VDEBUG) {
 #endif
-	if (fn == last_fn && ln == last_ln)	{
+	if (FileName == last_fn && ln == last_ln)	{
 		/* we've seen this place before */
 		e_seen++;
 		if (e_seen == MAXERR_LINE) fmt = "etc ...";
@@ -215,14 +212,14 @@ _error(class, node, fmt, argv)
 	else	{
 		/* brand new place */
 		last_ln = ln;
-		last_fn = fn;
+		last_fn = FileName;
 		e_seen = 0;
 	}
 #ifdef DEBUG
 	}
 #endif DEBUG
 	
-	if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
+	if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln);
 
 	if (remark) fprint(ERROUT, "%s ", remark);
 

lang/m2/comp/f_info.h

@@ -3,7 +3,7 @@
 /* $Header$ */
 
 struct f_info {
-	unsigned int f_lineno;
+	unsigned short f_lineno;
 	char *f_filename;
 	char *f_workingdir;
 };

lang/m2/comp/main.c

@@ -140,7 +140,7 @@ AddStandards()
 {
 	register struct def *df;
 	struct def *Enter();
-	static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0, 0}};
+	static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0}};
 
 	(void) Enter("ABS", D_PROCEDURE, std_type, S_ABS);
 	(void) Enter("CAP", D_PROCEDURE, std_type, S_CAP);

lang/m2/comp/node.H

@@ -24,7 +24,6 @@ struct node {
 #define nd_lab		nd_token.tk_data.tk_lab
 #define nd_symb		nd_token.tk_symb
 #define nd_lineno	nd_token.tk_lineno
-#define nd_filename	nd_token.tk_filename
 #define nd_IDF		nd_token.TOK_IDF
 #define nd_STR		nd_token.TOK_STR
 #define nd_SLE		nd_token.TOK_SLE

lang/m2/comp/node.c

@@ -43,8 +43,8 @@ FreeNode(nd)
 		list
 	*/
 	if (!nd) return;
-	if (nd->nd_left) FreeNode(nd->nd_left);
-	if (nd->nd_right) FreeNode(nd->nd_right);
+	FreeNode(nd->nd_left);
+	FreeNode(nd->nd_right);
 	free_node(nd);
 }
 

lang/m2/comp/type.H

@@ -29,11 +29,8 @@ struct subrange {
 
 struct array {
 	struct type *ar_elem;	/* Type of elements */
-	arith ar_lb, ar_ub;	/* Lower bound and upper bound */
 	label ar_descr;		/* Label of array descriptor */
 #define arr_elem	tp_value.tp_arr.ar_elem
-#define arr_lb		tp_value.tp_arr.ar_lb
-#define arr_ub		tp_value.tp_arr.ar_ub
 #define arr_descr	tp_value.tp_arr.ar_descr
 };
 

lang/m2/comp/type.c

@@ -387,15 +387,11 @@ ArraySizes(tp)
 	*/
 	switch(index_type->tp_fund) {
 	case T_SUBRANGE:
-		tp->arr_lb = index_type->sub_lb;
-		tp->arr_ub = index_type->sub_ub;
 		tp->tp_size = elem_size *
 			(index_type->sub_ub - index_type->sub_lb + 1);
 		break;
 	case T_CHAR:
 	case T_ENUMERATION:
-		tp->arr_lb = 0;
-		tp->arr_ub = index_type->enm_ncst - 1;
 		tp->tp_size = elem_size * index_type->enm_ncst;
 		break;
 	default:
@@ -453,6 +449,8 @@ lcm(m, n)
 DumpType(tp)
 	register struct type *tp;
 {
+	if (!tp) return;
+
 	print(" a:%d; s:%ld;", tp->tp_align, (long) tp->tp_size);
 	if (tp->next && tp->tp_fund != T_POINTER) {
 		/* Avoid printing recursive types!
@@ -501,9 +499,11 @@ DumpType(tp)
 		break;
 		}
 	case T_ARRAY:
-		print("ARRAY %ld-%ld", (long) tp->arr_lb, (long) tp->arr_ub);
+		print("ARRAY");
 		print("; el:");
 		DumpType(tp->arr_elem);
+		print("; index:");
+		DumpType(tp->next);
 		break;
 	case T_STRING:
 		print("STRING"); break;

lang/m2/comp/typequiv.c

@@ -128,11 +128,12 @@ TstCompat(tp1, tp2)
 
 int
 TstAssCompat(tp1, tp2)
-	struct type *tp1, *tp2;
+	register struct type *tp1, *tp2;
 {
 	/*	Test if two types are assignment compatible.
 		See Def 9.1.
 	*/
+	register struct type *tp;
 
 	if (TstCompat(tp1, tp2)) return 1;
 
@@ -145,11 +146,16 @@ TstAssCompat(tp1, tp2)
 	if (tp1 == char_type && tp2 == charc_type) return 1;
 
 	if (tp1->tp_fund == T_ARRAY) {
+		/* check for string
+		*/
 		arith size;
 
-		if (! tp1->next) return 0;
+		if (!(tp = tp1->next)) return 0;
 
-		size = tp1->arr_ub - tp1->arr_lb + 1;
+		if (tp->tp_fund == T_SUBRANGE) {
+			size = tp->sub_ub - tp->sub_lb + 1;
+		}
+		else	size = tp->enm_ncst;
 	    	tp1 = tp1->arr_elem;
 		if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
 	    	return

lang/m2/comp/walk.c

@@ -69,10 +69,12 @@ WalkModule(module)
 		Also generate code for its body.
 	*/
 	register struct def *df = module->mod_vis->sc_scope->sc_def;
+	register struct scope *sc;
 	struct scopelist *vis;
 
 	vis = CurrVis;
 	CurrVis = module->mod_vis;
+	sc = CurrentScope;
 
 	if (!proclevel && module != Defined) {
 		/* This module is a local module, but not within a
@@ -80,12 +82,12 @@ WalkModule(module)
 		   variables. This is done by generating a "bss",
 		   with label "_<modulenumber><modulename>".
 		*/
-		arith size = align(CurrentScope->sc_off, word_align);
+		arith size = align(sc->sc_off, word_align);
 
 		if (size == 0) size = word_size;
 		/* WHY ??? because we generated an INA for it ??? */
 
-		C_df_dnam(&(CurrentScope->sc_name[1]));
+		C_df_dnam(&(sc->sc_name[1]));
 		C_bss_cst(size, (arith) 0, 0);
 	}
 	else if (CurrVis == Defined->mod_vis) {
@@ -104,22 +106,22 @@ WalkModule(module)
 
 	/* Now, walk through it's local definitions
 	*/
-	WalkDef(CurrentScope->sc_def);
+	WalkDef(sc->sc_def);
 
 	/* Now, generate initialization code for this module.
 	   First call initialization routines for modules defined within
 	   this module.
 	*/
-	CurrentScope->sc_off = 0;
+	sc->sc_off = 0;
 	instructionlabel = 2;
 	func_type = 0;
-	C_pro_narg(CurrentScope->sc_name);
+	C_pro_narg(sc->sc_name);
 	DoProfil();
-	MkCalls(CurrentScope->sc_def);
+	MkCalls(sc->sc_def);
 	WalkNode(module->mod_body, (label) 0);
 	C_df_ilb((label) 1);
 	C_ret(0);
-	C_end(-CurrentScope->sc_off);
+	C_end(-sc->sc_off);
 	TmpClose();
 
 	CurrVis = vis;
@@ -132,20 +134,22 @@ WalkProcedure(procedure)
 		local definitions
 	*/
 	struct scopelist *vis = CurrVis;
+	register struct scope *sc;
 
 	proclevel++;
 	CurrVis = procedure->prc_vis;
+	sc = CurrentScope;
 	
-	WalkDef(CurrentScope->sc_def);
+	WalkDef(sc->sc_def);
 
 	/* Generate code for this procedure
 	*/
-	C_pro_narg(CurrentScope->sc_name);
+	C_pro_narg(sc->sc_name);
 	DoProfil();
 	/* generate calls to initialization routines of modules defined within
 	   this procedure
 	*/
-	MkCalls(CurrentScope->sc_def);
+	MkCalls(sc->sc_def);
 	return_expr_occurred = 0;
 	instructionlabel = 2;
 	func_type = procedure->df_type->next;
@@ -158,7 +162,7 @@ node_error(procedure->prc_body,"function procedure does not return a value");
 		C_ret((int) align(func_type->tp_size, word_align));
 	}
 	else	C_ret(0);
-	C_end(-CurrentScope->sc_off);
+	C_end(-sc->sc_off);
 	TmpClose();
 	CurrVis = vis;
 	proclevel--;
@@ -215,7 +219,7 @@ WalkNode(nd, lab)
 }
 
 WalkStat(nd, lab)
-	register struct node *nd;
+	struct node *nd;
 	label lab;
 {
 	/*	Walk through a statement, generating code for it.
@@ -224,8 +228,7 @@ WalkStat(nd, lab)
 	*/
 	register struct node *left = nd->nd_left;
 	register struct node *right = nd->nd_right;
-
-	if (options['p']) C_lin((arith) nd->nd_lineno);
+	register struct desig *pds = &Desig;
 
 	if (!nd) {
 		/* Empty statement
@@ -233,6 +236,8 @@ WalkStat(nd, lab)
 		return;
 	}
 
+	if (options['p']) C_lin((arith) nd->nd_lineno);
+
 	if (nd->nd_class == Call) {
 		if (chk_call(nd)) CodeCall(nd);
 		return;
@@ -253,7 +258,7 @@ WalkStat(nd, lab)
 			break;
 		}
 
-		CodeAssign(nd, &ds, &Desig);
+		CodeAssign(nd, &ds, pds);
 		}
 		break;
 
@@ -341,16 +346,16 @@ WalkStat(nd, lab)
 			wds.w_next = WithDesigs;
 			WithDesigs = &wds;
 			wds.w_scope = left->nd_type->rec_scope;
-			if (Desig.dsg_kind != DSG_PFIXED) {
+			if (pds->dsg_kind != DSG_PFIXED) {
 				/* In this case, we use a temporary variable
 				*/
-				CodeAddress(&Desig);
-				Desig.dsg_kind = DSG_FIXED;
+				CodeAddress(pds);
+				pds->dsg_kind = DSG_FIXED;
 				/* Only for the store ... */
-				Desig.dsg_offset = tmp = NewPtr();
-				Desig.dsg_name = 0;
-				CodeStore(&Desig, pointer_size);
-				Desig.dsg_kind = DSG_PFIXED;
+				pds->dsg_offset = tmp = NewPtr();
+				pds->dsg_name = 0;
+				CodeStore(pds, pointer_size);
+				pds->dsg_kind = DSG_PFIXED;
 				/* the record is indirectly available */
 			}
 			wds.w_desig = Desig;
@@ -390,7 +395,7 @@ node_error(right, "type incompatibility in RETURN statement");
 }
 
 ExpectBool(nd, true_label, false_label)
-	struct node *nd;
+	register struct node *nd;
 	label true_label, false_label;
 {
 	/*	"nd" must indicate a boolean expression. Check this and