Initial revision

util/ego/cs/cs_avail.c

@@ -0,0 +1,203 @@
+/* M O D U L E   F O R   A C C E S S S I N G   T H E   L I S T
+ *
+ * O F   A V A I L A B L E   E X P R E S S I O N S
+ */
+
+#include "../../../h/em_mnem.h"
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/aux.h"
+#include "../share/lset.h"
+#include "../share/global.h"
+#include "cs.h"
+#include "cs_aux.h"
+#include "cs_debug.h"
+#include "cs_alloc.h"
+#include "cs_getent.h"
+
+avail_p avails; /* The list of available expressions. */
+
+STATIC bool commutative(instr)
+	int instr;
+{
+	/* Is instr a commutative operator? */
+
+	switch (instr) {
+		case op_adf: case op_adi: case op_adu: case op_and:
+		case op_cms: case op_ior: case op_mlf: case op_mli:
+		case op_mlu:
+			return TRUE;
+		default:
+			return FALSE;
+	}
+}
+
+STATIC bool same_avail(kind, avp1, avp2)
+	byte kind;
+	avail_p avp1, avp2;
+{
+	/* Two expressions are the same if they have the same operator,
+	 * the same size, and their operand(s) have the same value. 
+	 * Only if the operator is commutative, the order of the operands
+	 * does not matter.
+	 */
+	if (avp1->av_instr != avp2->av_instr) return FALSE;
+	if (avp1->av_size != avp2->av_size) return FALSE;
+
+	switch (kind) {
+		default:
+			assert(FALSE);
+			break;
+		case EXPENSIVE_LOAD:
+		case UNAIR_OP:
+			return	avp1->av_operand == avp2->av_operand;
+		case BINAIR_OP:
+			if (commutative(avp1->av_instr & BMASK))
+				return	avp1->av_oleft == avp2->av_oleft &&
+					avp1->av_oright == avp2->av_oright
+					||
+					avp1->av_oleft == avp2->av_oright &&
+					avp1->av_oright == avp2->av_oleft
+					;
+			else
+				return	avp1->av_oleft == avp2->av_oleft &&
+					avp1->av_oright == avp2->av_oright;
+		case TERNAIR_OP:
+			return	avp1->av_ofirst == avp2->av_ofirst &&
+				avp1->av_osecond == avp2->av_osecond &&
+				avp1->av_othird == avp2->av_othird;
+	}
+	/* NOTREACHED */
+}
+
+STATIC check_local(avp)
+	avail_p avp;
+{
+	/* Check if the local in which the result of avp was stored,
+	 * still holds this result. Update if not.
+	 */
+	if (avp->av_saveloc == (entity_p) 0) return; /* Nothing to check. */
+
+	if (avp->av_saveloc->en_vn != avp->av_result) {
+		OUTTRACE("save local changed value", 0);
+		avp->av_saveloc = (entity_p) 0;
+	}
+}
+
+STATIC entity_p result_local(size, l)
+	offset size;
+	line_p l;
+{
+	/* If the result of an expression of size bytes is stored into a
+	 * local for which a registermessage was generated, return a pointer
+	 * to this local.
+	 */
+	line_p dummy;
+	entity_p enp;
+
+	if (l == (line_p) 0)
+		return (entity_p) 0;
+
+	if (INSTR(l)==op_stl && size==ws || INSTR(l)==op_sdl && size==2*ws) {
+		enp = getentity(l, &dummy);
+		if (is_regvar(enp->en_loc)) {
+			OUTTRACE("save local found, %D(LB)", enp->en_loc);
+			return enp;
+		}
+	}
+
+	return (entity_p) 0;
+}
+
+STATIC copy_avail(kind, src, dst)
+	int kind;
+	avail_p src, dst;
+{
+	/* Copy some attributes from src to dst. */
+
+	dst->av_instr = src->av_instr;
+	dst->av_size = src->av_size;
+
+	switch (kind) {
+		default:
+			assert(FALSE);
+			break;
+		case EXPENSIVE_LOAD:
+		case UNAIR_OP:
+			dst->av_operand = src->av_operand;
+			break;
+		case BINAIR_OP:
+			dst->av_oleft = src->av_oleft;
+			dst->av_oright = src->av_oright;
+			break;
+		case TERNAIR_OP:
+			dst->av_ofirst = src->av_ofirst;
+			dst->av_osecond = src->av_osecond;
+			dst->av_othird = src->av_othird;
+			break;
+	}
+}
+
+avail_p av_enter(avp, ocp, kind)
+	avail_p avp;
+	occur_p ocp;
+	int kind;
+{
+	/* Put the available expression avp in the list,
+	 * if it is not already there.
+	 * Add ocp to the set of occurrences of this expression.
+	 */
+	register avail_p ravp;
+	line_p last = ocp->oc_llast;
+
+	for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
+		if (same_avail(kind, ravp, avp)) { /* It was there. */
+			Ladd(ocp, &ravp->av_occurs);
+			/* Can we still use the local in which
+			 * the result was stored?
+			 */
+			check_local(ravp);
+			return ravp;
+		}
+	}
+	/* A new available axpression. */
+	ravp = newavail();
+
+	/* Remember local, if any, that holds result. */
+	if (avp->av_instr != (byte) INSTR(last)) {
+		/* Only possible when instr is the implicit AAR in 
+		 * a LAR or SAR.
+		 */
+		ravp->av_saveloc = (entity_p) 0;
+	} else {
+		ravp->av_saveloc = result_local(avp->av_size, last->l_next);
+	}
+	ravp->av_found = last;
+	ravp->av_result = kind == EXPENSIVE_LOAD? avp->av_operand: newvalnum();
+	copy_avail(kind, avp, ravp);
+	oldoccur(ocp);
+	ravp->av_before = avails;
+	avails = ravp;
+	return ravp;
+}
+
+clr_avails()
+{
+	/* Throw away the information about the available expressions. */
+
+	register avail_p ravp, next;
+	register Lindex i;
+	register lset s;
+
+	for (ravp = avails; ravp != (avail_p) 0; ravp = next) {
+		next = ravp->av_before;
+
+		s = ravp->av_occurs;
+		for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i, s)) {
+			oldoccur(occ_elem(i));
+		}
+		Ldeleteset(s);
+		oldavail(ravp);
+	}
+	avails = (avail_p) 0;
+}

util/ego/cs/cs_elim.c

@@ -0,0 +1,283 @@
+#include "../../../h/em_reg.h"
+#include "../../../h/em_mnem.h"
+#include "../share/types.h"
+#include "../share/alloc.h"
+#include "../share/lset.h"
+#include "../share/aux.h"
+#include "../share/global.h"
+#include "../share/debug.h"
+#include "cs.h"
+#include "cs_avail.h"
+#include "cs_alloc.h"
+#include "cs_aux.h"
+#include "cs_debug.h"
+#include "cs_profit.h"
+#include "cs_partit.h"
+#include "cs_debug.h"
+
+STATIC dlink(l1, l2)
+	line_p l1, l2;
+{
+	/* Doubly link the lines in l1 and l2. */
+
+	if (l1 != (line_p) 0)
+		l1->l_next = l2;
+	if (l2 != (line_p) 0)
+		l2->l_prev = l1;
+}
+
+STATIC remove_lines(first, last)
+	line_p first, last;
+{
+	/* Throw away the lines between and including first and last.
+	 * Don't worry about any pointers; the (must) have been taken care of.
+	 */
+	register line_p lnp, next;
+
+	last->l_next = (line_p) 0; /* Delimit the list. */
+	for (lnp = first; lnp != (line_p) 0; lnp = next) {
+		next = lnp->l_next;
+		oldline(lnp);
+	}
+}
+
+STATIC bool contained(ocp1, ocp2)
+	occur_p ocp1, ocp2;
+{
+	/* Determine whether ocp1 is contained within ocp2. */
+
+	register line_p lnp, next;
+
+	for (lnp = ocp2->oc_lfirst; lnp != (line_p) 0; lnp = next) {
+		next = lnp != ocp2->oc_llast ? lnp->l_next : (line_p) 0;
+
+		if (lnp == ocp1->oc_llast) return TRUE;
+	}
+	return FALSE;
+}
+
+STATIC delete(ocp, start)
+	occur_p ocp;
+	avail_p start;
+{
+	/* Delete all occurrences that are contained within ocp.
+	 * They must have been entered in the list before start:
+	 * if an expression is contained with an other, its operator line
+	 * appears before the operator line of the other because EM-expressions
+	 * are postfix.
+	 */
+	register avail_p ravp;
+	register Lindex	i, next;
+
+	for (ravp = start; ravp != (avail_p) 0; ravp = ravp->av_before) {
+		for (i = Lfirst(ravp->av_occurs); i != (Lindex) 0; i = next) {
+			next = Lnext(i, ravp->av_occurs);
+
+			if (contained(occ_elem(i), ocp)) {
+				OUTTRACE("delete contained occurrence", 0);
+#				ifdef TRACE
+					SHOWOCCUR(occ_elem(i));
+#				endif
+				oldoccur(occ_elem(i));
+				Lremove(Lelem(i), &ravp->av_occurs);
+			}
+		}
+	}
+}
+
+STATIC complete_aar(lnp, instr, descr_vn)
+	line_p lnp;
+	int instr;
+	valnum descr_vn;
+{
+	/* Lnp is an instruction that loads the address of an array-element.
+	 * Instr tells us what effect we should achieve; load (instr is op_lar)
+	 * or store (instr is op_sar) this array-element. Descr_vn is the
+	 * valuenumber of the address of the descriptor of this array.
+	 * We append a loi or sti of the correct number of bytes.
+	 */
+	register line_p lindir;
+
+	lindir = int_line(array_elemsize(descr_vn));
+	lindir->l_instr = instr == op_lar ? op_loi : op_sti;
+	dlink(lindir, lnp->l_next);
+	dlink(lnp, lindir);
+}
+
+STATIC replace(ocp, tmp, avp)
+	occur_p ocp;
+	offset tmp;
+	avail_p avp;
+{
+	/* Replace the lines in the occurrence in ocp by a load of the
+	 * temporary with offset tmp.
+	 */
+	register line_p lol, first, last;
+
+	assert(avp->av_size == ws || avp->av_size == 2*ws);
+
+	first = ocp->oc_lfirst; last = ocp->oc_llast;
+
+	lol = int_line(tmp);
+	lol->l_instr = avp->av_size == ws ? op_lol : op_ldl;
+	dlink(lol, last->l_next);
+
+	if (first->l_prev == (line_p) 0) ocp->oc_belongs->b_start = lol;
+	dlink(first->l_prev, lol);
+
+	if (avp->av_instr == (byte) op_aar) {
+		/* There may actually be a LAR or a SAR instruction; in that
+		 * case we have to complete the array-instruction.
+		 */
+		register int instr = INSTR(last);
+
+		if (instr != op_aar) complete_aar(lol, instr, avp->av_othird);
+	}
+
+	/* Throw away the by now useless lines. */
+	remove_lines(first, last);
+}
+
+STATIC append(avp, tmp)
+	avail_p avp;
+	offset tmp;
+{
+	/* Avp->av_found points to a line with an operator in it. This 
+	 * routine emits a sequence of instructions that saves the result
+	 * in a local with offset tmp. In most cases we just append
+	 * avp->av_found with stl/sdl tmp and lol/ldl tmp depending on
+	 * avp->av_size. If however the operator is an aar contained
+	 * within a lar or sar, we must first generate the aar.
+	 */
+	register line_p stl, lol;
+
+	assert(avp->av_size == ws || avp->av_size == 2*ws);
+
+	stl = int_line(tmp);
+	stl->l_instr = avp->av_size == ws ? op_stl : op_sdl;
+	lol = int_line(tmp);
+	lol->l_instr = avp->av_size == ws ? op_lol : op_ldl;
+
+	dlink(lol, avp->av_found->l_next);
+	dlink(stl, lol);
+	dlink(avp->av_found, stl);
+
+	if (avp->av_instr == (byte) op_aar) {
+		register int instr = INSTR(avp->av_found);
+
+		if (instr != op_aar) {
+			complete_aar(lol, instr, avp->av_othird);
+			avp->av_found->l_instr = op_aar;
+		}
+	}
+}
+
+STATIC set_replace(avp, tmp)
+	avail_p avp;
+	offset tmp;
+{
+	/* Avp->av_occurs is now a set of occurrences, each of which will be
+	 * replaced by a reference to a local.
+	 * Each time we eliminate an expression, we delete from our
+	 * list those expressions that are physically contained in them,
+	 * because we cannot eliminate them again.
+	 */
+	register Lindex i;
+	register lset s = avp->av_occurs;
+
+	for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i, s)) {
+		OUTVERBOSE("eliminate duplicate", 0);
+		SHOWOCCUR(occ_elem(i));
+		Scs++;
+		delete(occ_elem(i), avp->av_before);
+		replace(occ_elem(i), tmp, avp);
+	}
+}
+
+STATIC int reg_score(enp)
+	entity_p enp;
+{
+	/* Enp is a local that will go into a register.
+	 * We return its score upto now.
+	 */
+	assert(is_regvar(enp->en_loc));
+	return regv_arg(enp->en_loc, 4);
+}
+
+STATIC line_p gen_mesreg(off, avp, pp)
+	offset off;
+	avail_p avp;
+	proc_p pp;
+{
+	/* Generate a register message for the local that will hold the
+	 * result of the expression in avp, at the appropriate place in
+	 * the procedure in pp.
+	 */
+	register line_p reg;
+
+	reg = reg_mes(off, (short) avp->av_size, regtype(avp->av_instr), 0);
+	appnd_line(reg, pp->p_start->b_start);
+
+	return reg;
+}
+
+STATIC change_score(mes, score)
+	line_p mes;
+	int score;
+{
+	/* Change the score in the register message in mes to score. */
+
+	register arg_p ap = ARG(mes);
+
+	ap = ap->a_next; /* Offset. */
+	ap = ap->a_next; /* Size. */
+	ap = ap->a_next; /* Type. */
+	ap = ap->a_next; /* Score. */
+
+	ap->a_a.a_offset = score;
+}
+
+eliminate(pp)
+	proc_p pp;
+{
+	/* Eliminate costly common subexpressions within procedure pp.
+	 * We scan the available expressions in - with respect to time found -
+	 * reverse order, to find largest first, e.g. `A + B + C' before
+	 * `A + B'.
+	 * We do not eliminate an expression when the size
+	 * is not one of ws or 2*ws, because then we cannot use lol or ldl.
+	 * Code is appended to the first occurrence of the expression
+	 * to store the result into a local.
+	 */
+	register avail_p ravp;
+	register int score;
+	register offset tmp;
+	register line_p mes;
+
+	for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
+
+		if (ravp->av_size != ws && ravp->av_size != 2*ws) continue;
+
+		if (ravp->av_saveloc == (entity_p) 0) {
+			/* We save it ourselves. */
+			score = 2; /* Stl and lol. */
+		} else {
+			score = reg_score(ravp->av_saveloc);
+		}
+		if (desirable(ravp)) {
+			score += Lnrelems(ravp->av_occurs);
+			OUTTRACE("temporary local score %d", score);
+			if (ravp->av_saveloc != (entity_p) 0) {
+				tmp = ravp->av_saveloc->en_loc;
+				mes = find_mesreg(tmp);
+				OUTVERBOSE("re-using %D(LB)", tmp);
+			} else {
+				tmp = tmplocal(pp, (int) ravp->av_size);
+				mes = gen_mesreg(tmp, ravp, pp);
+				append(ravp, tmp);
+			}
+			change_score(mes, score);
+			set_replace(ravp, tmp);
+		}
+	}
+}

util/ego/cs/cs_elim.h

@@ -0,0 +1,5 @@
+extern eliminate();	/* (proc_p pp)
+			 * Eliminate some of the recurrences of expressions
+			 * that were found by the valuenumbering
+			 * algorithm.
+			 */

util/ego/cs/cs_getent.c

@@ -0,0 +1,219 @@
+#include "../../../h/em_mnem.h"
+#include "../share/types.h"
+#include "../share/aux.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "cs.h"
+#include "cs_aux.h"
+#include "cs_entity.h"
+#include "cs_stack.h"
+
+#define WS1	0
+#define WS2	1
+#define PS	2
+#define ARGW	3
+#define ARDESC3	4
+
+STATIC struct inf_entity {
+	byte	inf_instr;	/* Key.				*/
+	byte	inf_used;	/* Kind of entity used by key.	*/
+	byte	inf_size;	/* Indication of the size.	*/
+} inf_table[] = {
+	op_adp,	ENAOFFSETTED,	PS,
+	op_dee,	ENEXTERNAL,	WS1,
+	op_del,	ENLOCAL,	WS1,
+	op_ine,	ENEXTERNAL,	WS1,
+	op_inl,	ENLOCAL,	WS1,
+	op_lae,	ENAEXTERNAL,	PS,
+	op_lal,	ENALOCAL,	PS,
+	op_lar,	ENARRELEM,	ARDESC3,
+	op_ldc,	ENCONST,	WS2,
+	op_lde,	ENEXTERNAL,	WS2,
+	op_ldf,	ENOFFSETTED,	WS2,
+	op_ldl,	ENLOCAL,	WS2,
+	op_lil,	ENINDIR,	WS1,
+	op_lim,	ENIGNMASK,	WS1,
+	op_loc,	ENCONST,	WS1,
+	op_loe,	ENEXTERNAL,	WS1,
+	op_lof,	ENOFFSETTED,	WS1,
+	op_loi,	ENINDIR,	ARGW,
+	op_lol,	ENLOCAL,	WS1,
+	op_lpi,	ENPROC,		PS,
+	op_lxa,	ENAARGBASE,	PS,
+	op_lxl,	ENALOCBASE,	PS,
+	op_sar,	ENARRELEM,	ARDESC3,
+	op_sde,	ENEXTERNAL,	WS2,
+	op_sdf,	ENOFFSETTED,	WS2,
+	op_sdl,	ENLOCAL,	WS2,
+	op_sil,	ENINDIR,	WS1,
+	op_ste,	ENEXTERNAL, 	WS1,
+	op_stf,	ENOFFSETTED,	WS1,
+	op_sti,	ENINDIR,	ARGW,
+	op_stl,	ENLOCAL,	WS1,
+	op_zer,	ENCONST,	ARGW,
+	op_zre,	ENEXTERNAL,	WS1,
+	op_zrf,	ENFZER,		ARGW,
+	op_zrl,	ENLOCAL,	WS1,
+	op_nop	/* Delimitor. */
+};
+
+#define INFKEY(ip)	(ip->inf_instr & BMASK)
+#define ENKIND(ip)	ip->inf_used
+#define SIZEINF(ip)	ip->inf_size
+
+STATIC struct inf_entity *getinf(n)
+	int n;
+{
+	struct inf_entity *ip;
+
+	for (ip = &inf_table[0]; INFKEY(ip) != op_nop; ip++) {
+		if (INFKEY(ip) == n) return ip;
+	}
+	return (struct inf_entity *) 0;
+}
+
+entity_p getentity(lnp, l_out)
+	line_p lnp, *l_out;
+{
+	/* Build the entities where lnp refers to, and enter them.
+	 * If a token needs to be popped, the first line that pushed
+	 * it is stored in *l_out.
+	 * The main entity lnp refers to, is returned.
+	 */
+	struct entity en;
+	struct token tk;
+	struct inf_entity *ip;
+	valnum vn;
+	offset indexsize;
+	struct token adesc, index, arbase;
+
+	*l_out = lnp;
+
+	/* Lor is a special case. */
+	if (INSTR(lnp) == op_lor) {
+		en.en_static = FALSE;
+		en.en_size = ps;
+		switch (off_set(lnp)) {
+			default:
+				assert(FALSE);
+				break;
+			case 0:
+				en.en_kind = ENLOCBASE;
+				break;
+			case 1:
+				return (entity_p) 0;
+			case 2:
+				en.en_kind = ENHEAPPTR;
+				break;
+		}
+		return en_enter(&en);
+	}
+
+	if ( (ip = getinf(INSTR(lnp))) == (struct inf_entity *) 0)
+		return (entity_p) 0; /* It does not refer to any entity. */
+
+	/* Lil and sil refer to two entities. */
+	if (INSTR(lnp) == op_lil || INSTR(lnp) == op_sil) {
+		en.en_static = FALSE;
+		en.en_kind = ENLOCAL;
+		en.en_size = ps; /* Local must be a pointer. */
+		en.en_loc = off_set(lnp);
+		vn = en_enter(&en)->en_vn;
+	}
+
+	en.en_static = FALSE;
+	en.en_kind = ENKIND(ip);
+
+	/* Fill in the size of the entity. */
+	switch (SIZEINF(ip)) {
+		default:
+			assert(FALSE);
+			break;
+		case WS1:
+			en.en_size = ws;
+			break;
+		case WS2:
+			en.en_size = 2*ws;
+			break;
+		case PS:
+			en.en_size = ps;
+			break;
+		case ARGW:
+			if (TYPE(lnp) != OPNO) {
+				en.en_size = off_set(lnp);
+			} else {
+				Pop(&tk, (offset) ws);
+				*l_out = tk.tk_lfirst;
+				en.en_size = UNKNOWN_SIZE;
+			}
+			break;
+		case ARDESC3:
+			assert(en.en_kind == ENARRELEM);
+			if (TYPE(lnp) != OPNO) {
+				indexsize = off_set(lnp);
+			} else {
+				Pop(&tk, (offset) ws);
+				indexsize = UNKNOWN_SIZE;
+			}
+			Pop(&adesc, (offset) ps);
+			en.en_adesc = adesc.tk_vn;
+			Pop(&index, indexsize);
+			en.en_index = index.tk_vn;
+			Pop(&arbase, (offset) ps);
+			en.en_arbase = arbase.tk_vn;
+			*l_out = arbase.tk_lfirst;
+			en.en_size = array_elemsize(adesc.tk_vn);
+			break;
+	}
+
+	/* Fill in additional information. */
+	switch (en.en_kind) {
+		case ENFZER:
+			en.en_static = TRUE;
+			break;
+		case ENCONST:
+			en.en_static = TRUE;
+			en.en_val = off_set(lnp);
+			break;
+		case ENALOCAL:
+			en.en_static = TRUE;
+		case ENLOCAL:
+			en.en_loc = off_set(lnp);
+			break;
+		case ENAEXTERNAL:
+			en.en_static = TRUE;
+		case ENEXTERNAL:
+			en.en_ext = OBJ(lnp);
+			break;
+		case ENINDIR:
+			if (INSTR(lnp) == op_loi || INSTR(lnp) == op_sti) {
+				Pop(&tk, (offset) ps);
+				*l_out = tk.tk_lfirst;
+				vn = tk.tk_vn;
+			}
+			en.en_ind = vn;
+			break;
+		case ENAOFFSETTED:
+			en.en_static = TRUE;
+		case ENOFFSETTED:
+			Pop(&tk, (offset) ps);
+			*l_out = tk.tk_lfirst;
+			en.en_base = tk.tk_vn;
+			en.en_off = off_set(lnp);
+			break;
+		case ENALOCBASE:
+		case ENAARGBASE:
+			en.en_static = TRUE;
+			en.en_levels = off_set(lnp);
+			break;
+		case ENPROC:
+			en.en_pro = PROC(lnp);
+			break;
+		case ENARRELEM:
+			/* We gathered the information in the previous switch.
+			 */
+			break;
+	}
+
+	return en_enter(&en);
+}

util/ego/cs/cs_partit.c

@@ -0,0 +1,371 @@
+/* Functions to partition the huge set of EM-instructions. */
+
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_reg.h"
+#include "../../../h/em_spec.h"
+#include "../share/types.h"
+#include "../share/aux.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "cs.h"
+#include "cs_stack.h"
+
+#define XXX	(-1)
+#define ARGW	0
+#define WS	1
+#define PS	2
+#define FEF	3
+#define FIF	4
+#define CVT	5
+
+#define ANY	0
+#define PTR	1
+#define FLT	2
+
+STATIC struct {
+    byte i_group;   /* Group of instruction. */
+    byte i_op1;		/* Indication of size of operand of unary operator. */
+			/* Idem for 1st operand of binary operator. */
+    byte i_op2;		/* Idem for 2nd operand of binary operator. */
+    byte i_av;		/* Idem for result of operators. */
+    byte i_regtype;	/* ANY, PTR, FLT. */
+} info[] = {
+		XXX,		XXX,	XXX,	XXX,	XXX,
+/* aar */	TERNAIR_OP,	XXX,	XXX,	PS,	PTR,
+/* adf */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	FLT,
+/* adi */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* adp */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	PTR,
+/* ads */	BINAIR_OP,	PS,	ARGW,	PS,	PTR,
+/* adu */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* and */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* asp */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* ass */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* beq */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* bge */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* bgt */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* ble */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* blm */	HOPELESS,	XXX,	XXX,	XXX,	XXX,
+/* bls */	HOPELESS,	XXX,	XXX,	XXX,	XXX,
+/* blt */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* bne */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* bra */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* cai */	SIDE_EFFECTS,	XXX,	XXX,	XXX,	XXX,
+/* cal */	SIDE_EFFECTS,	XXX,	XXX,	XXX,	XXX,
+/* cff */	TERNAIR_OP,	XXX,	XXX,	CVT,	FLT,
+/* cfi */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* cfu */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* cif */	TERNAIR_OP,	XXX,	XXX,	CVT,	FLT,
+/* cii */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* ciu */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* cmf */	BINAIR_OP,	ARGW,	ARGW,	WS,	ANY,
+/* cmi */	BINAIR_OP,	ARGW,	ARGW,	WS,	ANY,
+/* cmp */	BINAIR_OP,	PS,	PS,	WS,	ANY,
+/* cms */	BINAIR_OP,	ARGW,	ARGW,	WS,	ANY,
+/* cmu */	BINAIR_OP,	ARGW,	ARGW,	WS,	ANY,
+/* com */	UNAIR_OP,	ARGW,	XXX,	ARGW,	ANY,
+/* csa */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* csb */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* cuf */	TERNAIR_OP,	XXX,	XXX,	CVT,	FLT,
+/* cui */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* cuu */	TERNAIR_OP,	XXX,	XXX,	CVT,	ANY,
+/* dch */	UNAIR_OP,	PS,	XXX,	PS,	PTR,
+/* dec */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* dee */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX,
+/* del */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX,
+/* dup */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* dus */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* dvf */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	FLT,
+/* dvi */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* dvu */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* exg */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* fef */	UNAIR_OP,	ARGW,	XXX,	FEF,	XXX,
+/* fif */	BINAIR_OP,	ARGW,	ARGW,	FIF,	XXX,
+/* fil */	IGNORE,		XXX,	XXX,	XXX,	XXX,
+/* gto */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* inc */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* ine */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX,
+/* inl */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX,
+/* inn */	BINAIR_OP,	ARGW,	WS,	WS,	ANY,
+/* ior */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* lae */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lal */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lar */	LOAD_ARRAY,	XXX,	XXX,	XXX,	ANY,
+/* ldc */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lde */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* ldf */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	ANY,
+/* ldl */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lfr */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* lil */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lim */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lin */	IGNORE,		XXX,	XXX,	XXX,	XXX,
+/* lni */	IGNORE,		XXX,	XXX,	XXX,	XXX,
+/* loc */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* loe */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lof */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	ANY,
+/* loi */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	ANY,
+/* lol */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lor */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* los */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* lpb */	UNAIR_OP,	PS,	XXX,	PS,	PTR,
+/* lpi */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* lxa */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	PTR,
+/* lxl */	EXPENSIVE_LOAD,	XXX,	XXX,	XXX,	PTR,
+/* mlf */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	FLT,
+/* mli */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* mlu */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* mon */	HOPELESS,	XXX,	XXX,	XXX,	XXX,
+/* ngf */	UNAIR_OP,	ARGW,	XXX,	ARGW,	FLT,
+/* ngi */	UNAIR_OP,	ARGW,	XXX,	ARGW,	ANY,
+/* nop */	IGNORE,		XXX,	XXX,	XXX,	XXX,
+/* rck */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* ret */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* rmi */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* rmu */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* rol */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* ror */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* rtt */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* sar */	STORE_ARRAY,	XXX,	XXX,	XXX,	XXX,
+/* sbf */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	FLT,
+/* sbi */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* sbs */	BINAIR_OP,	PS,	PS,	ARGW,	ANY,
+/* sbu */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* sde */	STORE_DIRECT,	XXX,	XXX,	XXX,	XXX,
+/* sdf */	STORE_INDIR,	XXX,	XXX,	XXX,	XXX,
+/* sdl */	STORE_DIRECT,	XXX,	XXX,	XXX,	XXX,
+/* set */	UNAIR_OP,	WS,	XXX,	ARGW,	ANY,
+/* sig */	FIDDLE_STACK,	XXX,	XXX,	XXX,	XXX,
+/* sil */	STORE_INDIR,	XXX,	XXX,	XXX,	XXX,
+/* sim */	STORE_DIRECT,	XXX,	XXX,	XXX,	XXX,
+/* sli */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* slu */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* sri */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* sru */	BINAIR_OP,	ARGW,	WS,	ARGW,	ANY,
+/* ste */	STORE_DIRECT,	XXX,	XXX,	XXX,	XXX,
+/* stf */	STORE_INDIR,	XXX,	XXX,	XXX,	XXX,
+/* sti */	STORE_INDIR,	XXX,	XXX,	XXX,	XXX,
+/* stl */	STORE_DIRECT,	XXX,	XXX,	XXX,	XXX,
+/* str */	HOPELESS,	XXX,	XXX,	XXX,	XXX,
+/* sts */	HOPELESS,	XXX,	XXX,	XXX,	XXX,
+/* teq */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* tge */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* tgt */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* tle */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* tlt */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* tne */	UNAIR_OP,	WS,	XXX,	WS,	ANY,
+/* trp */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* xor */	BINAIR_OP,	ARGW,	ARGW,	ARGW,	ANY,
+/* zeq */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zer */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* zge */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zgt */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zle */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zlt */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zne */	BBLOCK_END,	XXX,	XXX,	XXX,	XXX,
+/* zre */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX,
+/* zrf */	SIMPLE_LOAD,	XXX,	XXX,	XXX,	XXX,
+/* zrl */	KILL_ENTITY,	XXX,	XXX,	XXX,	XXX
+};
+
+#define GROUP(n)	(info[n].i_group)
+#define OP1SIZE(l)	(info[INSTR(l)].i_op1)
+#define OP2SIZE(l)	(info[INSTR(l)].i_op2)
+#define AVSIZE(l)	(info[INSTR(l)].i_av)
+#define REGTYPE(n)	(info[n].i_regtype)
+
+int instrgroup(lnp)
+	line_p lnp;
+{
+	if (INSTR(lnp) == op_lor && SHORT(lnp) == 1) {
+		/* We can't do anything with the stackpointer. */
+		return FIDDLE_STACK;
+	}
+	if (INSTR(lnp) < sp_fmnem || INSTR(lnp) > sp_lmnem) {
+		VI((short) INSTR(lnp));
+		return IGNORE;
+	}
+	return GROUP(INSTR(lnp));
+}
+
+bool stack_group(instr)
+	int instr;
+{
+	/* Is this an instruction that only does something to the top of
+	 * the stack?
+	 */
+	switch (GROUP(instr)) {
+		case SIMPLE_LOAD:
+		case EXPENSIVE_LOAD:
+		case LOAD_ARRAY:
+		case UNAIR_OP:
+		case BINAIR_OP:
+		case TERNAIR_OP:
+			return TRUE;
+		default:
+			return FALSE;
+	}
+}
+
+STATIC offset argw(lnp)
+	line_p lnp;
+{
+	/* Some EM-instructions have their argument either on the same line,
+	 * or on top of the stack. We give up when the argument is on top of
+	 * the stack.
+	 */
+	struct token dummy;
+
+	if (TYPE(lnp) != OPNO) {
+		return off_set(lnp);
+	} else {
+		Pop(&dummy, (offset) ws);
+		return UNKNOWN_SIZE;
+	}
+}
+
+offset op11size(lnp)
+	line_p lnp;
+{
+	/* Returns the size of the first argument of
+	 * the unary operator in lnp.
+	 */
+
+	switch (OP1SIZE(lnp)) {
+		case ARGW:
+			return argw(lnp);
+		case WS:
+			return ws;
+		case PS:
+			return ps;
+		default:
+			assert(FALSE);
+	}
+	/* NOTREACHED */
+}
+
+offset op12size(lnp)
+	line_p lnp;
+{
+	/* Same for first of binary. */
+
+	switch (OP1SIZE(lnp)) {
+		case ARGW:
+			return argw(lnp);
+		case PS:
+			return ps;
+		default:
+			assert(FALSE);
+	}
+	/* NOTREACHED */
+}
+
+offset op22size(lnp)
+	line_p lnp;
+{
+	switch (OP2SIZE(lnp)) {
+		case ARGW:
+			return argw(lnp);
+		case WS:
+			return ws;
+		case PS:
+			return ps;
+		default:
+			assert(FALSE);
+	}
+	/* NOTREACHED */
+}
+
+/* Ternary operators are op_aar and conversions between types and/or sizes. */
+
+offset op13size(lnp)
+	line_p lnp;
+{
+	/* When the instruction is a conversion, the size of the first
+	 * operand is the value of the second operand.
+	 * We only handle the most likely case, namely that the second operand
+	 * was pushed by a loc-instruction.
+	 */
+	if (INSTR(lnp) == op_aar) return ps;
+
+	if (lnp->l_prev != (line_p) 0 &&
+	    lnp->l_prev->l_prev != (line_p) 0 &&
+	    INSTR(lnp->l_prev->l_prev) == op_loc
+	   )
+		return off_set(lnp->l_prev->l_prev);
+	else
+		return UNKNOWN_SIZE;
+}
+
+offset op23size(lnp)
+	line_p lnp;
+{
+	if (INSTR(lnp) == op_aar)
+		return argw(lnp);
+	else
+		return ws;
+}
+
+offset op33size(lnp)
+	line_p lnp;
+{
+	if (INSTR(lnp) == op_aar)
+		return ps;
+	else
+		return ws;
+}
+
+offset avsize(lnp)
+	line_p lnp;
+{
+	/* Returns the size of the result of the instruction in lnp.
+	 * If the instruction is a conversion this size is given on the stack.
+	 * We only handle the case that this value was pushed by a loc.
+	 */
+	offset size;
+
+	switch (AVSIZE(lnp)) {
+		case ARGW:
+			return argw(lnp);
+		case WS:
+			return ws;
+		case PS:
+			return ps;
+		case FEF:
+			if ((size = argw(lnp)) != UNKNOWN_SIZE)
+				return size + ws;
+			else
+				return UNKNOWN_SIZE;
+		case FIF:
+			if ((size = argw(lnp)) != UNKNOWN_SIZE)
+				return size + size;
+			else
+				return UNKNOWN_SIZE;
+		case CVT:
+			if (lnp->l_prev != (line_p) 0 &&
+			    INSTR(lnp->l_prev) == op_loc
+			   )
+				return off_set(lnp->l_prev);
+			else
+				return UNKNOWN_SIZE;
+		default:
+			assert(FALSE);
+			break;
+	}
+	/* NOTREACHED */
+}
+
+int regtype(instr)
+	byte instr;
+{
+	switch (REGTYPE(instr & BMASK)) {
+		case ANY:
+			return reg_any;
+		case PTR:
+			return reg_pointer;
+		case FLT:
+			return reg_float;
+		default:
+			assert(FALSE);
+	}
+	/* NOTREACHED */
+}

util/ego/cs/cs_partit.h

@@ -0,0 +1,55 @@
+/* These routines partition the huge set of EM-instructions in
+ * "manageable chunks.
+ */
+
+extern int	instrgroup();	/* (line_p lnp)
+				 * Return the group into which the instruction
+				 * in lnp belongs to.
+				 */
+
+extern bool	stack_group();	/* (int instr)
+				 * Return whether instr is an instruction that
+				 * only changes the state of the stack, i.e.
+				 * is a "true" operator.
+				 */
+
+extern offset	op11size();	/* (line_p lnp)
+				 * Return the size of the operand of the unary
+				 * operator in lnp.
+				 */
+
+extern offset	op12size();	/* (line_p lnp)
+				 * Return the size of the first operand of the
+				 * binary operator in lnp.
+				 */
+
+extern offset	op22size();	/* (line_p lnp)
+				 * Return the size of the second operand of the
+				 * binary operator in lnp.
+				 */
+
+extern offset	op13size();	/* (line_p lnp)
+				 * Return the size of the first operand of the
+				 * ternary operator in lnp.
+				 */
+
+extern offset	op23size();	/* (line_p lnp)
+				 * Return the size of the second operand of the
+				 * ternary operator in lnp.
+				 */
+
+extern offset	op33size();	/* (line_p lnp)
+				 * Return the size of the third operand of the
+				 * ternary operator in lnp.
+				 */
+
+extern offset	avsize();	/* (line_p lnp)
+				 * Return the size of the result of the
+				 * operator in lnp.
+				 */
+
+extern int	regtype();	/* (byte instr)
+				 * Return in what kind of machine-register
+				 * the result of instr should be stored:
+				 * pointer, float, or any.
+				 */

util/ego/cs/cs_profit.c

@@ -0,0 +1,207 @@
+#include <stdio.h>
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/aux.h"
+#include "../share/cset.h"
+#include "../share/lset.h"
+#include "cs.h"
+#include "cs_aux.h"
+#include "cs_debug.h"
+#include "cs_avail.h"
+#include "cs_partit.h"
+
+STATIC cset	addr_modes;
+STATIC cset	cheaps;
+STATIC cset	forbidden;
+STATIC short	LX_threshold;
+STATIC short	AR_limit;
+STATIC bool	DO_sli;
+
+STATIC get_instrs(f, s_p)
+	FILE *f;
+	cset *s_p;
+{
+	/* Read a set of instructions from inputfile f into *s_p.
+	 * Such a set must be delimited by a number lower than
+	 * the number of the first EM mnemonic.
+	 */
+	Celem_t instr;
+
+	fscanf(f, "%d", &instr);
+	while (instr >= sp_fmnem) {
+		Cadd(instr, s_p);
+		fscanf(f, "%d", &instr);
+	}
+}
+
+STATIC choose_cset(f, s_p)
+	FILE *f;
+	cset *s_p;
+{
+	/* Read two compact sets of EM instructions from inputfile f.
+	 * Choose the first if we optimize with respect to time,
+	 * the second if we optimize with respect to space, as
+	 * indicated by time_space_ratio.
+	 */
+	cset cs1, cs2; /* Two dummy sets. */
+
+	*s_p = Cempty_set((short) sp_lmnem);
+
+	cs1 = Cempty_set((short) sp_lmnem);
+	get_instrs(f, &cs1);
+	cs2 = Cempty_set((short) sp_lmnem);
+	get_instrs(f, &cs2);
+
+	Ccopy_set(time_space_ratio >= 50 ? cs1 : cs2, s_p);
+
+	Cdeleteset(cs1); Cdeleteset(cs2);
+ }
+
+cs_machinit(f)
+	FILE *f;
+{
+	char s[100];
+	int time, space;
+
+	/* Find piece that is relevant for this phase. */
+	do {
+		while (getc(f) != '\n');
+		fscanf(f, "%s", s);
+	} while (strcmp(s, "%%CS"));
+
+	/* Choose a set of instructions which must only be eliminated
+	 * if they are at the root of another expression.
+	 */
+	choose_cset(f, &addr_modes);
+
+	/* Choose a set of cheap instructions; i.e. instructions that
+	 * are cheaper than a move to save the result of such an
+	 * instruction.
+	 */
+	choose_cset(f, &cheaps);
+
+	/* Read how many lexical levels back an LXL/LXA instruction
+	 * must at least look before it will be eliminated.
+	 */
+	fscanf(f, "%d %d", &time, &space);
+	LX_threshold = time_space_ratio >= 50 ? time : space;
+
+	/* Read what the size of an array-element may be,
+	 * before we think that it is to big to replace
+	 * a LAR/SAR of it by AAR LOI/STI <size>.
+	 */
+	fscanf(f, "%d", &space);
+	AR_limit = space;
+
+	/* Read whether we must eliminate an SLI instruction
+	 * when it is part of an array-index computation.
+	 */
+	fscanf(f, "%d %d", &time, &space);
+	DO_sli = time_space_ratio >= 50 ? time : space;
+
+	/* Read a set of instructions which we do not want to eliminate.
+	 * Note: only instructions need be given that may in principle
+	 * be eliminated, but for which better code can be generated
+	 * when they stay, and with which is not dealt in the common
+	 * decision routines.
+	 */
+	choose_cset(f, &forbidden);
+}
+
+STATIC bool is_index(lnp)
+	line_p lnp;
+{
+	/* Return whether the SLI-instruction in lnp is part of
+	 * an array-index computation.
+	 */
+	return	lnp->l_prev != (line_p) 0 && INSTR(lnp->l_prev) == op_loc &&
+		lnp->l_next != (line_p) 0 && INSTR(lnp->l_next) == op_ads;
+}
+
+STATIC bool gains(avp)
+	avail_p avp;
+{
+	/* Return whether we can gain something, when we eliminate
+	 * an expression such as in avp. We just glue together some
+	 * heuristics with some user-supplied stuff.
+	 */
+	if (Cis_elem(avp->av_instr & BMASK, forbidden))
+		return FALSE;
+
+	if (avp->av_instr == (byte) op_lxa || avp->av_instr == (byte) op_lxl)
+		return off_set(avp->av_found) >= LX_threshold;
+
+	if (avp->av_instr == (byte) op_sli)
+		return !is_index(avp->av_found) || DO_sli;
+
+	if (Cis_elem(avp->av_instr & BMASK, addr_modes))
+		return instrgroup(avp->av_found->l_prev) != SIMPLE_LOAD;
+
+	if (Cis_elem(avp->av_instr & BMASK, cheaps))
+		return avp->av_saveloc != (entity_p) 0;
+
+	return TRUE;
+}
+
+STATIC bool okay_lines(avp, ocp)
+	avail_p avp;
+	occur_p ocp;
+{
+	register line_p lnp, next;
+
+	for (lnp = ocp->oc_lfirst; lnp != (line_p) 0; lnp = next) {
+		next = lnp != ocp->oc_llast ? lnp->l_next : (line_p) 0;
+
+		if (INSTR(lnp) < sp_fmnem || INSTR(lnp) > sp_lmnem)
+			return FALSE;
+		if (!stack_group(INSTR(lnp))) {
+			/* Check for SAR-instruction. */
+			if (INSTR(lnp) != op_sar || next != (line_p) 0)
+				return FALSE;
+		}
+	}
+	/* All lines in this occurrence can in principle be eliminated;
+	 * no stores, messages, calls etc.
+	 * We now check whether it is desirable to treat a LAR or a SAR
+	 * as an AAR LOI/STI. This depends on the size of the array-elements.
+	 */
+	if (INSTR(ocp->oc_llast) == op_lar || INSTR(ocp->oc_llast) == op_sar) {
+		if (avp->av_instr == (byte) op_aar && time_space_ratio < 50) {
+			return array_elemsize(avp->av_othird) <= AR_limit;
+		}
+	}
+	return TRUE;
+}
+
+bool desirable(avp)
+	avail_p avp;
+{
+	register Lindex i, next;
+
+	if (!gains(avp)) {
+		OUTTRACE("no gain", 0);
+		SHOWAVAIL(avp);
+		return FALSE;
+	}
+
+	/* Walk through the occurrences to see whether it is okay to
+	 * eliminate them. If not, remove them from the set.
+	 */
+	for (i = Lfirst(avp->av_occurs); i != (Lindex) 0; i = next) {
+		next = Lnext(i, avp->av_occurs);
+
+		if (!okay_lines(avp, occ_elem(i))) {
+			OUTTRACE("may not eliminate", 0);
+#			ifdef TRACE
+				SHOWOCCUR(occ_elem(i));
+#			endif
+			oldoccur(occ_elem(i));
+			Lremove(Lelem(i), &avp->av_occurs);
+		}
+	}
+
+	return Lnrelems(avp->av_occurs) > 0;
+}

util/ego/cs/cs_vnm.c

@@ -0,0 +1,321 @@
+
+/* V A L U E N U M B E R I N G   M E T H O D */
+
+#include "../../../h/em_mnem.h"
+#include "../share/types.h"
+#include "../share/global.h"
+#include "../share/debug.h"
+#include "../share/aux.h"
+#include "cs.h"
+#include "cs_alloc.h"
+#include "cs_aux.h"
+#include "cs_entity.h"
+#include "cs_avail.h"
+#include "cs_stack.h"
+#include "cs_kill.h"
+#include "cs_partit.h"
+#include "cs_getent.h"
+
+STATIC push_entity(enp, lfirst)
+	entity_p enp;
+	line_p lfirst;
+{
+	/* Build token and Push it. */
+
+	struct token tk;
+
+	tk.tk_vn = enp->en_vn;
+	tk.tk_size = enp->en_size;
+	tk.tk_lfirst = lfirst;
+	Push(&tk);
+}
+
+STATIC put_expensive_load(bp, lnp, lfirst, enp)
+	bblock_p bp;
+	line_p lnp, lfirst;
+	entity_p enp;
+{
+	struct avail av;
+	occur_p	ocp;
+
+	av.av_instr = INSTR(lnp);
+	av.av_size = enp->en_size;
+	av.av_operand = enp->en_vn;
+
+	ocp = newoccur(lfirst, lnp, bp);
+
+	av_enter(&av, ocp, EXPENSIVE_LOAD);
+}
+
+STATIC put_aar(bp, lnp, lfirst, enp)
+	bblock_p bp;
+	line_p lnp, lfirst;
+	entity_p enp;
+{
+	/* Enp points to an ENARRELEM. We do as if its address was computed. */
+
+	struct avail av;
+	occur_p	ocp;
+
+	assert(enp->en_kind == ENARRELEM);
+	av.av_instr = op_aar;
+	av.av_size = ps;
+	av.av_ofirst = enp->en_arbase;
+	av.av_osecond = enp->en_index;
+	av.av_othird = enp->en_adesc;
+
+	ocp = newoccur(lfirst, lnp, bp);
+
+	av_enter(&av, ocp, TERNAIR_OP);
+}
+
+STATIC push_avail(avp, lfirst)
+	avail_p avp;
+	line_p lfirst;
+{
+	struct token tk;
+
+	tk.tk_vn = avp->av_result;
+	tk.tk_size = avp->av_size;
+	tk.tk_lfirst = lfirst;
+	Push(&tk);
+}
+
+STATIC push_unair_op(bp, lnp, tkp1)
+	bblock_p bp;
+	line_p lnp;
+	token_p tkp1;
+{
+	struct avail av;
+	occur_p	ocp;
+
+	av.av_instr = INSTR(lnp);
+	av.av_size = avsize(lnp);
+	av.av_operand = tkp1->tk_vn;
+
+	ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
+
+	push_avail(av_enter(&av, ocp, UNAIR_OP), tkp1->tk_lfirst);
+}
+
+STATIC push_binair_op(bp, lnp, tkp1, tkp2)
+	bblock_p bp;
+	line_p lnp;
+	token_p tkp1, tkp2;
+{
+	struct avail av;
+	occur_p	ocp;
+
+	av.av_instr = INSTR(lnp);
+	av.av_size = avsize(lnp);
+	av.av_oleft = tkp1->tk_vn;
+	av.av_oright = tkp2->tk_vn;
+
+	ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
+
+	push_avail(av_enter(&av, ocp, BINAIR_OP), tkp1->tk_lfirst);
+}
+
+STATIC push_ternair_op(bp, lnp, tkp1, tkp2, tkp3)
+	bblock_p bp;
+	line_p lnp;
+	token_p tkp1, tkp2, tkp3;
+{
+	struct avail av;
+	occur_p	ocp;
+
+	av.av_instr = INSTR(lnp);
+	av.av_size = avsize(lnp);
+	av.av_ofirst = tkp1->tk_vn;
+	av.av_osecond = tkp2->tk_vn;
+	av.av_othird = tkp3->tk_vn;
+
+	ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
+
+	push_avail(av_enter(&av, ocp, TERNAIR_OP), tkp1->tk_lfirst);
+}
+
+STATIC fiddle_stack(lnp)
+	line_p lnp;
+{
+	/* The instruction in lnp does something to the valuenumber-stack. */
+
+	struct token dummy;
+	offset size;
+
+	/* Partly initialize dummy. */
+	dummy.tk_lfirst = lnp;
+
+	switch (INSTR(lnp)) {
+		default:
+			assert(FALSE);
+			break;
+		case op_lor:
+			dummy.tk_vn = newvalnum(); dummy.tk_size = ps;
+			Push(&dummy);
+			break;
+		case op_asp:
+			if ((size = off_set(lnp)) > 0) {
+				Pop(&dummy, size);
+			} else {
+				dummy.tk_vn = newvalnum();
+				dummy.tk_size = size;
+				Push(&dummy);
+			}
+			break;
+		case op_dup:
+			Dup(lnp);
+			break;
+		case op_ass:
+		case op_dus:
+		case op_exg:
+		case op_los:
+			/* Don't waste effort. */
+			clr_stack();
+			break;
+		case op_sig:
+			Pop(&dummy, (offset) ps);
+			break;
+		case op_lfr:
+			dummy.tk_vn = newvalnum();
+			dummy.tk_size = off_set(lnp);
+			Push(&dummy);
+			break;
+	}
+}
+
+STATIC proc_p find_proc(vn)
+	valnum vn;
+{
+	/* Find the procedure-identifier with valuenumber vn. */
+
+	entity_p enp;
+
+	enp = find_entity(vn);
+
+	if (enp != (entity_p) 0 && enp->en_kind == ENPROC)
+		return enp->en_pro;
+
+	return (proc_p) 0;
+}
+
+STATIC side_effects(lnp)
+	line_p lnp;
+{
+	/* Lnp contains a cai or cal instruction. We try to find the callee
+	 * and see what side-effects it has.
+	 */
+	struct token tk;
+	proc_p pp;
+
+	if (INSTR(lnp) == op_cai) {
+		Pop(&tk, (offset) ps);
+		pp = find_proc(tk.tk_vn);
+	} else {
+		assert(INSTR(lnp) == op_cal);
+		pp = PROC(lnp);
+	}
+	if (pp != (proc_p) 0) {
+		kill_call(pp);
+	} else {
+		kill_much();
+	}
+}
+
+hopeless(instr)
+	int instr;
+{
+	/* The effect of `instr' is too difficult to
+	 * compute. We assume worst case behaviour.
+	 */
+	switch (instr) {
+		default:
+			assert(FALSE);
+			break;
+		case op_mon:
+		case op_str:
+			/* We can't even trust "static" entities. */
+			kill_all();
+			clr_stack();
+			break;
+		case op_blm:
+		case op_bls:
+		case op_sts:
+			kill_much();
+			clr_stack();
+			break;
+	}
+}
+
+vnm(bp)
+	bblock_p bp;
+{
+	register line_p lnp;
+	register entity_p rep;
+	line_p lfirst;
+	struct token tk, tk1, tk2, tk3;
+
+	for (lnp = bp->b_start; lnp != (line_p) 0; lnp = lnp->l_next) {
+
+		rep = getentity(lnp, &lfirst);
+		switch (instrgroup(lnp)) {
+			case SIMPLE_LOAD:	
+				push_entity(rep, lfirst);
+				break;
+			case LOAD_ARRAY:
+				put_aar(bp, lnp, lfirst, rep);
+				/* Fall through ... */
+			case EXPENSIVE_LOAD:
+				push_entity(rep, lfirst);
+				put_expensive_load(bp, lnp, lfirst, rep);
+				break;
+			case STORE_DIRECT:
+				kill_direct(rep);
+				Pop(&tk, rep->en_size);
+				rep->en_vn = tk.tk_vn;
+				break;
+			case STORE_ARRAY:
+				put_aar(bp, lnp, lfirst, rep);
+				/* Fall through ... */
+			case STORE_INDIR:
+				kill_indir(rep);
+				Pop(&tk, rep->en_size);
+				rep->en_vn = tk.tk_vn;
+				break;
+			case UNAIR_OP:
+				Pop(&tk1, op11size(lnp));
+				push_unair_op(bp, lnp, &tk1);
+				break;
+			case BINAIR_OP:
+				Pop(&tk2, op22size(lnp));
+				Pop(&tk1, op12size(lnp));
+				push_binair_op(bp, lnp, &tk1, &tk2);
+				break;
+			case TERNAIR_OP:
+				Pop(&tk3, op33size(lnp));
+				Pop(&tk2, op23size(lnp));
+				Pop(&tk1, op13size(lnp));
+				push_ternair_op(bp, lnp, &tk1, &tk2, &tk3);
+				break;
+			case KILL_ENTITY:
+				kill_direct(rep);
+				break;
+			case SIDE_EFFECTS:
+				side_effects(lnp);
+				break;
+			case FIDDLE_STACK:
+				fiddle_stack(lnp);
+				break;
+			case IGNORE:
+				break;
+			case HOPELESS:
+				hopeless(INSTR(lnp));
+				break;
+			case BBLOCK_END:
+				break;
+			default:
+				assert(FALSE);
+				break;
+		}
+	}
+}