bal 40 anni fa
parent
commit
1833451151

+ 42 - 0
util/ego/ca/Makefile

@@ -0,0 +1,42 @@
+EMH=../../../h
+EML=../../../lib
+CFLAGS=
+SHARE=../share
+CA=.
+OBJECTS=ca.o ca_put.o
+SHOBJECTS=$(SHARE)/get.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/aux.o $(SHARE)/debug.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/files.o $(SHARE)/map.o
+SRC=ca.h ca_put.h ca.c ca_put.c
+
+.c.o:
+	cc $(CFLAGS) -c $<
+all:	$(OBJECTS)
+ca: \
+	$(OBJECTS) $(SHOBJECTS)
+	 cc -o ca -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
+lpr:
+	pr $(SRC) | lpr
+dumpflop:
+	tar -uf /mnt/ego/ca/ca.tarf $(SRC) Makefile
+# the next lines are generated automatically
+# AUTOAUTOAUTOAUTOAUTOAUTO
+ca.o:	../share/alloc.h
+ca.o:	../share/debug.h
+ca.o:	../share/files.h
+ca.o:	../share/get.h
+ca.o:	../share/global.h
+ca.o:	../share/lset.h
+ca.o:	../share/map.h
+ca.o:	../share/types.h
+ca.o:	ca.h
+ca.o:	ca_put.h
+ca_put.o:	../../../h/em_flag.h
+ca_put.o:	../../../h/em_mes.h
+ca_put.o:	../../../h/em_mnem.h
+ca_put.o:	../../../h/em_pseu.h
+ca_put.o:	../../../h/em_spec.h
+ca_put.o:	../share/alloc.h
+ca_put.o:	../share/debug.h
+ca_put.o:	../share/def.h
+ca_put.o:	../share/map.h
+ca_put.o:	../share/types.h
+ca_put.o:	ca.h

+ 199 - 0
util/ego/ca/ca.c

@@ -0,0 +1,199 @@
+/*
+ *  C O M P A C T   A S S E M B L Y   L A N G U A G E   G E N E R A T I O N
+ *
+ */
+
+
+#include <stdio.h>
+#include "../share/types.h"
+#include "ca.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/files.h"
+#include "../share/map.h"
+#include "../share/alloc.h"
+#include "../share/get.h"
+#include "ca_put.h"
+
+
+/* This phase transforms the Intermediate Code of the global optimizer
+ * to 'standard' compact assembly language, which will be processed
+ * by the code generator.
+ */
+
+
+short	dlength;
+dblock_p *dmap;
+
+char **dnames, **pnames;  /* Dynamically allocated arrays of strings.
+			 * pnames[i] contains a pointer to the name
+			 * of the procedure  with proc_id i.
+			 */
+
+
+
+STATIC int makedmap(dbl)
+	dblock_p dbl;
+{
+	/* construct the dmap table */
+
+	dblock_p d;
+	int cnt;
+
+	/* determine the length of the table */
+
+	cnt = 0;
+	for (d = dbl; d != (dblock_p) 0; d = d->d_next) cnt++;
+	dmap = (dblock_p *) newmap(cnt);
+	for (d = dbl; d != (dblock_p) 0; d = d->d_next) {
+		assert(d->d_id) <= cnt;
+		dmap[d->d_id] = d;
+	}
+	return cnt;
+}
+
+
+
+STATIC getdnames(dumpd)
+	FILE *dumpd;
+{
+	/* Read the names of the datalabels from
+	 * the dump file.
+	 */
+
+	char str[IDL+1];
+	char *s;
+	int id;
+	register int i;
+
+	dnames = (char **) newnametab(dlength,IDL);
+	for (;;) {
+		if (fscanf(dumpd,"%d	%s",&id,str) == EOF) return;
+		assert(id <= dlength);
+		s = dnames[id];
+		for (i = 0; i < IDL; i++) {
+			*s++ = str[i];
+		}
+	}
+}
+
+STATIC getpnames(dumpp)
+	FILE *dumpp;
+{
+	/* Read the names of the procedures from
+	 * the dump file.
+	 */
+
+	char str[IDL+1];
+	char *s;
+	int id;
+	register int i;
+
+	pnames = (char **) newnametab(plength,IDL);
+	for (;;) {
+		if (fscanf(dumpp,"%d	%s",&id,str) == EOF) return;
+		assert(id <= plength);
+		s = pnames[id];
+		for (i = 0; i < IDL; i++) {
+			*s++ = str[i];
+		}
+	}
+}
+
+
+STATIC bool name_exists(name,endp,endd)
+	char *name;
+	proc_p endp;
+	dblock_p endd;
+{
+	/* Search the proctable (from fproc to endp)
+	 * and the data block table (from fdblock to endd)
+	 * to see if the name is already in use.
+	 */
+
+	proc_p p;
+	dblock_p d;
+
+	for (p = fproc; p != endp; p = p->p_next) {
+		if (strncmp(name,pnames[p->p_id],IDL) == 0) return TRUE;
+	}
+	for (d = fdblock; d != endd; d = d->d_next) {
+		if (strncmp(name,dnames[d->d_id],IDL) == 0) return TRUE;
+	}
+	return FALSE;
+}
+
+
+
+static int nn = 0;
+
+STATIC new_name(s)
+	char *s;
+{
+	s[0] = '_';
+	s[1] = 'I';
+	s[2] = 'I';
+	sprintf(&s[3],"%d",nn);
+	nn++;
+}
+
+
+	
+STATIC uniq_names()
+{
+	/* The names of all internal procedures and data blocks
+	 * are made different. As the optimizer combines several
+	 * modules into one, there may be name conflicts between
+	 * procedures or data blocks that were internal in
+	 * different source modules.
+	 */
+
+	proc_p p;
+	dblock_p d;
+
+	for (p = fproc; p != (proc_p) 0; p = p->p_next) {
+		if (!(p->p_flags1 & PF_EXTERNAL) &&
+		    name_exists(pnames[p->p_id],p,fdblock)) {
+			new_name(pnames[p->p_id]);
+		}
+	}
+	for (d = fdblock; d != (dblock_p) 0; d = d->d_next) {
+		if (!(d->d_flags1 & DF_EXTERNAL) &&
+		    name_exists(dnames[d->d_id],(proc_p) 0,d) ) {
+			new_name(dnames[d->d_id]);
+		}
+	}
+}
+main(argc,argv)
+	int argc;
+	char *argv[];
+{
+	/* CA does not output proctable etc. files. Instead, its
+	 * pname2 and dname2 arguments contain the names of the
+	 * dump files created by IC.
+	 */
+	FILE *f, *f2;	  /* The EM input and output. */
+	FILE *df, *pf;    /* The dump files */
+	line_p lnp;
+
+	fproc = getptable(pname); /* proc table */
+	fdblock = getdtable(dname);  /* data block table */
+	dlength = makedmap(fdblock); /* allocate dmap table */
+	df = openfile(dname2,"r");
+	getdnames(df);
+	fclose(df);
+	pf = openfile(pname2,"r");
+	getpnames(pf);
+	fclose(pf);
+	uniq_names();
+	f = openfile(lname,"r");
+	f2 = stdout;
+	cputmagic(f2); /* write magic number */
+	while ((lnp = get_ca_lines(f,&curproc)) != (line_p) 0) {
+		cputlines(lnp,f2);
+	}
+	fclose(f);
+	fclose(f2);
+	exit(0);
+}

+ 15 - 0
util/ego/ca/ca.h

@@ -0,0 +1,15 @@
+/*
+ *  C O M P A C T   A S S E M B L Y   L A N G U A G E   G E N E R A T I O N
+ *
+ */
+
+
+#define PF_SYMOUT 01
+#define DF_SYMOUT 01
+
+extern dblock_p *dmap;
+
+extern char **dnames;
+extern char **pnames;
+
+extern byte em_flag[];

+ 412 - 0
util/ego/ca/ca_put.c

@@ -0,0 +1,412 @@
+#include <stdio.h>
+#include "../share/types.h"
+#include "ca.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/map.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_flag.h"
+#include "../../../h/em_mes.h"
+#include "../share/alloc.h"
+
+#define outbyte(b) putc(b,outfile)
+
+FILE *outfile;
+
+STATIC proc_p thispro;
+
+STATIC outinst(m) {
+
+	outbyte( (byte) m );
+}
+
+STATIC coutshort(i) short i; {
+
+	outbyte( (byte) (i&BMASK) );
+	outbyte( (byte) (i>>8) );
+}
+
+STATIC coutint(i) short i; {
+
+	if (i>= -sp_zcst0 && i< sp_ncst0-sp_zcst0)
+		outbyte( (byte) (i+sp_zcst0+sp_fcst0) );
+	else {
+		outbyte( (byte) sp_cst2) ;
+		coutshort(i);
+	}
+}
+
+STATIC coutoff(off) offset off; {
+
+	if ((short) off == off)
+		coutint((short) off);
+	else {
+		outbyte( (byte) sp_cst4) ;
+		coutshort( (short) (off&0177777L) );
+		coutshort( (short) (off>>16) );
+	}
+}
+
+
+STATIC outsym(s,t)
+	char *s;
+	int t;
+{
+	register byte *p;
+	register unsigned num;
+
+	if (s[0] == '.') {
+		num = atoi(&s[1]);
+		if (num < 256) {
+			outbyte( (byte) sp_dlb1) ;
+			outbyte( (byte) (num) );
+		} else {
+			outbyte( (byte) sp_dlb2) ;
+			coutshort((short) num);
+		}
+	} else {
+		p= s;
+		while (*p && p < &s[IDL])
+			p++;
+		num = p - s;
+		outbyte( (byte) t);
+		coutint((short) num);
+		p = s;
+		while (num--)
+			outbyte( (byte) *p++ );
+	}
+}
+
+
+STATIC outdsym(dbl)
+	dblock_p dbl;
+{
+	outsym(dnames[dbl->d_id],sp_dnam);
+}
+
+
+STATIC outpsym(p)
+	proc_p p;
+{
+	outsym(pnames[p->p_id],sp_pnam);
+}
+
+
+STATIC outddef(id) short id; {
+
+	dblock_p dbl;
+
+	dbl = dmap[id];
+	dbl->d_flags2 |= DF_SYMOUT;
+	if (dbl->d_flags1 & DF_EXTERNAL) {
+		outinst(ps_exa);
+		outdsym(dbl);
+	}
+}
+
+STATIC outpdef(p) proc_p p; {
+	p->p_flags2 |= PF_SYMOUT;
+	if (p->p_flags1 & PF_EXTERNAL) {
+		outinst(ps_exp);
+		outpsym(p);
+	}
+}
+
+
+STATIC outdocc(obj) obj_p obj; {
+	dblock_p dbl;
+
+	dbl = obj->o_dblock;
+	if ((dbl->d_flags2 & DF_SYMOUT) == 0) {
+		dbl->d_flags2 |= DF_SYMOUT;
+		if ((dbl->d_flags1 & DF_EXTERNAL) == 0) {
+			outinst(ps_ina);
+			outdsym(dbl);
+		}
+	}
+}
+
+
+STATIC outpocc(p) proc_p p; {
+	if ((p->p_flags2 & PF_SYMOUT) == 0) {
+		p->p_flags2 |= PF_SYMOUT;
+		if ((p->p_flags1 & PF_EXTERNAL) == 0) {
+			outinst(ps_inp);
+			outpsym(p);
+		}
+	}
+}
+
+
+STATIC coutobject(obj)
+	obj_p obj;
+{
+	/* In general, an object is defined by a global data
+	 * label and an offset. There are two special cases:
+	 * the label is omitted if the object is part of the current
+	 * hol block; the offset is omitted if it is 0 and the label
+	 * was not omitted.
+	 */
+	if (dnames[obj->o_dblock->d_id][0] == '\0') {
+		coutoff(obj->o_off);
+	} else {
+		if (obj->o_off == 0) {
+			outdsym(obj->o_dblock);
+		} else {
+			outbyte((byte) sp_doff);
+			outdsym(obj->o_dblock);
+			coutoff(obj->o_off);
+		}
+	}
+}
+
+
+STATIC cputstr(abp) register argb_p abp; {
+	register argb_p tbp;
+	register length;
+
+	length = 0;
+	tbp = abp;
+	while (tbp!= (argb_p) 0) {
+		length += tbp->ab_index;
+		tbp = tbp->ab_next;
+	}
+	coutint(length);
+	while (abp != (argb_p) 0) {
+		for (length=0;length<abp->ab_index;length++)
+			outbyte( (byte) abp->ab_contents[length] );
+		abp = abp->ab_next;
+	}
+}
+
+
+STATIC outnum(n)
+	int n;
+{
+	if (n < 256) {
+		outbyte((byte) sp_ilb1);
+		outbyte((byte) n);
+	} else {
+		outbyte((byte) sp_ilb2);
+		coutshort((short) n);
+	}
+}
+
+
+STATIC numlab(n)
+	int n;
+{
+	if (n < sp_nilb0) {
+		outbyte((byte) (n + sp_filb0));
+	} else {
+		outnum(n);
+	}
+}
+
+
+STATIC cputargs(lnp)
+	line_p lnp;
+{
+	register arg_p ap;
+	int cnt = 0;
+	ap = ARG(lnp);
+	while (ap != (arg_p) 0) {
+		switch(ap->a_type) {
+			case ARGOFF:
+				coutoff(ap->a_a.a_offset);
+				break;
+			case ARGOBJECT:
+				coutobject(ap->a_a.a_obj);
+				break;
+			case ARGPROC:
+				outpsym(ap->a_a.a_proc);
+				break;
+			case ARGINSTRLAB:
+				outnum(ap->a_a.a_instrlab);
+				break;
+			case ARGSTRING:
+				outbyte((byte) sp_scon);
+				cputstr(&ap->a_a.a_string);
+				break;
+			case ARGICN:
+				outbyte((byte) sp_icon);
+				goto casecon;
+			case ARGUCN:
+				outbyte((byte) sp_ucon);
+				goto casecon;
+			case ARGFCN:
+				outbyte((byte) sp_fcon);
+			casecon:
+				coutint(ap->a_a.a_con.ac_length);
+				cputstr(&ap->a_a.a_con.ac_con);
+				break;
+			default:
+				assert(FALSE);
+		}
+		ap = ap->a_next;
+		/* Avoid generating extremely long CON or ROM statements */
+		if (cnt++ > 10 && ap != (arg_p) 0 && 
+		    (INSTR(lnp) == ps_con || INSTR(lnp) == ps_rom)) {
+			cnt = 0;
+			outbyte((byte) sp_cend);
+			outinst(INSTR(lnp));
+		}
+	}
+}
+
+
+
+STATIC outoperand(lnp)
+	line_p lnp;
+{
+	/* Output the operand of instruction lnp */
+
+	switch(TYPE(lnp)) {
+		case OPNO:
+			if ((em_flag[INSTR(lnp)-sp_fmnem]&EM_PAR) != PAR_NO) {
+				outbyte((byte) sp_cend);
+			}
+			break;
+		case OPSHORT:
+			if (INSTR(lnp) == ps_sym) {
+				outsym(dnames[SHORT(lnp)],sp_dnam);
+			} else {
+				coutint(SHORT(lnp));
+			}
+			break;
+		case OPOFFSET:
+			coutoff(OFFSET(lnp));
+			break;
+		case OPINSTRLAB:
+			if (INSTR(lnp) == op_lab) {
+				numlab(INSTRLAB(lnp));
+			} else {
+				if (INSTR(lnp) < sp_fpseu) {
+					coutint(INSTRLAB(lnp));
+				} else {
+					numlab(INSTRLAB(lnp));
+				}
+			}
+			break;
+		case OPOBJECT:
+			coutobject(OBJ(lnp));
+			break;
+		case OPPROC:
+			outpsym(PROC(lnp));
+			break;
+		case OPLIST:
+			cputargs(lnp);
+			switch(INSTR(lnp)) {
+				case ps_con:
+				case ps_rom:
+				case ps_mes:
+					outbyte((byte) sp_cend);
+					/* list terminator */
+					break;
+			}
+			break;
+		default:
+			assert(FALSE);
+	}
+}
+
+
+STATIC outvisibility(lnp)
+	line_p lnp;
+{
+	/* In EM names of datalabels and procedures can be made
+	 * externally visible, so they can be used in other files.
+	 * There are special EM pseudo-instructions to state
+	 * explicitly that a certain identifier is externally
+	 * visible (ps_exa,ps_exp) or invisible (ps_ina,ps_inp).
+	 * If there is no such pseudo for a certain identifier,
+	 * the identifier is external only if its first use
+	 * in the current file is an applied occurrence.
+	 * Unfortunately the global optimizer may change the
+	 * order of defining and applied occurrences.
+	 * In the first optimizer pass (ic) we record for each identifier
+	 * whether it is external or not. If necessary we generate
+	 * pseudo instructions here.
+	 */
+
+	 arg_p ap;
+	 short instr;
+
+	 instr = INSTR(lnp);
+	 switch(TYPE(lnp)) {
+		case OPOBJECT:
+			outdocc(OBJ(lnp));
+			/* applied occurrence of a data label */
+			break;
+		case OPSHORT:
+			if (instr == ps_sym) {
+				outddef(SHORT(lnp));
+				/* defining occ. data label */
+			}
+			break;
+		case OPPROC:
+			if (instr == ps_pro) {
+				outpdef(PROC(lnp));
+				/* defining occ. procedure */
+			} else {
+				outpocc(PROC(lnp));
+			}
+			break;
+		case OPLIST:
+			for (ap =  ARG(lnp); ap != (arg_p) 0; ap = ap->a_next) {
+				switch(ap->a_type) {
+					case ARGOBJECT:
+					   outdocc(ap->a_a.a_obj);
+					   break;
+					case ARGPROC:
+					   outpocc(ap->a_a.a_proc);
+					   break;
+				}
+			}
+			break;
+	}
+}
+
+
+cputlines(l,lf)
+	line_p l;
+	FILE *lf;
+{
+	/* Output the lines in Campact assembly language
+	 * format.
+	 */
+
+	line_p next,lnp;
+
+	outfile = lf;
+	for (lnp = l; lnp != (line_p) 0; lnp = next) {
+		next = lnp->l_next;
+		outvisibility(lnp); /* take care of visibiltity rules */
+		if (INSTR(lnp) != ps_sym && INSTR(lnp) != op_lab) {
+			outinst(INSTR(lnp));
+		}
+		outoperand(lnp);
+		switch(INSTR(lnp)) {
+			case ps_pro:
+				thispro = PROC(lnp);
+				/* fall through ... */
+			case ps_end:
+				coutoff(thispro->p_localbytes);
+		}
+		oldline(lnp);
+	}
+	if (thispro != (proc_p) 0) {
+		oldmap(lmap,llength);
+	}
+}
+
+cputmagic(lf)
+	FILE *lf;
+{
+	/* write the magic number */
+
+	outfile = lf;
+	coutshort(sp_magic);
+}

+ 9 - 0
util/ego/ca/ca_put.h

@@ -0,0 +1,9 @@
+/* C O M P A C T   A S S E M B L Y   G E N E R A T I O N
+ *
+ * C A _ P U T . C
+ *
+ */
+
+
+extern cputlines();
+extern cputmagic();

+ 149 - 0
util/ego/ra/Makefile

@@ -0,0 +1,149 @@
+
+EMH=../../../h
+EML=../../../lib
+CFLAGS=-DVERBOSE -O
+SHARE=../share
+RA=.
+OBJECTS=ra.o ra_items.o ra_lifet.o ra_allocl.o ra_profits.o ra_interv.o ra_pack.o ra_xform.o ra_aux.o
+SHOBJECTS=$(SHARE)/aux.o $(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/go.o
+SRC=ra.h ra_items.h ra_lifet.h ra_allocl.h ra_profits.h ra_interv.h ra_pack.h ra_xform.h ra_aux.h ra.c ra_items.c ra_lifet.c ra_allocl.c ra_profits.c ra_interv.c ra_pack.c ra_xform.c ra_aux.c
+.c.o:
+	cc $(CFLAGS) -c $<
+all:	$(OBJECTS)
+itemtab.h: \
+	makeitems \
+	itemtab.src
+	 makeitems $(EMH)/em_mnem.h itemtab.src > itemtab.h
+makeitems: \
+	makeitems.c
+	 cc -o makeitems makeitems.c
+ra: \
+	$(OBJECTS) $(SHOBJECTS)
+	 cc -o ra -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
+opr:
+	pr $(SRC) | opr
+lpr:
+	pr $(SRC) | lpr
+# the next lines are generated automatically
+# AUTOAUTOAUTOAUTOAUTOAUTO
+ra.o:	../../../h/em_reg.h
+ra.o:	../share/alloc.h
+ra.o:	../share/debug.h
+ra.o:	../share/files.h
+ra.o:	../share/get.h
+ra.o:	../share/global.h
+ra.o:	../share/go.h
+ra.o:	../share/lset.h
+ra.o:	../share/map.h
+ra.o:	../share/put.h
+ra.o:	../share/types.h
+ra.o:	ra.h
+ra.o:	ra_allocl.h
+ra.o:	ra_items.h
+ra.o:	ra_pack.h
+ra.o:	ra_profits.h
+ra.o:	ra_xform.h
+ra_allocl.o:	../../../h/em_mnem.h
+ra_allocl.o:	../../../h/em_pseu.h
+ra_allocl.o:	../../../h/em_reg.h
+ra_allocl.o:	../../../h/em_spec.h
+ra_allocl.o:	../share/alloc.h
+ra_allocl.o:	../share/aux.h
+ra_allocl.o:	../share/cset.h
+ra_allocl.o:	../share/debug.h
+ra_allocl.o:	../share/def.h
+ra_allocl.o:	../share/global.h
+ra_allocl.o:	../share/lset.h
+ra_allocl.o:	../share/map.h
+ra_allocl.o:	../share/types.h
+ra_allocl.o:	ra.h
+ra_allocl.o:	ra_allocl.h
+ra_allocl.o:	ra_aux.h
+ra_allocl.o:	ra_interv.h
+ra_allocl.o:	ra_items.h
+ra_aux.o:	../../../h/em_mnem.h
+ra_aux.o:	../../../h/em_pseu.h
+ra_aux.o:	../../../h/em_reg.h
+ra_aux.o:	../../../h/em_spec.h
+ra_aux.o:	../share/alloc.h
+ra_aux.o:	../share/debug.h
+ra_aux.o:	../share/def.h
+ra_aux.o:	../share/global.h
+ra_aux.o:	../share/lset.h
+ra_aux.o:	../share/types.h
+ra_aux.o:	ra.h
+ra_aux.o:	ra_aux.h
+ra_interv.o:	../share/alloc.h
+ra_interv.o:	../share/debug.h
+ra_interv.o:	../share/global.h
+ra_interv.o:	../share/lset.h
+ra_interv.o:	../share/types.h
+ra_interv.o:	../../../h/em_reg.h
+ra_interv.o:	ra.h
+ra_interv.o:	ra_interv.h
+ra_items.o:	../../../h/em_mnem.h
+ra_items.o:	../../../h/em_pseu.h
+ra_items.o:	../../../h/em_reg.h
+ra_items.o:	../../../h/em_spec.h
+ra_items.o:	../share/alloc.h
+ra_items.o:	../share/aux.h
+ra_items.o:	../share/debug.h
+ra_items.o:	../share/def.h
+ra_items.o:	../share/global.h
+ra_items.o:	../share/lset.h
+ra_items.o:	../share/types.h
+ra_items.o:	itemtab.h
+ra_items.o:	ra.h
+ra_items.o:	ra_aux.h
+ra_items.o:	ra_items.h
+ra_lifet.o:	../../../h/em_mnem.h
+ra_lifet.o:	../../../h/em_pseu.h
+ra_lifet.o:	../../../h/em_reg.h
+ra_lifet.o:	../../../h/em_spec.h
+ra_lifet.o:	../share/alloc.h
+ra_lifet.o:	../share/aux.h
+ra_lifet.o:	../share/debug.h
+ra_lifet.o:	../share/def.h
+ra_lifet.o:	../share/global.h
+ra_lifet.o:	../share/lset.h
+ra_lifet.o:	../share/types.h
+ra_lifet.o:	ra.h
+ra_lifet.o:	ra_aux.h
+ra_lifet.o:	ra_items.h
+ra_lifet.o:	ra_lifet.h
+ra_pack.o:	../../../h/em_reg.h
+ra_pack.o:	../share/alloc.h
+ra_pack.o:	../share/aux.h
+ra_pack.o:	../share/cset.h
+ra_pack.o:	../share/debug.h
+ra_pack.o:	../share/def.h
+ra_pack.o:	../share/global.h
+ra_pack.o:	../share/lset.h
+ra_pack.o:	../share/types.h
+ra_pack.o:	ra.h
+ra_pack.o:	ra_aux.h
+ra_pack.o:	ra_interv.h
+ra_profits.o:	../../../h/em_reg.h
+ra_profits.o:	../share/debug.h
+ra_profits.o:	../share/global.h
+ra_profits.o:	../share/lset.h
+ra_profits.o:	../share/types.h
+ra_profits.o:	ra.h
+ra_profits.o:	ra_aux.h
+ra_profits.o:	ra_profits.h
+ra_xform.o:	../../../h/em_mes.h
+ra_xform.o:	../../../h/em_mnem.h
+ra_xform.o:	../../../h/em_pseu.h
+ra_xform.o:	../../../h/em_reg.h
+ra_xform.o:	../../../h/em_spec.h
+ra_xform.o:	../share/alloc.h
+ra_xform.o:	../share/aux.h
+ra_xform.o:	../share/debug.h
+ra_xform.o:	../share/def.h
+ra_xform.o:	../share/global.h
+ra_xform.o:	../share/lset.h
+ra_xform.o:	../share/types.h
+ra_xform.o:	ra.h
+ra_xform.o:	ra_interv.h
+ra_xform.o:	ra_items.h
+ra_xform.o:	ra_xform.h

+ 77 - 0
util/ego/ra/makeitems.c

@@ -0,0 +1,77 @@
+#include <stdio.h>
+
+/*  MAKE ITEMS TABLE
+ *
+ * This program is used by the register allocation phase of the optimizer
+ * to make the file itemtab.h. It reads two files:
+ *  - the em_mnem.h file, containing the definitions of the
+ *    EM mnemonics
+ *  - the item-file, containing tuples:
+ *    (mnemonic, item_type)
+ * The output (standard output) is a C array.
+ */
+
+
+#define TRUE  1
+#define FALSE 0
+
+convert(mnemfile,itemfile)
+	FILE *mnemfile, *itemfile;
+{
+	char mnem1[20], mnem2[20],def[20],itemtype[20];
+	int newcl,opc,index;
+
+	newcl = TRUE;
+	printf("struct item_descr itemtab[] = {\n");
+	for (;;) {
+		fscanf(mnemfile,"%s%s%d",def,mnem1,&opc);
+		/* read a line like "#define op_aar 1" */
+		if (feof(mnemfile)) break;
+		if (strcmp(def,"#define") != 0) {
+			error("bad mnemonic file, #define expected");
+		}
+		if (newcl) {
+			fscanf(itemfile,"%s%s%d",mnem2,itemtype,&index);
+			/* read a line like "op_loc CONST 4" */
+		}
+		if (feof(itemfile) || strcmp(mnem1,mnem2) != 0) {
+			/* there is no line for this mnemonic, so
+			 * it has no type.
+			 */
+			printf("{NO_ITEM,0},\n");
+			newcl = FALSE;
+		} else {
+			printf("{%s,%d},\n",itemtype,index);
+			newcl = TRUE;
+		}
+	}
+	printf("};\n");
+}
+
+
+
+error(s)
+	char *s;
+{
+	fprintf(stderr,"%s\n",s);
+	exit(-1);
+}
+
+
+main(argc,argv)
+	int argc;
+	char *argv[];
+{
+	FILE *f1,*f2;
+
+	if (argc != 3) {
+		error("usage: makeitems mnemfile itemfile");
+	}
+	if ((f1 = fopen(argv[1],"r")) == NULL) {
+		error("cannot open mnemonic file");
+	}
+	if ((f2 = fopen(argv[2],"r")) == NULL) {
+		error("cannot open item file");
+	}
+	convert(f1,f2);
+}

+ 543 - 0
util/ego/ra/ra.c

@@ -0,0 +1,543 @@
+/*
+ *   R E G I S T E R    A L L O C A T I O N
+ *
+ */
+
+#include <stdio.h>
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/files.h"
+#include "../share/get.h"
+#include "../share/put.h"
+#include "../share/lset.h"
+#include "../share/map.h"
+#include "../share/alloc.h"
+#include "../share/go.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_items.h"
+#include "ra_allocl.h"
+#include "ra_profits.h"
+#include "ra_pack.h"
+#include "ra_xform.h"
+
+
+short alloc_id;
+item_p items[NRITEMTYPES];
+int nrinstrs;
+line_p *instrmap;
+
+cond_p alocaltab[NRREGTYPES][NRREGTYPES],alocaddrtab[NRREGTYPES][NRREGTYPES],
+	aconsttab,adconsttab,aglobaltab,aproctab;
+cond_p olocaltab[NRREGTYPES],olocaddrtab[NRREGTYPES],
+	oconsttab,odconsttab,oglobaltab,oproctab;
+cond_p regsav_cost;
+
+short regs_available[] = {
+	/* Actually machine dependent; this is for vax2 */
+	3,	/* reg_any i.e. data regs */
+	0,	/* reg_loop */
+	3,	/* reg_pointer i.e. address reg. */
+	0	/* reg_float */
+} ;
+
+STATIC cond_p getcondtab(f)
+	FILE *f;
+{
+	int l,i;
+	cond_p tab;
+
+	fscanf(f,"%d",&l);
+	tab = newcondtab(l);
+	for (i = 0; i < l; i++) {
+		fscanf(f,"%d %d %d",&tab[i].mc_cond,&tab[i].mc_tval,
+			 &tab[i].mc_sval);
+	}
+	assert(tab[l-1].mc_cond == DEFAULT);
+	return tab;
+}
+
+get_atab(f,tab)
+	FILE *f;
+	cond_p tab[NRREGTYPES][NRREGTYPES];
+{
+	int i,cnt,totyp,regtyp;
+	
+	fscanf(f,"%d",&cnt);
+	for (i = 0; i < cnt; i++) {
+		fscanf(f,"%d %d",&regtyp,&totyp);
+		assert(regtyp >= 0  && regtyp < NRREGTYPES);
+		assert(totyp >= 0  && totyp < NRREGTYPES);
+		tab[regtyp][totyp] = getcondtab(f);
+	}
+}
+
+
+get_otab(f,tab)
+	FILE *f;
+	cond_p tab[NRREGTYPES];
+{
+	int i,cnt,regtyp;
+	
+	fscanf(f,"%d",&cnt);
+	for (i = 0; i < cnt; i++) {
+		fscanf(f,"%d",&regtyp);
+		assert(regtyp >= 0  && regtyp < NRREGTYPES);
+		tab[regtyp] = getcondtab(f);
+	}
+}
+
+
+
+STATIC ra_machinit(f)
+	FILE *f;
+{
+	/* Read target machine dependent information for this phase */
+	char s[100];
+
+	for (;;) {
+		while(getc(f) != '\n');
+		fscanf(f,"%s",s);
+		if (strcmp(s,"%%RA") == 0)break;
+	}
+	fscanf(f,"%d",&regs_available[reg_any]);
+	fscanf(f,"%d",&regs_available[reg_pointer]);
+	fscanf(f,"%d",&regs_available[reg_float]);
+	get_atab(f,alocaltab);
+	get_atab(f,alocaddrtab);
+	aconsttab = getcondtab(f);
+	adconsttab = getcondtab(f);
+	aglobaltab = getcondtab(f);
+	aproctab = getcondtab(f);
+	get_otab(f,olocaltab);
+	get_otab(f,olocaddrtab);
+	oconsttab = getcondtab(f);
+	odconsttab = getcondtab(f);
+	oglobaltab = getcondtab(f);
+	oproctab = getcondtab(f);
+	regsav_cost = getcondtab(f);
+}
+
+
+STATIC bblock_p header(lp)
+	loop_p lp;
+{
+	/* Try to determine the 'header' block of loop lp.
+	 * If 'e' is the entry block of loop L, then block 'b' is
+	 * called the header block of L, iff:
+	 *	SUCC(b) = {e} & PRED(e) = {b}
+	 * If lp has no header block, 0 is returned.
+	 */
+
+	bblock_p x = lp->lp_entry->b_idom;
+
+	if (x != (bblock_p) 0 && Lnrelems(x->b_succ) == 1 &&
+	    (bblock_p) Lelem(Lfirst(x->b_succ)) == lp->lp_entry) {
+		return x;
+	}
+	return (bblock_p) 0;
+}
+
+
+STATIC ra_extproc(p)
+	proc_p p;
+{
+	/* Allocate the extended data structures for procedure p */
+
+	register loop_p lp;
+	register Lindex pi;
+	register bblock_p b;
+
+	for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
+	   pi = Lnext(pi,p->p_loops)) {
+		lp = (loop_p) Lelem(pi);
+		lp->lp_extend = newralpx();
+		lp->LP_HEADER = header(lp);
+	}
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		b->b_extend = newrabx();
+	}
+}
+
+
+
+
+STATIC ra_cleanproc(p)
+	proc_p p;
+{
+	/* Allocate the extended data structures for procedure p */
+
+	register loop_p lp;
+	register Lindex pi;
+	register bblock_p b;
+
+	for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
+	   pi = Lnext(pi,p->p_loops)) {
+		lp = (loop_p) Lelem(pi);
+		oldralpx(lp->lp_extend);
+	}
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		oldrabx(b->b_extend);
+	}
+}
+
+
+
+STATIC loop_blocks(p)
+	proc_p p;
+{
+	/* Compute the LP_BLOCKS sets for all loops of p */
+
+	register bblock_p b;
+	register Lindex i;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (i = Lfirst(b->b_loops); i != (Lindex) 0;
+		   i = Lnext(i,b->b_loops)) {
+			Ladd(b,&(((loop_p) Lelem(i))->LP_BLOCKS));
+		}
+	}
+}
+
+
+
+
+STATIC make_instrmap(p,map)
+	proc_p p;
+	line_p map[];
+{
+	/* make the instructions map of procedure p */
+
+	register bblock_p b;
+	register line_p l;
+	register int i = 0;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		b->B_BEGIN = i; /* number of first instruction */
+		for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+			map[i++] = l;
+		}
+		b->B_END = i-1; /* number of last instruction */
+	}
+}
+
+
+
+STATIC bool useful_item(item)
+	item_p item;
+{
+	/* See if it may be useful to put the item in a register.
+	 * A local variable that is not a parameter may always be put
+	 * in a register (as it need not be initialized).
+	 * Other items must be used at least twice.
+	 */
+
+	int nruses = Lnrelems(item->it_usage);	
+	assert (nruses > 0); /* otherwise it would not be an item! */
+	return nruses > 1 || (item->it_type == LOCALVAR &&
+				item->i_t.it_off < 0);
+}
+
+
+STATIC item_p cat_items(items)
+	item_p items[];
+{
+	/* Make one item list out of an array of itemlists.
+	 * Remove items that are used only once.
+	 */
+
+	register item_p it;
+	item_p *ip,head,next;
+	int t;
+
+
+	ip = &head;
+	for (t = 0; t < NRITEMTYPES;t++) {
+		for ( it = items[t]; it != (item_p) 0; it = next) {
+			next = it->it_next;
+			if (!it->it_desirable || !useful_item(it)) {
+				clean_timeset(it->it_usage);
+				olditem(it);
+			} else {
+				*ip = it;
+				ip = &it->it_next;
+			}
+		}
+	}
+	*ip = (item_p) 0;
+	return head;
+}
+
+
+
+
+STATIC clean_interval(list)
+	interv_p list;
+{
+	register interv_p x,next;
+
+	for (x = list; x != (interv_p) 0; x = next) {
+		next = x->i_next;
+		oldinterval(x);
+	}
+}
+
+
+
+STATIC clean_timeset(s)
+	lset s;
+{
+	register Lindex i;
+	register time_p t;
+
+	for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i,s)) {
+		t = (time_p) Lelem(i);
+		oldtime(t);
+	}
+	Ldeleteset(s);
+}
+
+
+
+STATIC clean_allocs(list)
+	alloc_p list;
+{
+	register alloc_p x,next;
+
+	for (x = list; x != (alloc_p) 0; x = next) {
+		next = x->al_next;
+		clean_interval(x->al_timespan);
+		Cdeleteset(x->al_rivals);
+		Ldeleteset(x->al_inits);
+		clean_interval(x->al_busy);
+		clean_allocs(x->al_mates);
+		oldalloc(x);
+	}
+}
+
+
+
+STATIC clean_items(list)
+	item_p list;
+{
+	register item_p x,next;
+
+	for (x = list; x != (item_p) 0; x = next ) {
+		next = x->it_next;
+		clean_timeset(x->it_usage);
+		olditem(x);
+	}
+}
+
+
+ra_initialize()
+{
+	init_replacements(ps,ws);
+}
+
+
+ra_optimize(p)
+	proc_p p;
+{
+	item_p itemlist;
+	alloc_p alloclist,packed,unpacked;
+	offset locls;
+	bool time_opt = (time_space_ratio == 100);
+
+	ra_extproc(p);
+	loop_blocks(p);
+	alloc_id =0;
+	locls = p->p_localbytes;
+	build_itemlist(p,items,&nrinstrs);
+	instrmap = (line_p *) newmap(nrinstrs-1); /* map starts counting at 0 */
+	make_instrmap(p,instrmap);
+	build_lifetimes(items);
+	/*  print_items(items,p); */
+	/* statistics(items); */
+	itemlist = cat_items(items); /* make one list */
+	alloclist = build_alloc_list(p,Lnrelems(p->p_loops),
+				     itemlist);
+	build_rivals_graph(alloclist);
+	compute_profits(alloclist,time_opt);
+	/* print_allocs(alloclist); */
+	pack(alloclist,time_opt,&packed,&unpacked,p);
+	stat_regusage(packed);
+	xform_proc(p,packed,nrinstrs,instrmap);
+	/* print_allocs(packed);   */
+	p->p_localbytes = locls;
+	/* don't really allocate dummy local variables! */
+	rem_locals(p,packed); 
+	rem_formals(p,packed); 
+	/* remove storage for real locals that
+	 *are always put in register .
+	 */
+	clean_allocs(unpacked);
+	clean_allocs(packed);
+	clean_items(itemlist);
+	oldmap(instrmap,nrinstrs-1);
+	ra_cleanproc(p);
+}
+
+
+
+main(argc,argv)
+	int argc;
+	char *argv[];
+{
+	go(argc,argv,ra_initialize,ra_optimize,ra_machinit,no_action);
+	exit(0);
+}
+
+
+/***************************************************************************/
+/***************************************************************************/
+/***************************************************************************/
+
+/* debugging stuff */
+
+
+
+char *str_types[] = {
+	"local variable",
+	"addr. of local",
+	"addr. of external",
+	"addr. of procedure",
+	"constant",
+	"double constant"
+};
+
+char *str_regtypes[] = {
+	"any",
+	"loop",
+	"pointer",
+	"float"
+};
+
+
+print_items(items,p)
+	item_p items[];
+	proc_p p;
+{
+	int t;
+	item_p item;
+	interv_p iv;
+
+	printf("BEGIN PROCEDURE %d\n",p->p_id);
+	for (t = 0; t < NRITEMTYPES;t++) {
+		for (item = items[t]; item != (item_p) 0;item = item->it_next) {
+			printf("\nitemtype = %s\n",str_types[t]);
+			if (t == GLOBL_ADDR) {
+				printf("id of external = %d\n",
+					item->i_t.it_obj->o_id);
+			} else {
+				printf("offset = %D\n",
+					item->i_t.it_off);
+			}
+			printf("regtype = %s\n",str_regtypes[item->it_regtype]);
+			printf("size = %d\n",item->it_size);
+			printf("#usages = %d\n", Lnrelems(item->it_usage));
+			printf("lifetime = {");
+			for (iv = item->it_lives; iv != (interv_p) 0;
+			     iv = iv->i_next) {
+				printf("(%d,%d) ",iv->i_start,iv->i_stop);
+			}
+			printf("} \n");
+		}
+	}
+	printf("END PROCEDURE %d\n\n",p->p_id);
+}
+
+
+print_allocs(list)
+	alloc_p list;
+{
+	alloc_p al,m;
+	item_p item;
+	short t;
+	interv_p iv;
+
+	printf("BEGIN ALLOCLIST of proc %d\n",curproc->p_id);
+	for (m = list ; m != (alloc_p) 0; m = m->al_next) {
+		for (al = m; al != (alloc_p) 0; al = al->al_mates) {
+			item = al->al_item;
+			t = item->it_type;
+			printf("\nitem: [type = %s, ",str_types[t]);
+			switch(t) {
+			case GLOBL_ADDR:
+				printf("id = %d]\n", item->i_t.it_obj->o_id);
+				break;
+			case PROC_ADDR:
+				printf("id = %d]\n", item->i_t.it_proc->p_id);
+				break;
+			default:
+				printf("offset = %D]\n", item->i_t.it_off);
+			}
+			printf("#usages(static) = %d\n",al->al_susecount);
+			printf("#usages(dyn) = %d\n",al->al_dusecount);
+			printf("#inits = %d\n",Lnrelems(al->al_inits));
+			printf("timespan = {");
+			for (iv = al->al_timespan; iv != (interv_p) 0;
+			     iv = iv->i_next) {
+				printf("(%d,%d) ",iv->i_start,iv->i_stop);
+			}
+			printf("} \n");
+			printf("busy = {");
+			for (iv = al->al_busy; iv != (interv_p) 0;
+			     iv = iv->i_next) {
+				printf("(%d,%d) ",iv->i_start,iv->i_stop);
+			}
+			printf("} \n");
+			printf("profits = %d\n",al->al_profits);
+			printf("dummy local = %D\n",al->al_dummy);
+			printf("regnr = %d\n",al->al_regnr);
+		}
+	}
+}
+
+
+short regs_needed[4];
+stat_regusage(list)
+	alloc_p list;
+{
+	int i;
+	alloc_p x;
+
+	for (i = 0; i < 4; i++) {
+		regs_needed[i] = 0;
+	}
+	for (x = list; x != (alloc_p) 0; x = x->al_next) {
+		regs_needed[x->al_regtype]++;
+	}
+	/* printf("data regs:%d\n",regs_needed[reg_any]); */
+	/* printf("address regs:%d\n",regs_needed[reg_pointer]); */
+}
+
+		
+
+int cnt_regtypes[reg_float+1];
+
+statistics(items)
+	item_p items[];
+{
+	register item_p item,next;
+	int t,r;
+	int cnt;
+
+	printf("\nSTATISTICS\n");
+	for (r = 0; r <= reg_float; r++) cnt_regtypes[r] = 0;
+	for (t = 0; t < NRITEMTYPES;t++) {
+		cnt = 0;
+		for (item = items[t]; item != (item_p) 0;item = next) {
+			if (useful_item(item)) {
+				cnt++;
+				cnt_regtypes[item->it_regtype]++;
+			}
+			next = item->it_next;
+		}
+		printf("#%s = %d\n",str_types[t],cnt);
+	}
+	for (r = 0; r <= reg_float; r++) {
+		printf("#%s = %d\n",str_regtypes[r],cnt_regtypes[r]);
+	}
+}

+ 138 - 0
util/ego/ra/ra.h

@@ -0,0 +1,138 @@
+/*
+ *   R E G I S T E R    A L L O C A T I O N
+ *
+ */
+
+/* TEMPORARY: should be put in ../../../h/em_mes.h: */
+#define ms_liv 9
+#define ms_ded 10
+
+#define INFINITE	10000
+#define NRREGTYPES	(reg_float+1)
+
+int nrinstrs;  /* number of instructions of current procedure */
+line_p *instrmap;  /* Dynamic array: instrmap[i] points to i'th instruction */
+
+extern cond_p alocaltab[NRREGTYPES][NRREGTYPES],
+	alocaddrtab[NRREGTYPES][NRREGTYPES], aconsttab,
+	adconsttab,aglobaltab,aproctab;
+extern cond_p olocaltab[NRREGTYPES],olocaddrtab[NRREGTYPES],
+	oconsttab,odconsttab,oglobaltab,oproctab;
+extern cond_p regsav_cost;
+
+/* Register Allocation */
+typedef struct item *item_p;
+typedef struct allocation *alloc_p;
+typedef struct interval *interv_p;
+typedef struct time *time_p;
+
+
+
+
+extern short regs_available[];  /* contains #registers of every type */
+
+
+/* A thing that can be put in a register is called an "item". The are several
+ * types of items: a local variable, the address of a local variable,
+ * the address of a global variable, the address of a procedure,
+ * a word-size constant and a doubleword- size constant.
+ */
+
+#define LOCALVAR	0
+#define LOCAL_ADDR	1
+#define GLOBL_ADDR	2
+#define PROC_ADDR	3
+#define CONST		4
+#define DCONST		5
+
+#define NO_ITEM		6
+#define NRITEMTYPES	6
+
+struct item {
+	item_p	  it_next;	/* link to next item is list		*/
+	short	  it_type;	/* its type; see above			*/
+	short	  it_regtype;	/* preferred type of register		*/
+	short	  it_size;	/* its size (in bytes)			*/
+	short	  it_lastlive;	/* temporary, used to build livetime	*/
+	lset	  it_usage;	/* all points in text where item is used*/
+	interv_p  it_lives;	/* intervals during which item is live	*/
+	bool	  it_desirable; /* should this item be put in reg.?	*/
+	union {
+		obj_p	it_obj;		/* for GLOBL_ADDR 		*/
+		proc_p	it_proc;	/* for PROC_ADDR		*/
+		offset	it_off;		/* for others	  		*/
+	} i_t;
+};
+
+
+/* A 'point in time' is defined by a (line,basic block) pair */
+
+struct time {
+	line_p	  t_line;	/* point in EM text			*/
+	bblock_p  t_bblock;	/* its basic block			*/
+};
+
+
+struct interval {
+	short	 i_start;	/* number of first instruction		*/
+	short	 i_stop;	/* number of last instruction		*/
+	interv_p i_next;
+};
+
+
+/* An item may be put in a register for the duration of a whole procedure
+ * or part of a procedure (e.g. a loop). So a possible "allocation" looks
+ * like: put item X in a register during the timespan T (which is a subset
+ * of the timespan of the entire procedure). The packing process deals
+ * with allocations, rather than items. One item may be part of several
+ * possible allocations.
+ */
+
+struct allocation {
+	item_p	  al_item;	/* the item to be put in a register	  */
+	short	  al_id;	/* unique identifying number		  */
+	short	  al_regtype;	/* the register type to be used		  */
+	interv_p  al_timespan;	/* timespan during which item is in reg.  */
+	short	  al_profits;	/* gains of putting item in register	  */
+	cset	  al_rivals;	/* set of allocations competing with it	  */
+	short	  al_susecount;	/* #usages during timespan (statically)   */
+	short	  al_dusecount;	/* #usages (dynamically, estimate)	  */
+	lset	  al_inits;	/* points where reg. must be initialized  */
+	interv_p  al_busy;	/* used to compute rivals		  */
+	short	  al_regnr;	/* register nr.,if it is granted a reg.   */
+	offset	  al_dummy;	/* dummy local variable,if granted a reg  */
+	alloc_p	  al_mates;	/* link to allocations packed in same reg */
+	alloc_p	  al_wholeproc;	/* alloc. for whole proc as timespan  	  */
+	short	  al_cntrivals; /* # unpacked rivals ; used for cost estim. */
+	bool	  al_isloop;	/* true if timespan consists of loop	  */
+	bool	  al_iswholeproc;/*true if timespan consists of whole proc*/
+	alloc_p	  al_next;	/* link to next one in a list		  */
+};
+
+extern short alloc_id;  /* last al_id used for current procedure */
+
+#define LP_BLOCKS	lp_extend->lpx_ra.lpx_blocks
+#define LP_HEADER	lp_extend->lpx_ra.lpx_header
+#define B_BEGIN		b_extend->bx_ra.bx_begin
+#define B_END		b_extend->bx_ra.bx_end
+#define B_DIST		b_extend->bx_ra.bx_dist
+#define B_USECNT	b_extend->bx_ra.bx_usecnt
+#define B_MARK		b_extend->bx_ra.bx_mark
+
+#define DLINK(l1,l2)	l1->l_next=l2; l2->l_prev=l1
+
+struct item_descr {
+	int	id_type;
+	int	id_replindex;
+} ;
+
+extern struct item_descr itemtab[];
+
+#define newalloc()	(alloc_p) newstruct(allocation)
+#define  oldalloc(a)	oldstruct(allocation,a)
+#define newitem()	(item_p) newstruct(item)
+#define olditem(i)	oldstruct(item,i)
+#define newtime()	(time_p) newstruct(time)
+#define oldtime(t)	oldstruct(time,t)
+#define newinterval()	(interv_p) newstruct(interval)
+#define oldinterval(i)	oldstruct(interval,i)

+ 376 - 0
util/ego/ra/ra_allocl.c

@@ -0,0 +1,376 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ A L L O C L I S T . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/aux.h"
+#include "../share/alloc.h"
+#include "../share/map.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+#include "ra_items.h"
+#include "ra_allocl.h"
+#include "ra_interv.h"
+
+STATIC count_usage(p,item,nrloops,sloopcnt,dloopcnt)
+	proc_p p;
+	item_p item;
+	short  nrloops, sloopcnt[], dloopcnt[];
+{
+	/* Determine how many times the item is used in every loop.
+	 * We maintain a 'static' count and a 'dynamic' count. The dynamic
+	 * count estimates the number of times the item is used during
+	 * execution, i.e. it gives a higher mark to items used inside
+	 * a loop.
+	 */
+
+	lset loops;
+	loop_p l;
+	int i;
+	short lev;
+	Lindex ui,li;
+	time_p u;
+
+	for (i = 0; i <= nrloops; i++) {
+		sloopcnt[i] = 0;
+		dloopcnt[i] = 0;
+	}
+	for (ui = Lfirst(item->it_usage); ui != (Lindex) 0;
+					  ui = Lnext(ui,item->it_usage)) {
+		u = (time_p) Lelem(ui);
+		loops = u->t_bblock->b_loops;
+		lev = Lnrelems(loops);
+		/* set of loops in which this usage of item occurs */
+		for (li = Lfirst(loops); li != (Lindex) 0; li=Lnext(li,loops)) {
+			l = (loop_p) Lelem(li);
+			sloopcnt[l->lp_id]++;
+			dloopcnt[l->lp_id] += 
+				(IS_FIRM(u->t_bblock) ? loop_scale(lev) : 1);
+		}
+	}
+}
+
+
+
+STATIC alloc_p cons_alloc(item,timespan,stat_usecount,
+			  dyn_usecount,inits,wholeproc,isloop,iswholeproc)
+	item_p item;
+	interv_p timespan;
+	short stat_usecount,dyn_usecount;
+	lset inits;
+	alloc_p wholeproc;
+	bool isloop,iswholeproc;
+{
+	alloc_p x;
+
+	x = newalloc();
+	x->al_id = ++alloc_id;
+	x->al_item = item;
+	x->al_timespan = timespan;
+	x->al_susecount = stat_usecount;
+	x->al_dusecount = dyn_usecount;
+	x->al_inits = inits;
+	x->al_wholeproc = wholeproc;
+	x->al_isloop = isloop;
+	x->al_iswholeproc = iswholeproc;
+	return x;
+}
+
+
+STATIC insert_alloc(alloc,list_p)
+	alloc_p alloc, *list_p;
+{
+	alloc->al_next = *list_p;
+	*list_p = alloc;
+}
+
+
+
+#define MUST_INIT(i,b)   (i->it_type!=LOCALVAR ||contains(b->B_BEGIN,i->it_lives))
+#define MUST_UPDATE(i,b) (i->it_type==LOCALVAR &&contains(b->B_BEGIN,i->it_lives))
+
+STATIC lset loop_inits(lp,item,header)
+	loop_p lp;
+	item_p item;
+	bblock_p header;
+{
+	/* Build the set of entry points to loop lp where item
+	 * must be initialized
+	 */
+
+	lset s = Lempty_set();
+	if (header != (bblock_p) 0 && MUST_INIT(item,header)) {
+		Ladd(header,&s);
+	}
+	return s;
+}
+
+
+
+#define IN_LOOP(b)	(Lnrelems(b->b_loops) > 0)
+
+STATIC bblock_p init_point(item)
+	item_p item;
+{
+	/* Find the most appropriate point to initialize any register
+	 * containing the item. We want to do the initialization as
+	 * late as possible, to allow other items to be put in the
+	 * same register, before this initialization. Yet, as we want
+	 * to do the initialization only once, it must be done in a
+	 * basic block that is a dominator of all points where the
+	 * item is used (ultimately in the first block of the procedure).
+	 * This basic block should not be part of loop.
+	 */
+
+	bblock_p b,dom = 0;
+	Lindex ti;
+	time_p t;
+
+	for (ti = Lfirst(item->it_usage); ti != (Lindex) 0;
+					ti = Lnext(ti,item->it_usage)) {
+		t = (time_p) Lelem(ti);
+		b = t->t_bblock;
+		dom = (dom == (bblock_p) 0 ? b : common_dom(dom,b));
+	}
+	while (IN_LOOP(dom)) {
+		/* Find a dominator of dom (possibly
+		 * dom itself) that is outside any loop.
+		 */
+		dom = dom->b_idom;
+	}
+	return dom;
+}
+
+
+STATIC add_blocks(b,s,span)
+	bblock_p b;
+	cset *s;
+	interv_p *span;
+{
+	Lindex pi;
+
+	if (!Cis_elem(b->b_id,*s)) {
+		Cadd(b->b_id,s);
+		add_interval(b->B_BEGIN,b->B_END,span);
+		for (pi = Lfirst(b->b_pred); pi != (Lindex) 0;
+				pi = Lnext(pi,b->b_pred)) {
+			add_blocks((bblock_p) Lelem(pi),s,span);
+		}
+	}
+}
+
+
+
+STATIC whole_lifetime(item,ini_out,span_out)
+	item_p item;
+	bblock_p *ini_out;
+	interv_p *span_out;
+{
+	/* Find the initialization point and the time_span of the item, if
+	 * we put the item in a register during all its uses.
+	 */
+
+	bblock_p b, ini = init_point(item);
+	cset s = Cempty_set(blength);
+	Lindex ti;
+	time_p t;
+	interv_p span = (interv_p) 0;
+
+	for (ti = Lfirst(item->it_usage); ti != (Lindex) 0;
+					ti = Lnext(ti,item->it_usage)) {
+		t = (time_p) Lelem(ti);
+		b = t->t_bblock;
+		add_blocks(b,&s,&span);
+	}
+	if (!Cis_elem(ini->b_id,s)) {
+		add_interval(ini->B_BEGIN,ini->B_END,&span);
+	}
+	Cdeleteset(s);
+	*ini_out = ini;
+	*span_out = span;
+}
+
+
+
+
+STATIC lset proc_inits(p,item,ini)
+	proc_p p;
+	item_p item;
+	bblock_p ini;
+{
+	lset s = Lempty_set();
+
+	if (item->it_type != LOCALVAR || item->i_t.it_off >= 0) {
+		/* only local variables need not be initialized */
+		Ladd(ini, &s);
+	}
+	return s;
+}
+
+
+STATIC bool updates_needed(lp,item)
+	loop_p lp;
+	item_p item;
+{
+	/* See if the value of item is live after the loop has
+	 * been exited, i.e. must the item be updated after the loop?
+	 */
+
+	Lindex bi,si;
+	bblock_p b,s;
+
+	for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
+					bi = Lnext(bi,lp->LP_BLOCKS)) {
+		b = (bblock_p) Lelem(bi);
+		for (si = Lfirst(b->b_succ); si != (Lindex) 0;
+					si = Lnext(si,b->b_succ)) {
+			s = (bblock_p) Lelem(si);
+			if (!Lis_elem(s,lp->LP_BLOCKS) && MUST_UPDATE(item,s)) {
+				return TRUE;
+			}
+		}
+	}
+	return FALSE;
+}
+
+
+
+STATIC short countuses(usage,b)
+	lset usage;
+	bblock_p b;
+{
+	short cnt = 0;
+	Lindex ti;
+	time_p t;
+
+	for (ti = Lfirst(usage); ti != (Lindex) 0; ti = Lnext(ti,usage)) {
+		t = (time_p) Lelem(ti);
+		if (t->t_bblock == b) cnt++;
+	}
+	return cnt;
+}
+
+
+
+STATIC allocs_of_item(p,item,loops,sloopcnt,dloopcnt,alloc_list_p)
+	proc_p p;
+	item_p item;
+	lset loops;
+	short *sloopcnt,*dloopcnt; /* dynamic arrays */
+	alloc_p *alloc_list_p;
+{
+	register Lindex li;
+	loop_p lp;
+	bblock_p header,ini;
+	short susecount,dusecount;
+	interv_p lt;
+	alloc_p wholeproc;
+
+	/* The whole procedure may be used as timespan.
+	   The dynamic usecount of a procedure is taken to be the same
+	   as its static usecount; this number is not very important, as
+	   time-optimziation chooses loops first.
+	 */
+	whole_lifetime(item,&ini,&lt);
+	wholeproc = cons_alloc(item,lt,Lnrelems(item->it_usage),
+			       Lnrelems(item->it_usage), proc_inits(p,item,ini),
+			       (alloc_p) 0,FALSE,TRUE); 
+	insert_alloc(wholeproc, alloc_list_p);
+	for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
+		lp = (loop_p) Lelem(li);
+		if (sloopcnt[lp->lp_id] != 0 && !updates_needed(lp,item)) {
+			/* Item is used within loop, so consider loop
+			 * as a timespan during which item may be put in
+			 * a register.
+			 */
+			if ((header = lp->LP_HEADER) == (bblock_p) 0 &&
+				MUST_INIT(item,lp->lp_entry)) continue;
+			lt = loop_lifetime(lp);
+			susecount = sloopcnt[lp->lp_id];
+			dusecount = dloopcnt[lp->lp_id];
+			if (MUST_INIT(item,lp->lp_entry)) {
+			       /* include header block in timespan */
+			       add_interval(header->B_BEGIN,header->B_END,&lt);
+			       susecount += countuses(item->it_usage,header);
+			} else {
+				header = (bblock_p) 0;
+			}
+			insert_alloc(cons_alloc(item,lt,susecount,dusecount,
+				     loop_inits(lp,item,header),wholeproc,
+				     TRUE,FALSE),
+					  alloc_list_p);
+		}
+	}
+}
+
+
+
+alloc_p build_alloc_list(p,nrloops,itemlist)
+	proc_p p;
+	short nrloops;
+	item_p itemlist;
+{
+	short *sloopcnt,*dloopcnt; /* dynamic arrays */
+	register item_p item;
+	alloc_p alloc_list = (alloc_p) 0;
+
+	sloopcnt = (short *) newtable(nrloops);
+	dloopcnt = (short *) newtable(nrloops);
+	for (item = itemlist; item != (item_p) 0; item = item->it_next) {
+		count_usage(p,item,nrloops,sloopcnt,dloopcnt);
+		allocs_of_item(p,item,p->p_loops,sloopcnt,dloopcnt,
+				&alloc_list);
+	}
+	oldtable(sloopcnt,nrloops);
+	oldtable(dloopcnt,nrloops);
+	return alloc_list;
+}
+
+
+
+build_rivals_graph(alloclist)
+	alloc_p alloclist;
+{
+	/* See which allocations in the list are rivals of each other,
+	 * i.e. there is some point of time, falling in both
+	 * timespans, at which the items of both allocations are live.
+	 * Allocations with the same item (but different timespans) are
+	 * not considered to be rivals.
+	 * We use an auxiliary data structure "busy" for each allocation,
+	 * indicating when the item is live during the timespan of the
+	 * allocation.
+	 */
+
+	register alloc_p alloc,x;
+
+	for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		alloc->al_rivals = Cempty_set(alloc_id);
+	}
+	for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		alloc->al_busy = 
+		   (alloc->al_item->it_type == LOCALVAR ?
+			intersect(alloc->al_timespan,alloc->al_item->it_lives) :
+			copy_timespan(alloc->al_timespan));
+		for (x = alloclist; x != alloc; x = x->al_next) {
+			if (x->al_item != alloc->al_item &&
+			    not_disjoint(alloc->al_busy,x->al_busy)) {
+				Cadd(x->al_id,&alloc->al_rivals);
+				Cadd(alloc->al_id,&x->al_rivals);
+				if (alloc->al_regtype == x->al_regtype) {
+					alloc->al_cntrivals++;
+					x->al_cntrivals++;
+				}
+			}
+		}
+	}
+}

+ 19 - 0
util/ego/ra/ra_allocl.h

@@ -0,0 +1,19 @@
+
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ A L L O C L I S T . H
+ */
+
+extern alloc_p build_alloc_list();	/* (proc_p p; short nrloops;
+					 *  item_p itemlist)
+					 * Build a list of possible allocations
+					 * for procedure p. An allocation
+					 * essentially is a pair (item,timespan)
+					 */
+extern build_rivals_graph();	/* (alloc_p alloclist)
+				/* See which allocations in the list are
+				 * rivals of each other, i.e. there is
+				 * some point of time, falling in both
+				 * timespans, at which the items of
+				 * both allocations are live.
+				 */

+ 40 - 0
util/ego/ra/ra_aux.c

@@ -0,0 +1,40 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  A U X I L I A R Y   R O U T I N E S
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/alloc.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+
+
+time_p cons_time(l,b)
+	line_p l;
+	bblock_p b;
+{
+	/* Construct a time */
+
+	time_p t = newtime();
+
+	t->t_line = l;
+	t->t_bblock = b;
+	return t;
+}
+
+
+
+
+short loop_scale(lev)
+	short lev;
+{
+	return (lev == 0 ? 1 : (lev > 3 ? 20 : 5 * lev));
+}

+ 24 - 0
util/ego/ra/ra_aux.h

@@ -0,0 +1,24 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  A U X I L I A R Y   R O U T I N E S
+ */
+
+#define regv_size(off)		regv_arg(off,2)
+					/* Fetch the size argument of the
+					 * register message of the local with
+					 * the given offset.
+					 */
+#define regv_type(off)		regv_arg(off,3)
+					/* Fetch the type argument of the
+					 * register message of the local with
+					 * the given offset.
+					 */
+extern time_p	cons_time();		/* (line_p l; bblock_p b)
+					 * Construct a 'time' record with
+					 * fields 'l' and 'b'.
+					 */
+extern short loop_scale(); 		/* (short lev)
+					 * Estimate how many times an item
+					 * appearing in a loop of nesting
+					 * level 'lev' will be used dynamically.
+					 */

+ 228 - 0
util/ego/ra/ra_interv.c

@@ -0,0 +1,228 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ I N T E R V A L . C
+ */
+
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/alloc.h"
+#include "../share/lset.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_interv.h"
+
+interv_p cons_interval(t_start,t_stop)
+	short t_start,t_stop;
+{
+	interv_p x;
+
+	x = newinterval();
+	x->i_start = t_start;
+	x->i_stop = t_stop;
+	return x;
+}
+
+
+
+add_interval(t1,t2,list)
+	short t1,t2;
+	interv_p *list;
+{
+	/* Add interval (t1,t2) to the list of intervals (which is
+	 * an in-out parameter!). The list is sorted in 'chronological'
+	 * order. We attempt to keep the list as small as possible, by
+	 * putting adjacent intervals in one interval.
+	 */
+
+	register interv_p x1, x2, *q;
+	int adjacent = 0;
+	interv_p x;
+
+	q = list;
+	x1 = (interv_p) 0;
+	for (x2 = *list; x2 != (interv_p) 0; x2 = x2->i_next) {
+		if (t2 < x2->i_start) break;
+		x1 = x2;
+		q = &x2->i_next;
+	}
+	/* Now interval (t1,t2) should be inserted somewhere in between
+	 * x1 and x2.
+	 */
+	if (x1 != (interv_p) 0 && t1 == x1->i_stop + 1) {
+		/* join x1 and (t1,t2) */
+		x1->i_stop = t2;
+		adjacent++;
+	}
+	if (x2 != (interv_p) 0 && t2 + 1 == x2->i_start) {
+		/* join (t1,t2) and x2 */
+		x2->i_start = t1;
+		adjacent++;
+	}
+	if (adjacent == 0) {
+		/* no adjacents, allocate a new intervalfor (t1,t2) */
+		x = cons_interval(t1,t2);
+		x->i_next = x2;
+		*q = x;
+	} else {
+		if (adjacent == 2) {
+			/* x1, (t1,t2) and x2 can be put in one interval */
+			x1->i_stop = x2->i_stop;
+			x1->i_next = x2->i_next;
+			oldinterval(x2);
+		}
+	}
+}
+
+
+
+interv_p loop_lifetime(lp)
+	loop_p lp;
+{
+	/* Determine the timespan of the loop, expressed as a list
+	 * of intervals.
+	 */
+
+	interv_p lt = 0;
+	register bblock_p b;
+	register Lindex bi;
+
+	for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
+					 bi = Lnext(bi,lp->LP_BLOCKS)) {
+		b = (bblock_p) Lelem(bi);
+		add_interval(b->B_BEGIN,b->B_END,&lt);
+	}
+	return lt;
+}
+
+
+interv_p proc_lifetime(p)
+	proc_p p;
+{
+	/* Determine the lifetime of an entire procedure */
+
+	register bblock_p b;
+
+	for (b = p->p_start; b->b_next != (bblock_p) 0; b = b->b_next) ;
+	return cons_interval(0,b->B_END);
+}
+
+
+
+STATIC set_min_max(iv1,iv2)
+	interv_p *iv1,*iv2;
+{
+	/* Auxiliary routine of intersect */
+
+	interv_p i1 = *iv1, i2 = *iv2;
+
+	if (i1->i_start < i2->i_start) {
+		*iv1 = i1;
+		*iv2 = i2;
+	} else {
+		*iv1 = i2;
+		*iv2 = i1;
+	}
+}
+
+
+
+interv_p intersect(list1,list2)
+	interv_p list1,list2;
+{
+	/* Intersect two lifetimes, each denoted by a list of intervals.
+	 * We maintain two pointers, pmin and pmax, pointing to the
+	 * next interval of each list. At any time, pmin points to the
+	 * interval of which i_start is lowest; pmax points to the
+	 * other interval (i.e. the next interval of the other list).
+	 */
+
+	interv_p lt = 0;
+	interv_p pmin,pmax;
+
+#define BUMP(p)	p = p->i_next
+#define EMIT(t1,t2)	add_interval(t1,t2,&lt)
+
+	pmin = list1;
+	pmax = list2;
+	while (pmin != (interv_p) 0 && pmax != (interv_p) 0) {
+		set_min_max(&pmin,&pmax);
+		if (pmax->i_start > pmin->i_stop) {
+			/* e.g. (5,7) and (9,13) */
+			BUMP(pmin);
+		} else {
+			if (pmax->i_stop < pmin->i_stop) {
+				/* e.g. (5,12) and (7,10) */
+				EMIT(pmax->i_start,pmax->i_stop);
+				BUMP(pmax);
+			} else {
+				/* e.g. (5,8) and (7,12) */
+				EMIT(pmax->i_start,pmin->i_stop);
+				if (pmax->i_stop == pmin->i_stop) {
+					/* e.g. (5,12) and (7,12) */
+					BUMP(pmax);
+				}
+				BUMP(pmin);
+			}
+		}
+	}
+	return lt;
+}
+
+
+
+bool not_disjoint(list1,list2)
+	interv_p list1,list2;
+{
+	/* See if list1 and list2 do overlap somewhere */
+
+	interv_p pmin,pmax;
+
+	pmin = list1;
+	pmax = list2;
+	while (pmin != (interv_p) 0 && pmax != (interv_p) 0) {
+		set_min_max(&pmin,&pmax);
+		if (pmax->i_start > pmin->i_stop) {
+			/* e.g. (5,7) and (9,13) */
+			BUMP(pmin);
+		} else {
+			return TRUE; /* not disjoint */
+		}
+	}
+	return FALSE; /* disjoint */
+}
+
+
+
+bool contains(t,timespan)
+	short t;
+	interv_p timespan;
+{
+	register interv_p iv;
+
+	for (iv = timespan; iv != (interv_p) 0; iv = iv->i_next) {
+		if (t <= iv->i_stop) return (t >= iv->i_start);
+	}
+	return FALSE;
+}
+
+
+
+interv_p copy_timespan(list)
+	interv_p list;
+{
+	/* copy the time span */
+
+	interv_p x,y,head,*p;
+
+	head = (interv_p) 0;
+	p = &head;
+
+	for (x = list; x != (interv_p) 0; x = x->i_next) {
+		y = cons_interval(x->i_start,x->i_stop);
+		*p = y;
+		p = &y->i_next;
+	}
+	return head;
+}

+ 35 - 0
util/ego/ra/ra_interv.h

@@ -0,0 +1,35 @@
+
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ I N T E R V A L . H
+ */
+
+
+extern interv_p cons_interval();/* (short t_start,t_stop)
+				 * construct an interval
+				 */
+extern add_interval();		/* (short t1,t2; interv_p *list)
+				 * Add interval (t1,t2) to the list of
+				 * intervals (which is an in-out parameter!).
+				 */
+extern interv_p loop_lifetime();/* (loop_p lp)
+				 * Determine the timespan of the loop,
+				 * expressed as a list of intervals.
+				 */
+extern interv_p proc_lifetime();/* (proc_p p)
+				 * Determine the timespan of a procedure,
+				 * expressed as an interval.
+				 */
+extern interv_p  intersect(); 	/* (interv_p list1,list2)
+				 * Intersect two lifetimes, each denoted
+				 * by a list of intervals.
+				 */
+extern bool not_disjoint();	/* (interv_p list1,list2)
+				 * See if list1 and list2 do overlap somewhere.
+				 */
+extern bool contains();		/* (short t;interv_p timespan)
+				 * See if t is part of the timespan.
+				 */
+extern interv_p copy_timespan();/* (interv_p list)
+				 * Make a copy of the timespan.
+				 */

+ 345 - 0
util/ego/ra/ra_items.c

@@ -0,0 +1,345 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ I T E M S . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/aux.h"
+#include "../share/alloc.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+#include "ra_items.h"
+
+
+#include "itemtab.h"
+/* Maps EM mnemonics onto item types, e.g. op_lol -> LOCALVAR, op_ldc->DCONST,
+ * generated from em_mmen.h and itemtab.src files.
+ */
+
+#define SMALL_CONSTANT(c)	(c >= 0 && c <= 8)
+/* prevent small constants from being put in a register */
+
+
+clean_tab(items)
+	item_p items[];
+{
+	int t;
+
+	for (t = 0; t < NRITEMTYPES;t++) {
+		items[t] = (item_p) 0;
+	}
+}
+
+
+
+
+short item_type(l)
+	line_p l;
+{
+	int instr = INSTR(l);
+	int t;
+
+	if (instr < sp_fmnem || instr > sp_lmnem) return NO_ITEM;
+	t =  itemtab[instr - sp_fmnem].id_type;
+	if (t == CONST && SMALL_CONSTANT(off_set(l))) return NO_ITEM;
+	return t;
+}
+
+
+
+bool is_item(l)
+	line_p l;
+{
+	return item_type(l) != NO_ITEM;
+}
+
+
+item_p item_of(off,items)
+	offset off;
+	item_p items[];
+{
+	register item_p x;
+
+	for (x = items[LOCALVAR]; x != (item_p) 0; x = x->it_next) {
+		if (off == x->i_t.it_off) {
+			if (!x->it_desirable) break; 
+					/* don't put this item in reg */
+			return x;
+		}
+	}
+	return (item_p) 0;
+}
+
+
+
+fill_item(item,l)
+	item_p item;
+	line_p l;
+{
+	item->it_type = item_type(l); 
+	switch(item->it_type) {
+		case GLOBL_ADDR:
+			item->i_t.it_obj = OBJ(l);
+			break;
+		case PROC_ADDR:
+			item->i_t.it_proc = PROC(l);
+			break;
+		default:
+			item->i_t.it_off = off_set(l);
+	}
+}
+
+
+
+STATIC bool desirable(l)
+	line_p l;
+{
+	/* See if it is really desirable to put the item of line l
+	 * in a register. We do not put an item in a register if it
+	 * is used as 'address of array descriptor' of an array
+	 * instruction.
+	*/
+
+	if (l->l_next != (line_p) 0) {
+		switch(INSTR(l->l_next)) {
+			case op_aar:
+			case op_lar:
+			case op_sar:
+				return FALSE;
+		}
+	}
+	return TRUE;
+}
+
+
+
+STATIC int cmp_items(a,b)
+	item_p a,b;
+{
+	/* This routine defines the <, = and > relations between items,
+	 * used to sort them for fast lookup.
+	 */
+
+	offset n1,n2;
+
+	switch(a->it_type) {
+		case GLOBL_ADDR:
+			assert(b->it_type == GLOBL_ADDR);
+			n1 = (offset) a->i_t.it_obj->o_id;
+			n2 = (offset) b->i_t.it_obj->o_id;
+			break;
+		case PROC_ADDR:
+			assert(b->it_type == PROC_ADDR);
+			n1 = (offset) a->i_t.it_proc->p_id;
+			n2 = (offset) b->i_t.it_proc->p_id;
+			break;
+		default:
+			n1 = a->i_t.it_off;
+			n2 = b->i_t.it_off;
+	}
+	return (n1 == n2 ? 0 : (n1 > n2 ? 1 : -1));
+}
+
+
+
+bool same_item(a,b)
+	item_p a,b;
+{
+	return cmp_items(a,b) == 0;
+}
+
+
+STATIC bool lt_item(a,b)
+	item_p a,b;
+{
+	return cmp_items(a,b) == -1;
+}
+
+
+
+/* build_itemlist()
+ *
+ * Build a list of all items used in the current procedure. An item
+ * is anything that can be put in a register (a local variable, a constant,
+ * the address of a local or global variable).
+ * For each type of item we use a sorted list containing all items of
+ * that type found so far.
+ * A local variable is only considered to be an item if there is a
+ * register message for it (indicating it is never accessed indirectly).
+ * For each item, we keep track of all places where it is used
+ * (either fetched or stored into). The usage of a local variable is also
+ * considered to be a usage of its address.
+ */
+
+
+
+STATIC item_p items[NRITEMTYPES];  /* items[i] points to the list of type i */
+
+
+
+STATIC short reg_type(item)
+	item_p item;
+{
+	/* See which type of register the item should best be assigned to */
+
+	switch(item->it_type) {
+		case LOCALVAR:
+			return regv_type(item->i_t.it_off);
+			/* use type mentioned in reg. message for local */
+		case LOCAL_ADDR:
+		case GLOBL_ADDR:
+		case PROC_ADDR:
+			return reg_pointer;
+		case CONST:
+		case DCONST:
+			return reg_any;
+		default: assert(FALSE);
+	}
+	/* NOTREACHED */
+}
+
+
+
+STATIC short item_size(item)
+	item_p item;
+{
+	/* Determine the size of the item (in bytes) */
+
+	switch(item->it_type) {
+		case LOCALVAR:
+			return regv_size(item->i_t.it_off);
+			/* use size mentioned in reg. message for local */
+		case LOCAL_ADDR:
+		case GLOBL_ADDR:
+		case PROC_ADDR:
+			return ps; /* pointer size */
+		case CONST:
+			return ws; /* word size */
+		case DCONST:
+			return 2 * ws; /* 2 * word size */
+		default: assert(FALSE);
+	}
+	/* NOTREACHED */
+}
+
+
+
+STATIC init_item(a,b)
+	item_p a,b;
+{
+	a->it_type = b->it_type;
+	switch(a->it_type) {
+		case GLOBL_ADDR:
+			a->i_t.it_obj = b->i_t.it_obj;
+			break;
+		case PROC_ADDR:
+			a->i_t.it_proc = b->i_t.it_proc;
+			break;
+		default:
+			a->i_t.it_off = b->i_t.it_off;
+	}
+	a->it_usage = Lempty_set();
+	a->it_regtype = reg_type(b);
+	a->it_size = item_size(b);
+	a->it_desirable = b->it_desirable;
+}
+
+
+
+STATIC add_item(item,t,items)
+	item_p item;
+	time_p t;
+	item_p items[];
+{
+	/* See if there was already a list element for item. In any
+	 * case record the fact that item is used at 't'.
+	 */
+
+	register item_p x, *q;
+
+	q = &items[item->it_type]; /* each type has its own list */
+	for (x = *q; x != (item_p) 0; x = *q) {
+		if (same_item(x,item)) {
+			/* found */
+			if (!item->it_desirable) {
+				x->it_desirable = FALSE;
+			}
+			Ladd(t,&x->it_usage);
+			return; /* done */
+		}
+		if (lt_item(item,x)) break;
+		q = &x->it_next;
+	}
+	/* not found, allocate new item; q points to it_next field of
+	 * the item after which the new item should be put.
+	 */
+	x = newitem();
+	x->it_next = *q;
+	*q = x;
+	init_item(x,item);
+	Ladd(t,&x->it_usage);
+}
+
+
+
+STATIC add_usage(l,b,items)
+	line_p l;
+	bblock_p b;
+	item_p items[];
+{
+	/* An item is used at line l. Add it to the list of items.
+	 * A local variable is only considered to be an item, if
+	 * there is a register message for it; else its address
+	 * is also considered to be an item.
+	 */
+
+	struct item thisitem;
+
+	fill_item(&thisitem,l); /* fill in some fields */
+	if (!desirable(l)) {
+		thisitem.it_desirable = FALSE; /* don't put item in reg. */
+	}
+	if (thisitem.it_type == LOCALVAR && !is_regvar(thisitem.i_t.it_off)) {
+		/* Use address of local instead of local itself */
+		thisitem.it_type = LOCAL_ADDR;
+		thisitem.it_regtype = reg_pointer;
+	}
+	add_item(&thisitem,cons_time(l,b),items);
+}
+
+
+
+build_itemlist(p,items,nrinstr_out)
+	proc_p p;
+	item_p items[];
+	int    *nrinstr_out;
+{
+	/* Make a list of all items used in procedure p.
+	 * An item is anything that can be put in a register,
+	 * such as a local variable, a constant etc.
+	 * As a side effect, determine the number of instructions of p.
+	 */
+
+	register line_p l;
+	register bblock_p b;
+	register cnt= 0;
+
+	clean_tab(items);
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+			if (is_item(l)) {
+				add_usage(l,b,items);
+			}
+			cnt++;
+		}
+	}
+	*nrinstr_out = cnt;
+}

+ 31 - 0
util/ego/ra/ra_items.h

@@ -0,0 +1,31 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ I T E M S . H
+ */
+
+extern short item_type();	/* (line_p l)
+				 * Determine the type of item (constant,local
+				 * variable etc.) accessed by l.
+				 */
+extern bool is_item();		/* (line_p l)
+				 * See if l accesses an item
+				 */
+extern item_p item_of();	/* (offset off;item_p items)
+				 * Determine the descriptor of the item
+				 * accessed by l; return 0 if not found
+				 */
+extern fill_item();		/* (item_p item;line_p l)
+				 * Compute the type and obj/off attributes
+				 * of the item accessed by l and put them
+				 * in the given item descriptor.
+				 */
+extern bool same_item();	/* (item_p a,b)
+				 * See if a and b are the same items.
+				 */
+extern build_itemlist();	/* (proc_p p;item_p items[]; int *nrinstr_out)
+				 * Determine all items accessed by procedure p
+				 * and put them in the items lists. All items
+				 * of type T must be put in list items[T].
+				 * Also determine the number of instructions
+				 * of p.
+				 */

+ 74 - 0
util/ego/ra/ra_lifet.c

@@ -0,0 +1,74 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ L I F E T I M E . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/aux.h"
+#include "../share/alloc.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+#include "ra_items.h"
+#include "ra_lifet.h"
+
+
+#define MSG_OFF(l)	aoff(ARG(l),1)
+#define is_livemsg(l)	(INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_liv)
+#define is_deadmsg(l)	(INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_ded)
+
+build_lifetimes(items)
+	item_p items[];
+{
+	/* compute the it_lives attribute of every item; this is
+	 * a list of intervals during which the item is live,
+	 * i.e. its current value may be used.
+	 * We traverse the EM text of the current procedure in
+	 * lexical order. If we encounter a live-message, we store
+	 * the number ('time') of the current instruction in the
+	 * it_lastlive attribute of the concerning item. If we see
+	 * a dead-message for that item, we know that the item is
+	 * live in between these two pseudo's. If the first message
+	 * appearing in the procedure is a dead-message, the item
+	 * is live from time 0 (start of procedure) till now. (Note
+	 * that it_lastlive is initially 0!).
+	 * The lifetime ends on the last instruction before the
+	 * dead-message that is not a live -or dead message.
+	 */
+
+	register line_p l;
+	register short now;
+	item_p item;
+	short last_code;
+
+	last_code = 0;
+	for (now = 0; now < nrinstrs; now++) {
+		l = instrmap[now];
+		if (is_livemsg(l)) {
+			item = item_of(MSG_OFF(l),items);
+			/* A local variable that is never used is NOT an
+			 * item; yet, there may be a register message for it...
+			 */
+			if(item != (item_p) 0) {
+				item->it_lastlive = now;
+			}
+		} else {
+			if (is_deadmsg(l)) {
+				item = item_of(MSG_OFF(l),items);
+				if (item != (item_p) 0) {
+					add_interval(item->it_lastlive,
+					       last_code, &item->it_lives);
+				}
+			} else {
+				last_code = now;
+			}
+		}
+	}
+}

+ 12 - 0
util/ego/ra/ra_lifet.h

@@ -0,0 +1,12 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ L I F E T I M E . H
+ */
+
+
+extern build_lifetimes();	/* item_p items[]; 
+				 * compute the it_lives attribute of every
+				 * item; this is a list of intervals
+				 *  during which the item is live,
+				 * i.e. its current value may be used.
+				 */

+ 407 - 0
util/ego/ra/ra_pack.c

@@ -0,0 +1,407 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ P A C K . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/alloc.h"
+#include "../share/aux.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+#include "ra_interv.h"
+
+
+short regs_occupied[NRREGTYPES];	/* #occupied registers for reg_pointer,
+					 * reg_any etc.
+					 */
+#define reg_available(t)	(regs_available[t] > regs_occupied[t])
+
+STATIC init_regcount()
+{
+	int t;
+
+	for (t = 0; t < NRREGTYPES; t++) {
+		regs_occupied[t] = 0;
+	}
+}
+
+STATIC alloc_p make_dummy()
+{
+	alloc_p x;
+
+	x = newalloc();
+	/* x->al_profits = 0; */
+	return x;
+}
+
+
+STATIC bool fits_in(a,b,cont_item)
+	alloc_p a,b;
+	bool *cont_item;
+{
+	/* See if allocation a can be assigned the same register as b.
+	 * Both allocations should be of the same register-type.
+	 * Note that there may be several other allocations (mates) assigned to
+	 * the same register as b. A new candidate (i.e. 'a') is only
+	 * allowed to join them if it is not the rival of any resident
+	 * allocation.
+	 */
+
+	*cont_item = FALSE;
+	if (a->al_regtype == b->al_regtype) {
+		while (b != (alloc_p) 0) {
+			if (Cis_elem(a->al_id,b->al_rivals)) break;
+			b = b->al_mates;
+			if (a->al_item == b->al_item) {
+				*cont_item = TRUE;
+			}
+		}
+	}
+	return b == (alloc_p) 0;
+}
+
+
+STATIC alloc_p find_fitting_alloc(alloc,packed)
+	alloc_p alloc,packed;
+{
+	/* Try to find and already packed allocation that is assigned
+	 * a register that may also be used for alloc.
+	 * We prefer allocations that have the same item as alloc.
+	 */
+
+	register alloc_p x;
+	alloc_p cand = (alloc_p) 0;
+	bool cont_item;
+
+	for (x = packed->al_next; x != (alloc_p) 0; x = x->al_next) {
+		if (fits_in(alloc,x,&cont_item)) {
+			cand = x;
+			if (cont_item) break;
+		}
+	}
+	return cand;
+}
+
+
+STATIC bool room_for(alloc,packed)
+	alloc_p alloc,packed;
+{
+	/* See if there is any register available for alloc */
+
+	return reg_available(alloc->al_regtype) ||
+		(find_fitting_alloc(alloc,packed) != (alloc_p) 0);
+}
+
+
+
+STATIC alloc_p best_alloc(unpacked,packed,time_opt)
+	alloc_p unpacked,packed;
+	bool time_opt;
+{
+	/* Find the next best candidate */
+
+	register alloc_p x,best;
+	bool loops_only;
+
+	for (loops_only = time_opt; ; loops_only = FALSE) {
+		/* If we're optimizing execution time, we first
+		 * consider loops.
+		 */
+		best = unpacked; /* dummy */
+		for (x = unpacked->al_next; x != (alloc_p) 0; x = x->al_next) {
+			if ((!loops_only || x->al_isloop) && 
+			    x->al_profits > best->al_profits &&
+			    room_for(x,packed)) {
+				best = x;
+			}
+		}
+		if (best != unpacked || !loops_only) break;
+	}
+	return (best == unpacked ? (alloc_p) 0 : best);
+}
+
+
+
+
+STATIC alloc_p choose_location(alloc,packed,p)
+	alloc_p alloc,packed;
+	proc_p p;
+{
+	/* Decide in which register to put alloc */
+
+	alloc_p fit;
+	offset dum;
+
+	fit = find_fitting_alloc(alloc,packed);
+	if (fit == (alloc_p) 0) {
+		/* Take a brand new register; allocate a dummy local for it */
+		alloc->al_regnr = regs_occupied[alloc->al_regtype]++;
+		dum = tmplocal(p,alloc->al_item->it_size);
+		alloc->al_dummy = dum;
+	} else {
+		alloc->al_regnr = fit->al_regnr;
+		alloc->al_dummy = fit->al_dummy;
+	}
+	return fit;
+}
+
+
+
+STATIC update_lists(alloc,unpacked,packed,fit)
+	alloc_p alloc,unpacked,packed,fit;
+{
+	/* 'alloc' has been granted a register; move it from the 'unpacked'
+	 * list to the 'packed' list. Also remove any allocation from 'unpacked'
+	 * having:
+	 *  1. the same item as 'alloc' and
+	 *  2. a timespan that overlaps the timespan of alloc.
+	 */
+
+	register alloc_p x,q,next;
+
+	q = unpacked; /* dummy element at head of list */
+	for (x = unpacked->al_next; x != (alloc_p) 0; x = next) {
+		next = x->al_next;
+		if (x->al_item == alloc->al_item &&
+		    not_disjoint(x->al_timespan, alloc->al_timespan)) {
+			/* this code kills two birds with one stone;
+			 * x is either an overlapping allocation or
+			 * alloc itself!
+			 */
+			q->al_next = x->al_next;
+			if (x == alloc) {
+				if (fit == (alloc_p) 0) {
+					x->al_next = packed->al_next;
+					packed->al_next = x;
+				} else {
+					x->al_mates = fit->al_mates;
+					fit->al_mates = x;
+					x->al_next = (alloc_p) 0;
+				}
+			}
+		} else {
+			q = x;
+		}
+	}
+}
+
+
+
+STATIC short cum_profits(alloc)
+	alloc_p alloc;
+{
+	/* Add the profits of all allocations packed in the same
+	 * register as alloc (i.e. alloc and all its 'mates').
+	 */
+	
+	alloc_p m;
+	short sum = 0;
+
+	for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
+		sum += m->al_profits;
+	}
+	return sum;
+}
+
+
+
+STATIC alloc_p best_cumprofits(list,x_out,prev_out)
+	alloc_p list, *x_out, *prev_out;
+{
+	/* Find the allocation with the best cummulative profits */
+
+	register alloc_p x,prev,best_prev;
+	short best = 0, cum;
+
+	prev = list;
+	for (x = list->al_next; x != (alloc_p) 0; x = x->al_next) {
+		cum = cum_profits(x);
+		if (cum > best) {
+			best = cum;
+			best_prev = prev;
+		}
+		prev = x;
+	}
+	if (best == 0) {
+		*x_out = (alloc_p) 0;
+	} else {
+		*x_out = best_prev->al_next;
+		*prev_out = best_prev;
+	}
+}
+
+
+
+STATIC account_regsave(packed,unpacked)
+	alloc_p packed,unpacked;
+{
+	/* After all packing has been done, we check for every allocated
+	 * register whether it is really advantageous to use this
+	 * register. It may be possible that the cost of saving
+	 * and restoring the register are higher than the profits of all
+	 * allocations packed in the register. If so, we simply remove
+	 * all these allocations.
+	 * The cost of saving/restoring one extra register may depend on 
+	 * the number of registers already saved.
+	 */
+
+	alloc_p x,prev,checked;
+	short time,space;
+	short tot_cost = 0,diff;
+
+	init_regcount();
+	checked = make_dummy();
+	while (TRUE) {
+		best_cumprofits(packed,&x,&prev);
+		if (x == (alloc_p) 0) break;
+		regs_occupied[x->al_regtype]++;
+		regsave_cost(regs_occupied,&time,&space);
+		diff = add_timespace(time,space) - tot_cost;
+		if (diff < cum_profits(x)) {
+			/* x is o.k. */
+			prev->al_next = x->al_next;
+			x->al_next = checked->al_next;
+			checked->al_next = x;
+			tot_cost += diff;
+		} else {
+			break;
+		}
+	}
+	/* Now every allocation in 'packed' does not pay off, so
+	 * it is moved to unpacked, indicating it will not be assigned
+	 * a register.
+	 */
+	for (x = unpacked; x->al_next != (alloc_p) 0; x = x->al_next);
+	x->al_next = packed->al_next;
+	packed->al_next = checked->al_next;
+	oldalloc(checked);
+}
+
+
+
+STATIC bool in_single_reg(item,packed)
+	item_p item;
+	alloc_p packed;
+{
+	/* See if item is allocated in only one register (i.e. not in
+	 * several different registers during several parts of its lifetime.
+	 */
+
+	register alloc_p x,m;
+	bool seen = FALSE;
+
+	for (x = packed->al_next; x != (alloc_p) 0; x = x->al_next) {
+		for ( m = x; m != (alloc_p) 0; m = m->al_mates) {
+			if (m->al_item == item) {
+				if (seen) return FALSE;
+				seen = TRUE;
+				break;
+			}
+		}
+	}
+	return TRUE;
+}
+
+
+
+STATIC alloc_p find_prev(alloc,list)
+	alloc_p alloc,list;
+{
+	register alloc_p x;
+
+	assert ( alloc != (alloc_p) 0);
+	for (x = list; x->al_next != alloc ; x = x->al_next)
+		assert(x != (alloc_p) 0);
+	return x;
+}
+
+
+
+STATIC repl_allocs(new,old,packed)
+	alloc_p new,old,packed;
+{
+	alloc_p x,next,prev,*p;
+	new->al_regnr = old->al_regnr;
+	new->al_dummy = old->al_dummy;
+	prev = find_prev(old,packed);
+	new->al_next = old->al_next;
+	old->al_next = (alloc_p) 0;
+	prev->al_next = new;
+	new->al_mates = old;
+	p = &new->al_mates;
+	for (x = old; x != (alloc_p) 0; x = next) {
+		next = x->al_mates;
+		if (x->al_item == new->al_item) {
+			*p = next;
+			oldalloc(x);
+		} else {
+			p = &x->al_mates;
+		}
+	}
+}
+
+
+
+STATIC assemble_allocs(packed)
+	alloc_p packed;
+{
+	register alloc_p x,m,next;
+	alloc_p e;
+	bool voidb;
+
+	for (x = packed->al_next; x != (alloc_p) 0; x = next) {
+		next = x->al_next;
+		for ( m = x; m != (alloc_p) 0; m = m->al_mates) {
+			if (in_single_reg(m->al_item,packed) &&
+			    (e = m->al_wholeproc) != (alloc_p) 0 &&
+			    e->al_profits > 0 &&
+			    fits_in(e,x,&voidb)) {
+				repl_allocs(e,x,packed);
+				break;
+			}
+		}
+	}
+}
+
+pack(alloclist,time_opt,packed_out,not_packed_out,p)
+	alloc_p alloclist, *packed_out,*not_packed_out;
+	bool time_opt;
+	proc_p p;
+{
+	/* This is the packing system. It decides which allations
+	 * to grant a register.
+	 * We use two lists: packed (for allocations that are assigned a
+	 * register) and unpacked (allocations not yet assigned a register).
+	 * The packed list is in fact '2-dimensional': the al_next field is
+	 * used to link allations that are assigned different registers;
+	 * the al_mates field links allocations that are assigned to
+	 * the same registers (i.e. these allocations fit together).
+	 */
+
+	register alloc_p x;
+	alloc_p packed,unpacked,fit;
+
+	init_regcount();
+	packed = make_dummy();
+	unpacked = make_dummy();
+	unpacked->al_next = alloclist;
+	while ((x = best_alloc(unpacked,packed,time_opt)) != (alloc_p) 0) {
+		fit = choose_location(x,packed,p);
+		update_lists(x,unpacked,packed,fit);
+	}
+	assemble_allocs(packed);
+	account_regsave(packed,unpacked); 
+	/* remove allocations that don't pay off against register
+	 * save/restore costs.
+	 */
+	*packed_out = packed->al_next;
+	*not_packed_out = unpacked->al_next;
+	oldalloc(packed);
+	oldalloc(unpacked);
+}

+ 11 - 0
util/ego/ra/ra_pack.h

@@ -0,0 +1,11 @@
+
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ P A C K . H
+ */
+
+extern pack();		/* ( alloc_p alloclist, *packed_out,*not_packed_out;
+			 *   bool time_opt; proc_p p)
+			 * This is the packing system. It decides which 
+			 * allations  to grant a register.
+			 */

+ 235 - 0
util/ego/ra/ra_profits.c

@@ -0,0 +1,235 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ P R O F I T S . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/lset.h"
+#include "../share/global.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_aux.h"
+#include "ra_profits.h"
+
+STATIC bool test_cond(cond,val)
+	short cond;
+	offset val;
+{
+	switch(cond) {
+		case DEFAULT:
+			return TRUE;
+		case FITBYTE:
+			return val >= -128 && val < 128;
+		case IN_0_63:
+			return val >= 0 && val <= 63;
+		case IN_0_8:
+			return val >= 0 && val <= 8;
+	}
+}
+
+STATIC short map_value(tab,val,time)
+	struct cond_tab tab[];
+	offset val;
+	bool time;
+{
+	cond_p p;
+
+	for (p = &tab[0]; ; p++) {
+		if (test_cond(p->mc_cond,val)) {
+			return (time ? p->mc_tval : p->mc_sval);
+		}
+	}
+}
+
+
+STATIC short index_value(tab,n,time)
+	struct cond_tab tab[];
+	short n;
+	bool time;
+{
+	cond_p p;
+
+	p = &tab[n]; 
+	return (time ? p->mc_tval : p->mc_sval);
+}
+
+
+allocscore(itemtyp,localtyp,size,off,totyp,time_out,space_out) 
+	short itemtyp, localtyp,totyp,size;
+	offset off;
+	short *time_out, *space_out;
+{
+	cond_p m;
+
+	if (localtyp == reg_loop) localtyp = reg_any;
+	if (size == ws || size ==ps && totyp == reg_pointer) {
+		switch(itemtyp) {
+		   case LOCALVAR:
+			m = alocaltab[localtyp][totyp];
+			break;
+		   case LOCAL_ADDR:
+			m = alocaddrtab[localtyp][totyp];
+			break;
+		   case CONST:
+			m = aconsttab;
+			break;
+		   case DCONST:
+			m = aconsttab;
+			break;
+		   case GLOBL_ADDR:
+			m = aglobaltab;
+			break;
+		   case PROC_ADDR:
+			m = aproctab;
+			break;
+		}
+	} else {
+		m = (cond_p) 0;
+	}
+	*time_out = (m == (cond_p) 0 ? -1 : map_value(m,off,TRUE));
+	*space_out = (m == (cond_p) 0 ? -1 : map_value(m,off,FALSE));
+	/*
+	printf("itemtyp = %d, localtyp = %d off = %D\n",itemtyp,localtyp,off);
+	printf("ALLOCSCORE = (%d,%d)\n",*time_out,*space_out);
+	*/
+}
+
+opening_cost(itemtyp,localtyp,off,time_out,space_out) 
+	short itemtyp, localtyp;
+	offset off;
+	short *time_out, *space_out;
+{
+	cond_p m;
+
+	if (localtyp == reg_loop) localtyp = reg_any;
+	switch(itemtyp) {
+	   case LOCALVAR:
+		m = olocaltab[localtyp];
+		break;
+	   case LOCAL_ADDR:
+		m = olocaddrtab[localtyp];
+		break;
+	   case CONST:
+		m = oconsttab;
+		break;
+	   case DCONST:
+		m = oconsttab;
+		break;
+	   case GLOBL_ADDR:
+		m = oglobaltab;
+		break;
+	   case PROC_ADDR:
+		m = oproctab;
+		break;
+	}
+	*time_out = (m == (cond_p) 0 ? 1000 : map_value(m,off,TRUE));
+	*space_out = (m == (cond_p) 0 ? 1000 : map_value(m,off,FALSE));
+	/*
+	printf("itemtyp = %d, localtyp = %d off = %D\n",itemtyp,localtyp,off);
+	printf("OPEN_COST = (%d,%d)\n",*time_out,*space_out);
+	*/
+}
+
+
+
+
+short regsave_cost(regs,time_out,space_out)
+	short regs[], *time_out, *space_out;
+{
+	/* Estimate the costs of saving and restoring the registers
+	 * The array regs contains the number of registers of every
+	 * possible type.
+	 */
+
+	short n = regs[reg_any] + regs[reg_pointer] + regs[reg_float]; 
+	/* #registers */
+
+	*time_out = index_value(regsav_cost,n,TRUE);
+	*space_out = index_value(regsav_cost,n,FALSE);
+	/*
+	printf("REGSAVE COST, n=%d, (%d,%d)\n",n,*time_out,*space_out);
+	*/
+}
+
+
+
+STATIC short dyn_inits(inits)
+	lset inits;
+{
+	Lindex i;
+	short sum = 0;
+	bblock_p b;
+
+	for (i = Lfirst(inits); i != (Lindex) 0; i = Lnext(i,inits)) {
+		b = (bblock_p) Lelem(i);
+		sum += loop_scale(Lnrelems(b->b_loops));
+	}
+	return sum;
+}
+
+
+
+compute_profits(alloclist,time_opt)
+	alloc_p alloclist;
+	bool time_opt;
+{
+	/* Compute the profits attribute of every allocation.
+	 * If the item of an allocation may be put in several types
+	 * of register, we choose only the most advanteagous one.
+	 */
+
+	register alloc_p alloc;
+	short s,t,rtyp,maxsc;
+	item_p item;
+	short time,space,sc;
+	short otime,ospace;
+	offset off;
+	short cnt,nr_inits;
+
+	for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		maxsc = 0;
+		item = alloc->al_item;
+		switch(item->it_type) {
+			case LOCALVAR:
+			case LOCAL_ADDR:
+			case CONST:
+			case DCONST:
+				off = item->i_t.it_off;
+				break;
+			default:
+				off = 0;
+		}
+		for (rtyp = item->it_regtype; ; rtyp = reg_any) {
+			allocscore( 	item->it_type,
+					item->it_regtype,
+					item->it_size,
+					off,
+					rtyp,
+					&time,
+					&space);
+			opening_cost( 	item->it_type,
+					item->it_regtype,
+					off,
+					&otime,
+					&ospace);
+			nr_inits = Lnrelems(alloc->al_inits);
+			s = alloc->al_susecount * space - 
+				nr_inits*ospace;
+			if (!alloc->al_isloop && nr_inits > 0) {
+				/* might lead to increase of execution time */
+				cnt = 0;
+			} else {
+				cnt = alloc->al_dusecount;
+			}
+			t = cnt * time - dyn_inits(alloc->al_inits) * otime;
+			sc = (time_opt ? t : s);
+			if (sc >= maxsc) {
+				maxsc = sc;
+				alloc->al_regtype = rtyp;
+				alloc->al_profits = sc;
+			}
+			if (rtyp == reg_any) break;
+		}
+	}
+}

+ 11 - 0
util/ego/ra/ra_profits.h

@@ -0,0 +1,11 @@
+
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ P R O F I T S . H
+ */
+
+extern compute_profits();/* (alloc_p alloclist)
+			 * Compute the profits attribute of every allocation.
+			 */
+short regsave_cost(); 	/* (short regs[], *time_out, *space_out)
+			 */

+ 565 - 0
util/ego/ra/ra_xform.c

@@ -0,0 +1,565 @@
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ X F O R M . C
+ */
+
+#include "../share/types.h"
+#include "../share/debug.h"
+#include "../share/def.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/aux.h"
+#include "../share/alloc.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_spec.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_mes.h"
+#include "../../../h/em_reg.h"
+#include "ra.h"
+#include "ra_interv.h"
+#include "ra_xform.h"
+#include "ra_items.h"
+
+
+/* The replacement table is used to transform instructions that reference
+ * items other than local variables (i.e. the address of a local or global
+ * variable or a single/double constant; the transformation of an instruction
+ * that references a local variable is very simple).
+ * The generated code depends on the word and pointer size of the target
+ * machine.
+ */
+
+
+struct repl {
+	short	r_instr;	/* instruction		*/
+	short	r_op;		/* operand		*/
+};
+
+/* REGNR,NO and STOP should not equal the wordsize or pointer size
+ * of any machine.
+ */
+#define	REGNR	-3
+#define	NO	-2
+#define	STOP	-1
+#define	PS	0
+#define	PS2	1
+#define	WS	2
+#define	WS2	3
+
+#define LOAD_POINTER	op_nop
+#define	BLANK		{0, STOP}
+
+#define NRREPLACEMENTS	13
+#define	REPL_LENGTH	3
+
+struct repl repl_tab[NRREPLACEMENTS][REPL_LENGTH] = {
+	/* 0 */	{{op_lil, REGNR},	BLANK,		BLANK},
+	/* 1 */	{{LOAD_POINTER,REGNR},	{op_loi,PS},	{op_loi,WS}},
+	/* 2 */	{{LOAD_POINTER,REGNR},	BLANK,		BLANK},
+	/* 3 */ {{LOAD_POINTER,REGNR},	{op_loi,WS2},	BLANK},
+	/* 4 */	{{op_sil,REGNR},	BLANK,		BLANK},
+	/* 5 */	{{LOAD_POINTER,REGNR},	{op_loi,PS},	{op_sti,WS}},
+	/* 6 */	{{LOAD_POINTER,REGNR},	{op_sti,WS2},	BLANK},
+	/* 7 */	{{op_lil,REGNR},	{op_inc,NO},	{op_sil,REGNR}},
+	/* 8 */	{{op_lil,REGNR},	{op_dec,NO},	{op_sil,REGNR}},
+	/* 9 */	{{op_zer,WS},		{op_sil,REGNR},	BLANK},
+	/*10 */	{{op_lol,REGNR},	BLANK,		BLANK},
+	/*11 */	{{op_ldl,REGNR},	BLANK,		BLANK},
+	/*12 */	{{LOAD_POINTER,REGNR},	{op_cai,NO},	BLANK},
+};
+
+
+
+
+init_replacements(psize,wsize)
+	short psize,wsize;
+{
+	/* The replacement code to be generated depends on the
+	 * wordsize and pointer size of the target machine.
+	 * The replacement table is initialized with a description
+	 * of which sizes to use. This routine inserts the real sizes.
+	 * It also inserts the actual EM instruction to be used
+	 * as a 'Load pointer' instruction.
+	 */
+
+	register int i,j;
+	short load_pointer;
+	struct repl *r;
+
+	assert (psize == wsize || psize == 2*wsize);
+	load_pointer = (psize == wsize ? op_lol : op_ldl);
+	for (i = 0; i < NRREPLACEMENTS; i++) {
+		for (j = 0; j < REPL_LENGTH; j++) {
+			r = &repl_tab[i][j];
+			if (r->r_op == STOP) break;
+			if (r->r_instr == LOAD_POINTER) {
+				r->r_instr = load_pointer;
+			}
+			switch (r->r_op) {
+				/* initially r_op describes how to compute
+				 * the real operand of the instruction. */
+				case PS2:
+					r->r_op = 2*psize;
+					break;
+				case PS:
+					r->r_op = psize;
+					break;
+				case WS2:
+					r->r_op = 2*wsize;
+					break;
+				case WS:
+					r->r_op = wsize;
+					break;
+				case NO:
+				case REGNR:	/* use offset of dummy local,
+						 * will be filled in later.
+						 */
+					break;
+				default: assert(FALSE);
+			}
+		}
+	}
+}
+
+
+
+STATIC int repl_index(l)
+	line_p l;
+{
+	return itemtab[INSTR(l) - sp_fmnem].id_replindex;
+}
+
+
+
+STATIC bool is_current(alloc,t)
+	alloc_p alloc;
+	short t;
+{
+	/* Is time t part of alloc's timespan? */
+
+	return contains(t,alloc->al_timespan);
+}
+
+
+STATIC match_item(item,l)
+	item_p item;
+	line_p l;
+{
+	/* See if the item used by l is the same one as 'item' */
+	struct item thisitem;
+
+	fill_item(&thisitem,l);
+	if (item->it_type == LOCAL_ADDR && thisitem.it_type == LOCALVAR) {
+		/* The usage of a local variable is also considered to
+		 * be the usage of the address of that variable.
+		 */
+		thisitem.it_type = LOCAL_ADDR;
+	}
+	return item->it_type == thisitem.it_type && same_item(item,&thisitem);
+}
+
+
+
+STATIC alloc_p find_alloc(alloclist,l,t)
+	alloc_p alloclist;
+	line_p l;
+	short t;
+{
+	/* See if any of the allocations of the list applies to instruction
+	 * l at time t.
+	 */
+
+	register alloc_p alloc,m;
+
+	for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
+			if (is_current(m,t) && match_item(m->al_item,l)) {
+				return m;
+			}
+		}
+	}
+	return (alloc_p) 0;
+}
+
+
+STATIC replace_line(l,b,list)
+	line_p l,list;
+	bblock_p b;
+{
+	if (b->b_start == l) {
+		b->b_start = list;
+	} else {
+		PREV(l)->l_next = list;
+	}
+	PREV(list) = PREV(l);
+	while (list->l_next != (line_p) 0) {
+		list = list->l_next;
+	}
+	list->l_next = l->l_next;
+	if (l->l_next != (line_p) 0) {
+		PREV(l->l_next) = list;
+	}
+	oldline(l);
+}
+
+
+STATIC line_p repl_code(lnp,regnr)
+	line_p lnp;
+	offset  regnr;
+{
+	line_p head,*q,l,prev = (line_p) 0;
+	int i,index;
+	struct repl *r;
+
+	q = &head;
+	index = repl_index(lnp);
+	for (i = 0; i < REPL_LENGTH; i++) {
+		r = &repl_tab[index][i];
+		if (r->r_op == STOP) break;  /* replacement < REPL_LENGTH */
+		switch(r->r_op) {
+			case REGNR:
+				l = int_line(regnr);
+				break;
+			case NO:
+				l = newline(OPNO);
+				break;
+			default:
+				l = newline(OPSHORT);
+				SHORT(l) = r->r_op;
+				break;
+		}
+		*q = l;
+		l->l_instr = r->r_instr;
+		PREV(l) = prev;
+		prev = l;
+		q = &l->l_next;
+	}
+	return head;
+}
+
+
+
+STATIC apply_alloc(b,l,alloc)
+	bblock_p b;
+	line_p l;
+	alloc_p alloc;
+{
+	/* 'l' is an EM instruction using an item that will be put in
+	 * a register. Generate new code that uses the register instead
+	 * of the item.
+	 * If the item is a local variable the new code is the same as
+	 * the old code, except for the fact that the offset of the
+	 * local is changed (it now uses the dummy local that will be
+	 * put in a register by the code generator).
+	 * If the item is a constant, the new code is a LOL or LDL.
+	 * If the item is the address of a local or global variable, things
+	 * get more complicated. The new code depends on the instruction
+	 * that uses the item (i.e. l). The new code, which may consist of
+	 * several instructions, is obtained by consulting a replacement
+	 * table.
+	 */
+
+	line_p newcode;
+
+	if (alloc->al_item->it_type == LOCALVAR) {
+		SHORT(l) = alloc->al_dummy;
+	} else {
+		newcode = repl_code(l,alloc->al_dummy);
+		replace_line(l,b,newcode);
+	}
+}
+
+
+
+STATIC int loaditem_tab[NRITEMTYPES][2] =
+{	/* 		WS		2 * WS */
+	/*LOCALVAR*/	op_lol,		op_ldl,
+	/*LOCAL_ADDR*/	op_lal,		op_lal,
+	/*GLOBL_ADDR*/	op_lae,		op_lae,
+	/*PROC_ADDR*/	op_lpi,		op_lpi,
+	/*CONST*/	op_loc,		op_nop,
+	/*DCONST*/	op_nop,		op_ldc
+};
+
+
+STATIC line_p load_item(item)
+	item_p item;
+{
+	/* Generate an EM instruction that loads the item on the stack */
+
+	line_p l;
+
+	switch (item->it_type) {
+		case GLOBL_ADDR:
+			l = newline(OPOBJECT);
+			OBJ(l) = item->i_t.it_obj;
+			break;
+		case PROC_ADDR:
+			l = newline(OPPROC);
+			PROC(l) = item->i_t.it_proc;
+			break;
+		default:
+			l = int_line(item->i_t.it_off);
+	}
+	l->l_instr = loaditem_tab[item->it_type][item->it_size == ws ? 0 : 1];
+	assert(l->l_instr != op_nop);
+	return l;
+}
+
+
+STATIC line_p store_local(size,off)
+	short size;
+	offset off;
+{
+	line_p l = int_line(off);
+
+	l->l_instr = (size == ws ? op_stl : op_sdl);
+	return l;
+}
+
+
+
+STATIC line_p init_place(b)
+	bblock_p b;
+{
+
+	register line_p l,prev;
+
+	prev = (line_p) 0;
+	for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+		switch(INSTR(l)) {
+			case ps_mes:
+			case ps_pro:
+			case op_lab:
+				break;
+			default:
+				return prev;
+		}
+		prev =l;
+	}
+	return prev;
+}
+
+
+
+STATIC append_code(l1,l2,b)
+	line_p l1,l2;
+	bblock_p b;
+{
+	/* Append instruction l1 and l2 at begin of block b */
+
+	line_p l;
+
+	DLINK(l1,l2);
+	l = init_place(b);
+	if (l == (line_p) 0) {
+		l2->l_next = b->b_start;
+		b->b_start = l1;
+		PREV(l1) = (line_p) 0;
+	} else {
+		l2->l_next = l->l_next;
+		DLINK(l,l1);
+	}
+	if (l2->l_next != (line_p) 0) {
+		PREV(l2->l_next) = l2;
+	}
+}
+
+
+
+STATIC emit_init_code(list)
+	alloc_p list;
+{
+	/* Emit initialization code for all packed allocations.
+	 * This code looks like "dummy_local := item", e.g.
+	 * "LOC 25 ; STL -10" in EM terminology.
+	 */
+
+	register alloc_p alloc,m;
+	Lindex bi;
+	bblock_p b;
+
+	for (alloc = list; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
+			for (bi = Lfirst(m->al_inits); bi != (Lindex) 0;
+						  bi = Lnext(bi,m->al_inits)) {
+				/* "inits" contains all initialization points */
+				b = (bblock_p) Lelem(bi);
+				append_code(load_item(m->al_item),
+					    store_local(m->al_item->it_size,
+							m->al_dummy),
+					    b);
+			}
+		}
+	}
+}
+
+
+
+STATIC emit_mesregs(p,alloclist)
+	proc_p  p;
+	alloc_p alloclist;
+{
+	line_p l,m,x;
+	alloc_p alloc;
+
+
+	l = p->p_start->b_start;
+	x = l->l_next;
+	for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		m = reg_mes(alloc->al_dummy,alloc->al_item->it_size,
+			alloc->al_regtype,INFINITE);
+		DLINK(l,m);
+		l = m;
+	}
+	if (x != (line_p) 0) DLINK(l,x); 
+}
+
+#define is_mesreg(l)	(INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_reg)
+
+
+
+rem_mes(p)
+	proc_p p;
+{
+	register bblock_p b;
+	register line_p l,next;
+	offset m;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0; l = next) {
+			next = l->l_next;
+			if ( INSTR(l) == ps_mes &&
+			    ((m = aoff(ARG(l),0)) == ms_liv || m == ms_ded)) {
+					/* remove live/dead messages */
+					rm_line(l,b);
+			}
+		}
+	}
+}
+
+
+
+xform_proc(p,alloclist,nrinstrs,instrmap)
+	proc_p p;
+	alloc_p alloclist;
+	short nrinstrs;
+	line_p instrmap[];
+{
+	/* Transform every instruction of procedure p that uses an item
+	 * at a point where the item is kept in a register.
+	 */
+
+	register short now = 0;
+	register line_p l,next;
+	register bblock_p b;
+	alloc_p alloc;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0; l = next) {
+			next = l->l_next;
+			if (is_mesreg(l) && ARG(l)->a_next != (arg_p) 0 && 
+				aoff(ARG(l),4) != INFINITE) {
+				/* All register messages for local variables
+			         * that were not assigned a register get
+				 * their 'count' fields* set to 0.
+				 */
+				ARG(l)->a_next->a_next->a_next
+					->a_next->a_a.a_offset = 0;
+			}
+			if (is_item(l) && 
+			    (alloc = find_alloc(alloclist,l,now))
+					     != (alloc_p) 0 ) {
+				apply_alloc(b,l,alloc);
+			}
+			now++;
+		}
+	}
+	emit_init_code(alloclist);
+	emit_mesregs(p,alloclist);
+	rem_mes(p);
+}
+
+
+
+
+STATIC bool always_in_reg(off,allocs,size_out)
+	offset off;
+	alloc_p allocs;
+	short *size_out;
+{
+	/* See if the local variable with the given offset is stored
+	 * in a register during its entire lifetime. As a side effect,
+	 * return the size of the local.
+	 */
+
+	alloc_p alloc,m;
+	item_p item;
+
+	for (alloc = allocs; alloc != (alloc_p) 0; alloc = alloc->al_next) {
+		for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
+			item = m->al_item;
+			if (m->al_iswholeproc &&
+			    item->it_type == LOCALVAR &&
+			    item->i_t.it_off == off) {
+				*size_out = item->it_size;
+				return TRUE;
+			}
+		}
+	}
+	return FALSE;
+}
+
+
+rem_locals(p,allocs)
+	proc_p p;
+	alloc_p allocs;
+{
+	/* Try to decrease the number of locals of procedure p, by
+	 * looking at which locals are always stored in a register.
+	 */
+
+	offset nrlocals = p->p_localbytes;
+	short size;
+
+	while (nrlocals > 0) {
+		/* A local can only be removed if all locals with
+		 * higher offsets are removed too.
+		 */
+		if (always_in_reg(-nrlocals,allocs,&size)) {
+			OUTVERBOSE("local %d removed from proc %d\n",
+				nrlocals,p->p_id);
+			nrlocals -= size;
+		} else {
+			break;
+		}
+	}
+	p->p_localbytes = nrlocals;
+}
+rem_formals(p,allocs)
+	proc_p p;
+	alloc_p allocs;
+{
+	/* Try to decrease the number of formals of procedure p, by
+	 * looking at which formals are always stored in a register.
+	 */
+
+	offset nrformals = p->p_nrformals;
+	offset off = 0;
+	short size;
+
+	if (nrformals == UNKNOWN_SIZE) return;
+	while (off < nrformals) {
+		if (always_in_reg(off,allocs,&size)) {
+			OUTVERBOSE("formal %d removed from proc %d\n",
+				off,p->p_id);
+			off += size;
+		} else {
+			break;
+		}
+	}
+	if (nrformals == off) {
+		OUTVERBOSE("all formals of procedure %d removed\n",p->p_id,0);
+		p->p_nrformals = 0;
+	}
+}

+ 24 - 0
util/ego/ra/ra_xform.h

@@ -0,0 +1,24 @@
+
+/*  R E G I S T E R   A L L O C A T I O N
+ *
+ *  R A _ X F O R M . H
+ */
+
+extern init_replacements();	/* (short psize,wsize)
+				 * This routine must be called once, before
+				 * any call to xform_proc. It initializes
+				 * a machine dependent table.
+				 */
+extern xform_proc();		/* (proc_p p; alloc_p alloclist;
+				 *  short nrinstrs; line_p instrmap[])
+				 * Transform a procedure. Alloclist must
+				 * contain the packed allocations (i.e. those
+				 * allocations that are assigned a register).
+				 */
+bool always_in_reg();		/* ( offset off; alloc_p allocs;
+				 *   short *size_out;)
+				 * See if the local variable with the given 
+				 * offset is stored in a register during its 
+				 * entire lifetime. As a side effect,
+				 * return the size of the local.
+				 */

+ 21 - 0
util/ego/ud/ud.h

@@ -0,0 +1,21 @@
+/*  U S E  -  D E F I N I T I O N   A N A L Y S I S
+ *
+ *  U D . H
+ */
+
+#define GEN(b)		(b)->b_extend->bx_ud.bx_gen
+#define KILL(b)		(b)->b_extend->bx_ud.bx_kill
+#define IN(b)		(b)->b_extend->bx_ud.bx_in
+#define OUT(b)		(b)->b_extend->bx_ud.bx_out
+#define C_GEN(b)	(b)->b_extend->bx_ud.bx_cgen
+#define C_KILL(b)	(b)->b_extend->bx_ud.bx_ckill
+#define C_IN(b)		(b)->b_extend->bx_ud.bx_cin
+#define C_OUT(b)	(b)->b_extend->bx_ud.bx_cout
+#define CHGVARS(b)	(b)->b_extend->bx_ud.bx_chgvars
+
+extern short nrglobals;  /* number of global variables for which
+			  * ud-info is maintained.
+			  */
+extern short nrvars;	 /* total number of variables (global + local)
+			  * for which ud-info is maintained.
+			  */

+ 55 - 0
util/ego/ud/ud_aux.c

@@ -0,0 +1,55 @@
+/* C O P Y   P R O P A G A T I O N 
+ *
+ * A U X I L I A R Y   R O U T I N E S
+ */
+
+
+#include "../share/types.h"
+#include "../ud/ud.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/alloc.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/def.h"
+#include "../share/locals.h"
+#include "../share/aux.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_spec.h"
+#include "../ud/ud_defs.h"
+
+repl_line(old,new,b)
+	line_p old,new;
+	bblock_p b;
+{
+	/* Replace 'old' by 'new' */
+
+	if (PREV(old) == (line_p) 0) {
+		b->b_start = new;
+	} else {
+		PREV(old)->l_next = new;
+	}
+	PREV(new) = PREV(old);
+	if ((new->l_next = old->l_next) != (line_p) 0) {
+		PREV(new->l_next) = new;
+	}
+	oldline(old);
+}
+
+
+
+bool same_var(use,def)
+	line_p use,def;
+{
+	/* 'use' is an instruction that uses a variable
+	 * for which we maintain ud-info (e.g. a LOL).
+	 * See if 'def' references the same variable.
+	 */
+
+	if (TYPE(use) == OPOBJECT) {
+		return TYPE(def) == OPOBJECT && OBJ(use) == OBJ(def);
+	} else {
+		return TYPE(def) != OPOBJECT && off_set(use) == off_set(def);
+	}
+}

+ 17 - 0
util/ego/ud/ud_aux.h

@@ -0,0 +1,17 @@
+
+/* C O P Y    P R O P A G A T I O N
+ *
+ * A U X I L I A R Y   R O U T I N E S
+ */
+
+
+extern repl_line();		/* (line_p old,new; bblock_p b)
+				 * Replace EM instruction 'old' by a
+				 * copy of 'new'. Update doubly-linked
+				 * list.
+				 */
+extern bool same_var();		/* (line_p use,def)
+				 * 'use' is an instruction that uses a variable
+				 * for which we maintain ud-info (e.g. a LOL).
+				 * See if 'def' references the same variable.
+				 */

+ 246 - 0
util/ego/ud/ud_const.c

@@ -0,0 +1,246 @@
+/* C O N S T A N T   P R O P A G A T I O N */
+
+#include "../share/types.h"
+#include "../ud/ud.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/alloc.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/def.h"
+#include "../share/aux.h"
+#include "../share/locals.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_spec.h"
+#include "../ud/ud_defs.h"
+#include "ud_const.h"
+#include "ud_aux.h"
+
+
+#define CHANGE_INDIR(p)	(p->p_change->c_flags & CF_INDIR)
+#define IS_REG(v)	(locals[TO_LOCAL(v)]->lc_flags & LCF_REG)
+#define BODY_KNOWN(p)	(p->p_flags1 & (byte) PF_BODYSEEN)
+#define CALLS_UNKNOWN(p) (p->p_flags1 & (byte) PF_CALUNKNOWN)
+
+
+bool is_use(l)
+	line_p l;
+{
+	/* See if 'l' is a use of a variable */
+
+	switch(INSTR(l)) {
+		 case op_lde:
+		 case op_ldl:
+		 case op_loe:
+		 case op_lol:
+			return TRUE;
+		default:
+			return FALSE;
+	}
+	/* NOTREACHED  */
+}
+
+
+
+
+bool value_known(def,val_out)
+	line_p def;
+	offset *val_out;
+{
+	/* See if the value stored by definition 'def'
+	 * is known statically (i.e. is a constant).
+	 */
+
+	short sz1, sz2;
+	offset v;
+	line_p l;
+
+	sz1 = ws;
+	switch(INSTR(def)) {
+		case op_inl:
+		case op_ine:
+		case op_del:
+		case op_dee:
+			return FALSE;
+		case op_zrl:
+		case op_zre:
+			v = (offset) 0;
+			break;
+		case op_sdl:
+		case op_sde:
+			sz1 += ws;
+			/* fall through ... */
+		case op_stl:
+		case op_ste:
+			l = PREV(def);
+			if (l == (line_p) 0) return FALSE;
+			sz2 = ws;
+			switch(INSTR(l)) {
+				case op_zer:
+					if (SHORT(l) >= sz1) {
+						v = (offset) 0;
+						break;
+					}
+					return FALSE;
+				case op_ldc:
+					sz2 += ws;
+					/* fall through ...*/
+				case op_loc:
+					if (sz1 == sz2) {
+						v = off_set(l);
+						break;
+					}
+					/* fall through ... */
+				default:
+					return FALSE;
+			}
+			break;
+		default:
+			assert(FALSE);
+	}
+	*val_out = v;
+	return TRUE;
+}
+
+
+
+
+bool affected(use,v,l)
+	line_p use,l;
+	short  v;
+{
+	/* See if the variable referenced by 'use' may be
+	 * changed by instruction l, which is either a cal, cai or
+	 * an indirect assignment.
+	 */
+
+	if (INSTR(l) == op_cal &&
+	    TYPE(use) == OPOBJECT &&
+	    BODY_KNOWN(PROC(l)) &&
+	    !CALLS_UNKNOWN(PROC(l)) &&
+	    !CHANGE_INDIR(PROC(l))) {
+		return Cis_elem(OBJ(use)->o_id,PROC(l)->p_change->c_ext);
+	}
+	return TYPE(use) == OPOBJECT || !IS_REG(v);
+}
+
+
+
+
+STATIC search_backwards(use,v,found,def)
+	line_p use, *def;
+	short v;
+	bool *found;
+{
+	/* Search backwards in the current basic block,
+	 * starting at 'use', trying to find a definition
+	 * of the variable referenced by 'use', whose variable
+	 * number is v. If the definition found is an
+	 * implicit one, return 0 as def.
+	 */
+
+	register line_p l;
+
+	for (l = PREV(use); l != (line_p) 0; l = PREV(l)) {
+		if (does_expl_def(l) && same_var(use,l)) {
+			*found = TRUE;
+			*def = l;
+			return;
+		}
+		if (does_impl_def(l) && affected(use,v,l)) {
+			*found = TRUE;
+			*def = (line_p) 0;
+			return;
+		}
+	}
+	*found = FALSE;
+}
+
+
+
+
+STATIC short outer_def(vdefs,in)
+	cset vdefs, in;
+{
+	/* See if there is a unique definition of variable
+	 * v reaching the beginning of block b.
+	 * 'vdefs' is vardefs[v], 'in' is IN(b).
+	 */
+
+	short n,defnr = 0;
+	Cindex i;
+
+	for (i = Cfirst(vdefs); i != (Cindex) 0; i = Cnext(i,vdefs)) {
+		n = Celem(i);
+		if (Cis_elem(EXPL_TO_DEFNR(n),in)) {
+			if (defnr != 0) return  0;
+			/* If there was already a def., there's no unique one */
+			defnr = n;
+		}
+	}
+	return defnr;
+}
+
+
+
+
+line_p unique_def(use,b,defnr_out)
+	line_p use;
+	bblock_p b;
+	short *defnr_out;
+{
+	/* See if there is one unique explicit definition
+	 * of the variable used by 'use', that reaches 'use'.
+	 */
+
+	short v;
+	bool found;
+	line_p def =  (line_p) 0;
+
+	*defnr_out = 0;
+	var_nr(use,&v,&found);
+	if (found) {
+		/* We do maintain ud-info for this variable.
+		 * See if there is a previous explicit definition
+		 * in the current basic block.
+		 */
+		search_backwards(use,v,&found,&def);
+		if (!found && !Cis_elem(IMPLICIT_DEF(v),IN(b))) {
+			/* See if there is a unique explicit definition
+			 * outside the current block, reaching the
+			 * beginning of the current block.
+			 */
+			*defnr_out = outer_def(vardefs[v],IN(b));
+			def = (*defnr_out == 0 ? (line_p) 0 : defs[*defnr_out]);
+		}
+	}
+	return def;
+}
+
+
+
+fold_const(l,b,val)
+	line_p l;
+	bblock_p b;
+	offset val;
+{
+	/* Perform the substitutions required for constant folding */
+
+	line_p n;
+
+	n = int_line(val);
+	switch(INSTR(l)) {
+		case op_lol:
+		case op_loe:
+			n->l_instr = op_loc;
+			break;
+		case op_ldl:
+		case op_lde:
+			n->l_instr = op_ldc;
+			break;
+		default:
+			assert (FALSE);
+	}
+	repl_line(l,n,b);
+}

+ 24 - 0
util/ego/ud/ud_const.h

@@ -0,0 +1,24 @@
+
+/* C O N S T A N T   P R O P A G A T I O N */
+
+extern line_p unique_def();	/* ( line_p use; bblock_p b; short *defnr_out;)
+				 * See if there is a unique explicit definition
+				 * of the variable used by 'use' that
+				 * reaches 'use'.
+				 */
+extern bool value_known();	/* (line_p def; offset *val_out)
+				 * See if the value stored by definition 'def'
+				 * is known statically (i.e. is a constant).
+				 */
+extern fold_const();		/* (line_p l; bblock_p b; offset val)
+				 * Perform the substitutions required for
+				 * constant folding.
+				 */
+extern bool is_use();		/* (line_p l)
+				 * See if 'l' is a use of a variable.
+				 */
+extern bool affected();		/* (line_p use,l; short  v)
+				 * See if the variable referenced by 'use' may 
+				 * be changed by instruction l, which is 
+				 * either a cal, cai or an indirect assignment.
+				 */

+ 390 - 0
util/ego/ud/ud_copy.c

@@ -0,0 +1,390 @@
+/* C O P Y   P R O P A G A T I O N */
+
+#include "../share/types.h"
+#include "../ud/ud.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/alloc.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/def.h"
+#include "../share/aux.h"
+#include "../share/locals.h"
+#include "../../../h/em_mnem.h"
+#include "../../../h/em_pseu.h"
+#include "../../../h/em_spec.h"
+#include "../ud/ud_defs.h"
+#include "ud_copy.h"
+#include "ud_const.h"
+#include "ud_aux.h"
+
+
+
+line_p *copies;		/* table of copies; every entry points to the
+			 * store-instruction.
+			 */
+short *def_to_copynr;	/* table that maps a 'definition'-number to a 
+			 * 'copy' number.
+			 */
+short nrcopies;		/* number of copies in the current procedure
+			 * (length of copies-table)
+			 */
+
+#define COPY_NR(c)	def_to_copynr[c]
+#define CHANGED(v,b) (Cis_elem(v,CHGVARS(b)) || Cis_elem(IMPLICIT_DEF(v),GEN(b)))
+
+
+#define COUNT 0
+#define MAP 1
+
+STATIC traverse_defs(p,action)
+	proc_p p;
+	int action;
+{
+	bblock_p b;
+	line_p l;
+	bool found;
+	short defcnt,v,cnt;
+
+	defcnt = 1;
+	if (action == COUNT) {
+		nrcopies = 0;
+	} else {
+		copies = (line_p *) newmap(nrcopies);
+		def_to_copynr = newtable(nrdefs);
+		cnt = 1;
+	}
+	if (defcnt > nrdefs) return;
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+			if (defs[defcnt] == l) {
+				if (is_copy(l)) {
+					var_nr(PREV(l),&v,&found);
+					if (found) {
+						if (action == COUNT) {
+							nrcopies++;
+						} else {
+							copies[cnt] = l;
+							def_to_copynr[defcnt] =
+							   cnt++;
+						}
+					}
+				}
+				if (++defcnt > nrdefs) return;
+			}
+		}
+	}
+}
+
+
+
+STATIC make_copytab(p)
+	proc_p p;
+{
+	/* Make a table of all copies appearing in procedure p.
+	 * We first count how many there are, because we
+	 * have to allocate a dynamic array of the correct size.
+	 */
+
+	traverse_defs(p,COUNT);
+	traverse_defs(p,MAP);
+}
+
+
+
+STATIC bool is_changed(varl,start,stop)
+	line_p varl, start, stop;
+{
+	/* See if the variable used by instruction varl
+	 * is changed anywhere between 'start' and 'stop'
+	 */
+
+	register line_p l;
+	short v;
+	bool found;
+
+	var_nr(varl,&v,&found);
+	if (!found) {
+		return TRUE; /* We don't maintain ud-info for this variable */
+	}
+	for (l = start; l != (line_p) 0 && l != stop; l = l->l_next) {
+		if (does_expl_def(l) && same_var(varl,l)) return TRUE;
+		if (does_impl_def(l) && affected(varl,v,l)) return TRUE;
+	}
+	return FALSE;
+}
+
+
+
+STATIC gen_kill_copies(p)
+	proc_p p;
+{
+	/* Compute C_GEN and C_KILL for every basic block
+	 * of p.
+	 */
+
+	register line_p l;
+	register bblock_p b,n;
+	short v;
+	bool found;
+	short copycnt = 1, defcnt = 1;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		C_GEN(b) = Cempty_set(nrcopies);
+		C_KILL(b) = Cempty_set(nrcopies);
+	}
+	if (nrcopies == 0) return;
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+			if (copies[copycnt] == l) {
+				var_nr(PREV(l),&v,&found);
+				assert(found);
+				for (n = p->p_start; n != (bblock_p) 0;
+				     n = n->b_next) {
+					if (n != b && CHANGED(v,n) &&
+					    Cis_elem(EXPL_TO_DEFNR(defcnt),IN(n))) {
+						Cadd(copycnt,&C_KILL(n));
+					}
+				}
+				if (is_changed(PREV(l),l,(line_p) 0)) {
+					Cadd(copycnt,&C_KILL(b));
+				} else {
+					Cadd(copycnt,&C_GEN(b));
+				}
+				if (++copycnt > nrcopies) return;
+			}
+			if (defs[defcnt] == l) defcnt++;
+		}
+	}
+}
+
+
+
+STATIC intersect_outs(bbset,setp,full_set)
+	lset bbset;
+	cset *setp,full_set;
+{
+	/* Take the intersection of C_OUT(b), for all b in bbset,
+	 * and put the result in setp.
+	 */
+
+	Lindex i;
+
+	Ccopy_set(full_set,setp);
+	for (i = Lfirst(bbset); i != (Lindex) 0; i = Lnext(i,bbset)) {
+		Cintersect(C_OUT((bblock_p) Lelem(i)), setp);
+	}
+}
+
+
+
+STATIC init_cin(p,full_set)
+	proc_p p;
+	cset full_set;
+{
+	/* Initialize C_IN(b) and C_OUT(b), for every basic block b.
+	 * C_IN of the root of the CFG (i.e. the procedure entry block)
+	 * will contain every copy, as it trivially holds that for
+	 * every copy "s: A := B" there is no assignment to B on any
+	 * path from s to the beginning of the root (because PRED(root)=empty).
+	 * C_IN and C_OUT of the root will never be changed.
+	 * For all remaining blocks b, C_IN(b) is initialized to the set of
+	 * all copies, and C_OUT is set to all copies but those killed in b.
+	 */
+
+	bblock_p b;
+	bblock_p root = p->p_start;
+
+	C_IN(root) = Cempty_set(nrcopies);
+	Ccopy_set(full_set,&C_IN(root)); /* full_set is the set of all copies */
+	/* C_OUT(root) = {all copies} - C_KILL(root) + C_GEN(root) */
+	C_OUT(root) = Cempty_set(nrcopies);
+	Ccopy_set(full_set,&C_OUT(root));
+	Csubtract(C_KILL(root),&C_OUT(root));
+	Cjoin(C_GEN(root),&C_OUT(root));
+	for (b = root->b_next; b != (bblock_p) 0; b = b->b_next) {
+		C_IN(b) = Cempty_set(nrcopies);
+		Ccopy_set(full_set,&C_IN(b));
+		C_OUT(b) = Cempty_set(nrcopies);
+		Ccopy_set(full_set,&C_OUT(b));
+		Csubtract(C_KILL(b),&C_OUT(b));
+	}
+}
+
+
+
+STATIC solve_cin(p)
+	proc_p p;
+{
+	/* Solve the data flow equations for reaching
+	 * definitions of procedure p.
+	 * These equations are:
+	 *  (1)  C_OUT(b) = C_IN(b) - C_KILL(b) + C_GEN(b)
+	 *  (2)  C_IN(b)  = C_OUT(p1) * .. * C_OUT(pn)
+	 *  (3)  C_IN(root) = {all copies} ;
+	 *       where PRED(b) = {p1, .. , pn}
+	 *	 and '*' denotes set intersection.
+	 * We use the iterative algorithm of Aho&Ullman to
+	 * solve the equations.
+	 */
+
+	register bblock_p b;
+	bool     change;
+	cset     newin,full_set;
+	short n;
+
+	/* initializations */
+	full_set = Cempty_set(nrcopies);
+	for (n = 1; n <= nrcopies; n++) {
+		Cadd(n,&full_set);
+	}
+	newin = Cempty_set(nrcopies);
+	init_cin(p,full_set);
+	change = TRUE;
+	/* main loop */
+	while (change) {
+		change = FALSE;
+		for (b = p->p_start->b_next; b != (bblock_p) 0; b = b->b_next) {
+			intersect_outs(b->b_pred, &newin,full_set);
+			/* newin = C_OUT(p1) * .. * C_OUT(pn) */
+			if (!Cequal(newin,C_IN(b))) {
+				change = TRUE;
+				Ccopy_set(newin, &C_IN(b));
+				Ccopy_set(C_IN(b),   &C_OUT(b));
+				Csubtract(C_KILL(b), &C_OUT(b));
+				Cjoin(C_GEN(b),      &C_OUT(b));
+			}
+		}
+	}
+	Cdeleteset(newin);
+	Cdeleteset(full_set);
+}
+
+
+
+copy_analysis(p)
+	proc_p p;
+{
+	/* Determine which copies procedure p has. Compute C_IN(b),
+	 * for every basic block b.
+	 */
+
+	make_copytab(p); /* Make a table of all copies */
+	gen_kill_copies(p); /* Compute C_GEN(b) and C_KILL(b), for every b */
+	solve_cin(p); /* Solve equations for C_IN(b) */
+}
+
+
+
+bool is_copy(def)
+	line_p def;
+{
+	/* See if the definition def is also a 'copy', i.e. an
+	 * statement of the form 'A := B' (or, in EM terminology:
+	 * a sequence 'Load Variable; Store Variable').
+	 */
+
+
+	line_p lhs;
+	int instr;
+
+	lhs = PREV(def);
+	if (lhs == (line_p) 0) return FALSE;
+	instr = INSTR(def);
+	switch(INSTR(lhs)) {
+		case op_lol:
+		case op_loe:
+			return instr == op_stl || instr == op_ste;
+		case op_ldl:
+		case op_lde:
+			return instr == op_sdl || instr == op_sde;
+		default:
+			return FALSE;
+	}
+	/* NOTREACHED */
+}
+
+
+
+fold_var(old,new,b)
+	line_p old, new;
+	bblock_p b;
+{
+	/* The variable referenced by the EM instruction 'old'
+	 * must be replaced by the variable referenced by 'new'.
+	 */
+
+	line_p l;
+
+/* DEBUGGING: 
+	local_p loc;
+	short nr;
+	bool ok;
+	if (TYPE(old) == OPOBJECT) {
+		printf("global var.");
+	} else {
+		printf("local var. with off. %D",off_set(old));
+		find_local(off_set(old),&nr,&ok);
+		assert(ok);
+		loc = locals[nr];
+		printf(",score %D",loc->lc_score);
+	}
+	printf(" replaced by ");
+	if (TYPE(new) == OPOBJECT) {
+		printf("global var.");
+	} else {
+		printf("local var. with off. %D",off_set(new));
+		find_local(off_set(new),&nr,&ok);
+		assert(ok);
+		loc = locals[nr];
+		printf(",score %D",loc->lc_score);
+	}
+	printf("\n");
+END DEBUG */
+	l = old;
+	if (TYPE(l) != TYPE(new)) {
+		l = newline(TYPE(new));
+		l->l_instr = INSTR(new);
+		repl_line(old,l,b);
+	}
+	switch(TYPE(new)) {
+		case OPOBJECT:
+			OBJ(l) = OBJ(new);
+			break;
+		case OPSHORT:
+			SHORT(l) = SHORT(new);
+			break;
+		case OPOFFSET:
+			OFFSET(l) = OFFSET(new);
+			break;
+		default:
+			assert(FALSE);
+	}
+}
+
+
+
+bool value_retained(copy,defnr,use,b)
+	line_p copy,use;
+	short  defnr;
+	bblock_p b;
+{
+	/* See if the right hand side variable of the
+	 * copy still has the same value at 'use'.
+	 * If the copy and the use are in the same
+	 * basic block (defnr = 0), search from the
+	 * copy to the use, to see if the rhs variable
+	 * is changed. If the copy is in another block,
+	 * defnr is the definition-number of the copy.
+	 * Search from the beginning of the block to
+	 * the use, to see if the rhs is changed; if not,
+	 * check that the copy is in C_IN(b).
+	 */
+
+	line_p rhs, start;
+
+	rhs = PREV(copy);
+	start = (defnr == 0 ? copy : b->b_start);
+	return !is_changed(rhs,start,use) &&
+	       (defnr == 0 || Cis_elem(COPY_NR(defnr), C_IN(b)));
+}

+ 41 - 0
util/ego/ud/ud_copy.h

@@ -0,0 +1,41 @@
+
+/* C O P Y   P R O P A G A T I O N */
+
+extern line_p *copies;		/* table of copies; every entry points to the
+				 * store-instruction.
+				 */
+extern short *def_to_copynr;	/* Table that maps a 'definition'-number to a
+				 * 'copy' number.
+				 */
+extern short nrcopies;		/* number of copies in the current procedure
+				 * (length of copies-table)
+				 */
+
+extern copy_analysis();		/* (proc_p p)
+				 * Determine which copies procedure p has.
+				 * Compute C_IN(b), for every basic block b.
+				 */
+extern bool is_copy();		/* (line_p def)
+				 * See if the definition def is also a 'copy',
+				 * i.e. an statement of the form
+				 * 'A := B' (or, in EM terminology:
+				 * a sequence 'Load Variable; Store Variable').
+				 */
+extern fold_var();		/* (line_p old,new; bblock_p b)
+				 * The variable referenced by the
+				 * EM instruction 'old' must be replaced
+				 * by the variable referenced by 'new'.
+				 */
+extern bool value_retained();	/* (line_p copy; short defnr; line_p use;
+				 * bblock_p b)
+				 * See if the right hand side variable of the
+				 * copy still has the same value at 'use'.
+				 * If the copy and the use are in the same
+				 * basic block (defnr = 0), search from the
+				 * copy to the use, to see if the rhs variable
+				 * is changed. If the copy is in another block,
+				 * defnr is the definition-number of the copy.
+				 * Search from the beginning of the block to
+				 * the use, to see if the rhs is changed;
+				 * if not, check that the copy is in C_IN(b).
+				 */

+ 378 - 0
util/ego/ud/ud_defs.c

@@ -0,0 +1,378 @@
+
+/*  U S E  -  D E F I N I T I O N   A N A L Y S I S
+ *
+ *  U D _ D E F S . C
+ */
+
+#include "../share/types.h"
+#include "ud.h"
+#include "../share/debug.h"
+#include "../share/global.h"
+#include "../share/lset.h"
+#include "../share/cset.h"
+#include "../share/map.h"
+#include "../share/locals.h"
+#include "../../../h/em_mnem.h"
+#include "ud_defs.h"
+#include "../share/alloc.h"
+#include "../share/aux.h"
+
+#define BODY_KNOWN(p)	(p->p_flags1 & (byte) PF_BODYSEEN)
+#define CHANGE_INDIR(p)	(p->p_change->c_flags & CF_INDIR)
+
+short nrdefs;		/* total number of definitions */
+short nrexpldefs;	/* number of explicit definitions */
+line_p *defs;
+cset *vardefs;
+
+STATIC cset all_globl_defs, all_indir_defs;
+/* auxiliary sets, used by gen_sets */
+
+
+bool does_expl_def(l)
+	line_p l;
+{
+	/* See if instruction l does an explicit definition */
+
+	switch(INSTR(l)) {
+		case op_stl:
+		case op_sdl:
+		case op_ste:
+		case op_sde:
+		case op_inl:
+		case op_del:
+		case op_ine:
+		case op_dee:
+		case op_zrl:
+		case op_zre:
+			return TRUE;
+		default:
+			return FALSE;
+	}
+	/* NOTREACHED */
+}
+
+
+
+bool does_impl_def(l)
+	line_p l;
+{
+	/* See if instruction l does an implicit definition */
+
+	switch(INSTR(l)) {
+		case op_cal:
+		case op_cai:
+		case op_sil:
+		case op_stf:
+		case op_sti:
+		case op_sts:
+		case op_sdf:
+		case op_sar:
+		case op_blm:
+		case op_bls:
+		case op_zrf:
+			return TRUE;
+		default:
+			return FALSE;
+	}
+}
+
+
+make_defs(p)
+	proc_p p;
+{
+	/* Make a map of all explicit definitions
+	 * occurring in p.
+	 * Determine the set of explicit definitions
+	 * of variable v (i.e. vardefs[v]), for all
+	 * v from 1 to nrvars.
+	 * For every basic block b, compute CHGVARS(b),
+	 * i.e. the set of variables changed in b by an
+	 * explicit definition.
+	 */
+
+	register bblock_p b;
+	register  line_p l;
+	short v, i, cnt = 0;
+	bool  found;
+
+	/* first count the number of definitions */
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		for (l = b->b_start; l != (line_p) 0 ; l = l->l_next) {
+			if (does_expl_def(l)) {
+				var_nr(l,&v,&found);
+				if (!found) continue; /* no ud for this var */
+				cnt++;
+			}
+		}
+	}
+	nrexpldefs = cnt;
+	/* now allocate the defs table and the vardefs table*/
+	defs = (line_p *) newmap(nrexpldefs);
+	vardefs = (cset *) newmap(nrvars);
+	for (i = 1; i <= nrvars; i++) {
+		vardefs[i] = Cempty_set(nrexpldefs);
+	}
+	cnt = 1;
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		CHGVARS(b) =Cempty_set(nrvars);
+		for (l = b->b_start; l != (line_p) 0 ; l = l->l_next) {
+			if (does_expl_def(l)) {
+				var_nr(l,&v,&found);
+				if (!found) continue;
+				assert (v <= nrvars);
+				Cadd(v,&CHGVARS(b));
+				defs[cnt] = l;
+				Cadd(cnt,&vardefs[v]);
+				cnt++;
+			}
+		}
+	}
+}
+
+
+
+STATIC init_gen(nrdefs)
+	short nrdefs;
+{
+	/* Initializing routine of gen_sets. Compute the set
+	 * of all implicit definitions to global variables
+	 * (all_globl_defs) and the set of all implicit
+	 * definition generated by an indirect assignment
+	 * through a pointer (all_indir_defs).
+	 */
+
+	short v;
+
+	all_globl_defs = Cempty_set(nrdefs);
+	all_indir_defs = Cempty_set(nrdefs);
+	for (v = 1; v <= nrglobals; v++) {
+		Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)), &all_globl_defs);
+		Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)), &all_indir_defs);
+	}
+	for (v = 1; v <= nrlocals; v++) {
+		if (!IS_REGVAR(locals[v])) {
+			Cadd(IMPLICIT_DEF(LOC_TO_VARNR(v)), &all_indir_defs);
+		}
+	}
+}
+
+
+
+STATIC clean_gen()
+{
+	Cdeleteset(all_globl_defs);
+	Cdeleteset(all_indir_defs);
+}
+
+
+
+STATIC bool same_target(l,defnr)
+	line_p l;
+	short  defnr;
+{
+	/* See if l defines the same variable as def */
+
+	line_p def;
+	short  v;
+
+	if (IS_IMPL_DEF(defnr)) {
+		/* An implicitly generated definition */
+		v = IMPL_VAR(TO_IMPLICIT(defnr));
+		if (IS_GLOBAL(v)) {
+			return TYPE(l) == OPOBJECT &&
+				OBJ(l)->o_globnr == TO_GLOBAL(v);
+		} else {
+			return TYPE(l) != OPOBJECT &&
+				locals[TO_LOCAL(v)]->lc_off == off_set(l);
+		}
+	}
+	/* explicit definition */
+	def = defs[TO_EXPLICIT(defnr)];
+	if (TYPE(l) == OPOBJECT) {
+		return TYPE(def) == OPOBJECT && OBJ(def) == OBJ(l);
+	} else {
+		return TYPE(def) != OPOBJECT && off_set(def) == off_set(l);
+	}
+}
+
+
+
+STATIC rem_prev_defs(l,gen_p)
+	line_p l;
+	cset   *gen_p;
+{
+	/* Remove all definitions in gen that define the
+	 * same variable as l.
+	 */
+
+	cset gen;
+	Cindex i,next;
+
+	gen = *gen_p;
+	for (i = Cfirst(gen); i != (Cindex) 0; i = next) {
+		next = Cnext(i,gen);
+		if (same_target(l,Celem(i))) {
+			Cremove(Celem(i),gen_p);
+		}
+	}
+}
+
+
+
+
+STATIC impl_globl_defs(p,gen_p)
+	proc_p p;
+	cset   *gen_p;
+{
+	/* Add all definitions of global variables
+	 * that are generated implicitly by a call
+	 * to p to the set gen_p.
+	 */
+
+	Cindex i;
+	short v;
+	cset ext = p->p_change->c_ext;
+
+	for (i = Cfirst(ext); i != (Cindex) 0; i = Cnext(i,ext)) {
+		if (( v = omap[Celem(i)]->o_globnr) != (short) 0) {
+			/* the global variable v, for which we do
+			 * maintain ud-info is changed by p, so a
+			 * definition of v is generated implicitly.
+			 */
+			Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)),gen_p);
+		}
+	}
+}
+
+
+
+STATIC impl_gen_defs(l,gen_p)
+	line_p l;
+	cset   *gen_p;
+{
+	/* Add all definitions generated implicitly by instruction l
+	 * to gen_p. l may be a call or some kind of indirect
+	 * assignment.
+	 */
+
+	proc_p p;
+
+	switch(INSTR(l)) {
+		case op_cal:
+			p = PROC(l);
+			if (BODY_KNOWN(p)) {
+				impl_globl_defs(p,gen_p);
+				if (!CHANGE_INDIR(p)) return;
+				break;
+			}
+			/* else fall through ... */
+		case op_cai:
+			/* Indirect subroutine call or call to
+			 * a subroutine whose body is not available.
+			 * Assume worst case; all global
+			 * variables are changed and
+			 * the called proc. does a store-
+			 * indirect.
+			 */
+			Cjoin(all_globl_defs,gen_p);
+			break;
+		/* default: indir. assignment */
+	}
+	Cjoin(all_indir_defs,gen_p);
+}
+
+
+
+
+gen_sets(p)
+	proc_p p;
+{
+	/* Compute for every basic block b of p the
+	 * set GEN(b) of definitions in b (explicit as
+	 * well as implicit) that reach the end of b.
+	 */
+	
+	register bblock_p b;
+	register line_p   l;
+	short defnr = 1;
+
+	init_gen(nrdefs);  /* compute all_globl_defs and all_indir_defs */
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		GEN(b) = Cempty_set(nrdefs);
+		for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
+			if (does_impl_def(l)) {
+				impl_gen_defs(l,&GEN(b));
+				/* add definitions implicitly
+				 * generated by subroutine call
+				 * or indir. pointer assignment.
+				 */
+			} else {
+				if (does_expl_def(l)) {
+					if (defnr <= nrdefs && defs[defnr] == l) {
+						rem_prev_defs(l,&GEN(b));
+						/* previous defs. of same var
+						 * don't reach the end of b.
+						 */
+						Cadd(EXPL_TO_DEFNR(defnr),&GEN(b));
+						defnr++;
+					}
+				}
+			}
+		}
+	}
+	clean_gen();  /* clean up */
+}
+
+
+
+
+STATIC killed_defs(v,b)
+	short v;
+	bblock_p b;
+{
+	/* Put all definitions of v occurring outside b
+	 * in KILL(b). In fact, we also put explicit
+	 * definitions occurring in b, but not reaching the
+	 * end of b, in KILL(b). This causes no harm.
+	 */
+
+	Cindex i;
+	short d;
+
+	for (i = Cfirst(vardefs[v]); i != (Cindex) 0; i = Cnext(i,vardefs[v])) {
+		d = Celem(i);  /* d is an explicit definition of v */
+		if (!Cis_elem(EXPL_TO_DEFNR(d),GEN(b))) {
+			Cadd(EXPL_TO_DEFNR(d),&KILL(b));
+		}
+	}
+	/* Also add implicit definition of v to KILL(b) */
+	Cadd(IMPLICIT_DEF(v),&KILL(b));
+}
+
+
+
+
+kill_sets(p)
+	proc_p p;
+{
+	/* For every basic block b of p compute the set
+	 * KILL(b) of definitions outside b that define
+	 * variables redefined by b.
+	 * KILL(b) contains explicit as well as implicit
+	 * definitions.
+	 */
+
+	register bblock_p b;
+	Cindex i;
+	short v;
+
+	for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
+		KILL(b) = Cempty_set(nrdefs);
+		for (i = Cfirst(CHGVARS(b)); i != (Cindex) 0;
+						i = Cnext(i,CHGVARS(b))) {
+			v = Celem(i); /* v is a variable changed in b */
+			killed_defs(v,b);
+		}
+	}
+}

+ 51 - 0
util/ego/ud/ud_defs.h

@@ -0,0 +1,51 @@
+/*  U S E  -  D E F I N I T I O N   A N A L Y S I S
+ *
+ *  U D _ D E F S . H
+ */
+
+extern short nrdefs;		/* total number of definitions */
+extern short nrexpldefs;	/* number of explicit definitions */
+extern line_p *defs;		/* map of explicit definitions */
+extern cset *vardefs;		/* set of explicit defs. of all variables */
+
+extern make_defs();		/* (proc_p p)
+				 * Compute defs[], vardefs[]
+				 * and CHGVARS(b) (for every b).
+				 */
+extern gen_sets();		/* (proc_p p)
+				 * Compute GEN(b) (for every b).
+				 */
+extern kill_sets();		/* (proc_p p)
+				 *Compute KILL(b) (for every b).
+				 */
+extern bool does_expl_def();	/* (line_p l)
+				 * See if instruction l does an explicit
+				 * definition (e.g. a STL).
+				 */
+extern bool does_impl_def();	/* (line_p l)
+				 * See if instruction l does an implicit
+				 * definition (e.g. a CAL).
+				 */
+
+
+/* Two kinds of definitions exist:
+ *  - an explicit definition is an assignment to a single
+ *    variable (e.g. a STL, STE, INE).
+ *  - an implicit definition is an assignment to a variable
+ *    performed via a subroutine call or an
+ *    indirect assignment (through a pointer).
+ * Every explicit definition has an 'explicit definition number',
+ * which is its index in the 'defs' table.
+ * Every implicit definition has an 'implicit definition number',
+ * which is the 'variable number' of the changed variable.
+ * Every such definition also has a 'definition number'.
+ * Conversions exist between these numbers.
+ */
+
+#define TO_EXPLICIT(defnr)	(defnr - nrvars)
+#define TO_IMPLICIT(defnr)	(defnr)
+#define EXPL_TO_DEFNR(explnr)	(explnr + nrvars)
+#define IMPL_TO_DEFNR(implnr)	(implnr)
+#define IMPLICIT_DEF(v)		(v)
+#define IMPL_VAR(defnr)		(defnr)
+#define IS_IMPL_DEF(defnr)	(defnr <= nrvars)

+ 18 - 0
util/ego/ud/ud_locals.h

@@ -0,0 +1,18 @@
+/*  U S E  -  D E F I N I T I O N   A N A L Y S I S
+ *
+ *  U D _ L O C A L S . H
+ */
+
+extern local_p *locals;		/* table of locals, index is local-number */
+extern short   nrlocals;	/* number of locals for which we keep ud-info */
+
+extern make_localtab();		/* (proc_p p) 
+				 * Analyse the text of procedure p to determine
+				 * which local variable p has. Make a table of
+				 * these variables ('locals') and count them
+				 * ('nrlocals'). Also collect register messages.
+				 */
+extern var_nr();		/* (line_p l; short *nr_out;bool *found_out)
+				 * Compute the 'variable number' of the
+				 * variable referenced by EM instruction l.
+				 */