From: bal Date: Mon, 26 Nov 1984 13:43:22 +0000 (+0000) Subject: Initial revision X-Git-Tag: release-5-5~5975 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=7b798175adb00a55cd956cd8b89a4e6e031ae2a2;p=ack.git Initial revision --- diff --git a/util/ego/cf/Makefile b/util/ego/cf/Makefile new file mode 100644 index 000000000..3e4b346db --- /dev/null +++ b/util/ego/cf/Makefile @@ -0,0 +1,57 @@ +EMH=../../../h +EML=../../../lib +CFLAGS= +SHARE=../share +CF=. +OBJECTS=cf.o cf_idom.o cf_loop.o cf_succ.o +SHOBJECTS=$(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)/aux.o +SRC=cf.h cf_succ.h cf_idom.h cf_loop.h cf.c cf_succ.c cf_idom.c cf_loop.c +.c.o: + cc $(CFLAGS) -c $< +all: $(OBJECTS) +cf: \ + $(OBJECTS) $(SHOBJECTS) + cc -o cf -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a +lpr: + pr $(SRC) | lpr +dumpflop: + tar -uf /mnt/ego/cf/cf.tarf $(SRC) +# the next lines are generated automatically +# AUTOAUTOAUTOAUTOAUTOAUTO +cf.o: ../../../h/em_mnem.h +cf.o: ../share/alloc.h +cf.o: ../share/cset.h +cf.o: ../share/debug.h +cf.o: ../share/files.h +cf.o: ../share/get.h +cf.o: ../share/global.h +cf.o: ../share/lset.h +cf.o: ../share/map.h +cf.o: ../share/put.h +cf.o: ../share/types.h +cf.o: cf.h +cf.o: cf_idom.h +cf.o: cf_loop.h +cf.o: cf_succ.h +cf_idom.o: ../share/alloc.h +cf_idom.o: ../share/debug.h +cf_idom.o: ../share/lset.h +cf_idom.o: ../share/types.h +cf_idom.o: cf.h +cf_loop.o: ../share/alloc.h +cf_loop.o: ../share/debug.h +cf_loop.o: ../share/lset.h +cf_loop.o: ../share/types.h +cf_loop.o: cf.h +cf_succ.o: ../../../h/em_flag.h +cf_succ.o: ../../../h/em_mnem.h +cf_succ.o: ../../../h/em_pseu.h +cf_succ.o: ../../../h/em_spec.h +cf_succ.o: ../share/cset.h +cf_succ.o: ../share/debug.h +cf_succ.o: ../share/def.h +cf_succ.o: ../share/global.h +cf_succ.o: ../share/lset.h +cf_succ.o: ../share/map.h +cf_succ.o: ../share/types.h +cf_succ.o: cf.h diff --git a/util/ego/cf/cf.c b/util/ego/cf/cf.c new file mode 100644 index 000000000..37c0d5602 --- /dev/null +++ b/util/ego/cf/cf.c @@ -0,0 +1,334 @@ +/* C O N T R O L F L O W + * + * M A I N R O U T I N E + */ + +#include +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/map.h" +#include "../share/files.h" +#include "../share/global.h" +#include "../share/alloc.h" +#include "../share/lset.h" +#include "../share/cset.h" +#include "../share/get.h" +#include "../share/put.h" +#include "../../../h/em_mnem.h" +#include "cf.h" +#include "cf_succ.h" +#include "cf_idom.h" +#include "cf_loop.h" + + +STATIC cset lpi_set; /* set of procedures used in LPI instruction */ +STATIC cset cai_set; /* set of all procedures doing a CAI */ + +STATIC interproc_analysis(p) + proc_p p; +{ + /* Interprocedural analysis of a procedure p determines: + * - all procedures called by p (the 'call graph') + * - the set of objects changed by p (directly) + * - whether p does a load-indirect (loi,lof etc.) + * - whether p does a store-indirect (sti, stf etc.) + * The changed/used variables information will be + * transitively closed, i.e. if P calls Q and Q changes + * a variable X, the P changes X too. + * (The same applies for used variables and for use/store + * indirect). + * The transitive closure will be computed by main + * after all procedures have been processed. + */ + + bblock_p b; + line_p lnp; + bool inloop; + + /* Allocate memory for structs and sets */ + + p->p_use = newuse(); + p->p_change = newchange(); + p->p_change->c_ext = Cempty_set(olength); + p->p_calling = Cempty_set(plength); + + for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) { + inloop = (Lnrelems(b->b_loops) > 0); + for (lnp = b->b_start; lnp != (line_p) 0; lnp = lnp->l_next) { + /* for all instructions of p do */ + switch(INSTR(lnp)) { + case op_cal: + Cadd(PROC(lnp)->p_id, &p->p_calling); + /* add called proc to p_calling */ + if (inloop) { + CALLED_IN_LOOP(PROC(lnp)); + } + break; + case op_cai: + Cadd(p->p_id,&cai_set); + break; + case op_lpi: + Cadd(PROC(lnp)->p_id, &lpi_set); + /* All procedures that have their names used + * in an lpi instruction, may be called via + * a cai instruction. + */ + PROC(lnp)->p_flags1 |= PF_LPI; + break; + case op_ste: + case op_sde: + case op_ine: + case op_dee: + case op_zre: + Cadd(OBJ(lnp)->o_id, &p->p_change->c_ext); + /* Add changed object to c_ext */ + break; + case op_lil: + case op_lof: + case op_loi: + case op_los: + case op_lar: + p->p_use->u_flags |= UF_INDIR; + /* p does a load-indirect */ + break; + case op_sil: + case op_stf: + case op_sti: + case op_sts: + case op_sar: + p->p_change->c_flags |= CF_INDIR; + /* p does a store-indirect */ + break; + case op_blm: + case op_bls: + p->p_use->u_flags |= UF_INDIR; + p->p_change->c_flags |= CF_INDIR; + /* p does both */ + break; + case op_mon: + printf("mon not yet implemented\n"); + break; + case op_lxl: + case op_lxa: + curproc->p_flags1 |= PF_ENVIRON; + break; + } + } + } +} + + +STATIC cf_cleanproc(p) + proc_p p; +{ + /* Remove the extended data structures of p */ + + register bblock_p b; + register Lindex pi; + loop_p lp; + + for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) { + oldcfbx(b->b_extend); + } + for (pi = Lfirst(p->p_loops); pi != (Lindex) 0; pi = Lnext(pi, + p->p_loops)) { + lp = (loop_p) Lelem(pi); + oldcflpx(lp->lp_extend); + } +} + + + +#define CHANGE_INDIR(ch) ((ch->c_flags & CF_INDIR) != 0) +#define USE_INDIR(us) ((us->u_flags & UF_INDIR) != 0) +#define CALLS_UNKNOWN(p) (p->p_flags1 & (byte) PF_CALUNKNOWN) +#define BODY_KNOWN(p) (p->p_flags1 & (byte) PF_BODYSEEN) +#define ENVIRON(p) (p->p_flags1 & (byte) PF_ENVIRON) + + +STATIC bool add_info(q,p) + proc_p q,p; +{ + /* Determine the consequences for used/changed variables info + * of the fact that p calls q. If e.g. q changes a variable X + * then p changes this variable too. This routine is an + * auxiliary routine of the transitive closure process. + * The returned value indicates if there was any change in + * the information of p. + */ + + change_p chp, chq; + use_p usp, usq; + bool diff = FALSE; + + chp = p->p_change; + chq = q->p_change; + usp = p->p_use; + usq = q->p_use; + + if (!BODY_KNOWN(q)) { + /* q is a procedure of which the body is not available + * as EM text. + */ + if (CALLS_UNKNOWN(p)) { + return FALSE; + /* p already called an unknown procedure */ + } else { + p->p_flags1 |= PF_CALUNKNOWN; + return TRUE; + } + } + if (CALLS_UNKNOWN(q)) { + /* q calls a procedure of which the body is not available + * as EM text. + */ + if (!CALLS_UNKNOWN(p)) { + p->p_flags1 |= PF_CALUNKNOWN; + diff = TRUE; + } + } + if (IS_CALLED_IN_LOOP(p) && !IS_CALLED_IN_LOOP(q)) { + CALLED_IN_LOOP(q); + diff = TRUE; + } + if (!Cis_subset(chq->c_ext, chp->c_ext)) { + /* q changes global variables (objects) that + * p did not (yet) change. Add all variables + * changed by q to the c_ext set of p. + */ + Cjoin(chq->c_ext, &chp->c_ext); + diff = TRUE; + } + if (CHANGE_INDIR(chq) && !CHANGE_INDIR(chp)) { + /* q does a change-indirect (sil etc.) + * and p did not (yet). + */ + chp->c_flags |= CF_INDIR; + diff = TRUE; + } + if (USE_INDIR(usq) && !USE_INDIR(usp)) { + /* q does a use-indirect (lil etc.) + * and p dis not (yet). + */ + usp->u_flags |= UF_INDIR; + diff = TRUE; + } + if (ENVIRON(q) && !ENVIRON(p)) { + /* q uses or changes local variables in its + * environment while p does not (yet). + */ + p->p_flags1 |= PF_ENVIRON; + diff = TRUE; + } + return diff; +} + + + +STATIC trans_clos(head) + proc_p head; +{ + /* Compute the transitive closure of the used/changed + * variable information. + */ + + register proc_p p,q; + Cindex i; + bool changes = TRUE; + + while(changes) { + changes = FALSE; + for (p = head; p != (proc_p) 0; p = p->p_next) { + if (!BODY_KNOWN(p)) continue; + for (i = Cfirst(p->p_calling); i != (Cindex) 0; + i = Cnext(i,p->p_calling)) { + q = pmap[Celem(i)]; + if (add_info(q,p)) { + changes = TRUE; + } + } + } + } +} + + + + +indir_calls() +{ + Cindex i; + proc_p p; + + for (i = Cfirst(cai_set); i != (Cindex) 0; i = Cnext(i,cai_set)) { + p = pmap[Celem(i)]; /* p does a CAI */ + Cjoin(lpi_set, &p->p_calling); + } + Cdeleteset(lpi_set); + Cdeleteset(cai_set); +} + + + +main(argc,argv) + int argc; + char *argv[]; +{ + FILE *f, *f2, *gf2; /* The EM input, EM output, basic block output */ + bblock_p g; + short n, kind; + line_p l; + + linecount = 0; + fproc = getptable(pname); /* proc table */ + fdblock = getdtable(dname); /* data block table */ + lpi_set = Cempty_set(plength); + cai_set = Cempty_set(plength); + if ((f = fopen(lname,"r")) == NULL) { + error("cannot open %s", lname); + } + if ((f2 = fopen(lname2,"w")) == NULL) { + error("cannot open %s", lname2); + } + if ((gf2 = fopen(bname2,"w")) == NULL) { + error("cannot open %s",bname2); + } + while (getbblocks(f,&kind,&n,&g,&l)) { + /* read EM text of one unit and + * (if it is a procedure) + * partition it into n basic blocks. + */ + if (kind == LDATA) { + putunit(LDATA,(proc_p) 0,l,gf2,f2); + } else { + curproc->p_start = g; + /* The global variable curproc points to the + * current procedure. It is set by getbblocks + */ + control_flow(g); /* compute pred and succ */ + dominators(g,n); /* compute immediate dominators */ + loop_detection(curproc); /* compute loops */ + interproc_analysis(curproc); + /* Interprocedural analysis */ + cf_cleanproc(curproc); + putunit(LTEXT,curproc,(line_p) 0,gf2,f2); + /* output control flow graph + text */ + } + } + fclose(f); + fclose(f2); + fclose(gf2); + indir_calls(); + trans_clos(fproc); + /* Compute transitive closure of used/changed + * variables information for every procedure. + */ + if ((f = fopen(dname2,"w")) == NULL) { + error("cannot open %s",dname2); + } + putdtable(fdblock,f); + if ((f = fopen(pname2,"w")) == NULL) { + error("cannot open %s",pname2); + } + putptable(fproc,f,TRUE); + exit(0); +} diff --git a/util/ego/cf/cf.h b/util/ego/cf/cf.h new file mode 100644 index 000000000..ca250c0f7 --- /dev/null +++ b/util/ego/cf/cf.h @@ -0,0 +1,13 @@ +/* C O N T R O L F L O W */ + +/* Macro's for extended data structures: */ + +#define B_SEMI b_extend->bx_cf.bx_semi +#define B_PARENT b_extend->bx_cf.bx_parent +#define B_BUCKET b_extend->bx_cf.bx_bucket +#define B_ANCESTOR b_extend->bx_cf.bx_ancestor +#define B_LABEL b_extend->bx_cf.bx_label + +#define LP_BLOCKS lp_extend->lpx_cf.lpx_blocks +#define LP_COUNT lp_extend->lpx_cf.lpx_count +#define LP_MESSY lp_extend->lpx_cf.lpx_messy diff --git a/util/ego/cf/cf_idom.c b/util/ego/cf/cf_idom.c new file mode 100644 index 000000000..6e9695593 --- /dev/null +++ b/util/ego/cf/cf_idom.c @@ -0,0 +1,138 @@ +/* C O N T R O L F L O W + * + * C F _ I D O M . C + */ + + +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/lset.h" +#include "../share/alloc.h" +#include "cf.h" + + +/* The algorithm for finding dominators in a flowgraph + * that is used here, was developed by Thomas Lengauer + * and Robert E. Tarjan of Stanford University. + * The algorithm is described in their article: + * A Fast Algorithm for Finding Dominators + * in a Flowgraph + * which was published in: + * ACM Transactions on Programming Languages and Systems, + * Vol. 1, No. 1, July 1979, Pages 121-141. + */ + + +#define UNREACHABLE(b) (b->B_SEMI == (short) 0) + +short dfs_nr; +bblock_p *vertex; /* dynamically allocated array */ + + +STATIC dfs(v) + bblock_p v; +{ + /* Depth First Search */ + + Lindex i; + bblock_p w; + + v->B_SEMI = ++dfs_nr; + vertex[dfs_nr] = v->B_LABEL = v; + v->B_ANCESTOR = (bblock_p) 0; + for (i = Lfirst(v->b_succ); i != (Lindex) 0; i = Lnext(i,v->b_succ)) { + w = (bblock_p) Lelem(i); + if (w->B_SEMI == 0) { + w->B_PARENT = v; + dfs(w); + } + } +} + + + +STATIC compress(v) + bblock_p v; +{ + if (v->B_ANCESTOR->B_ANCESTOR != (bblock_p) 0) { + compress(v->B_ANCESTOR); + if (v->B_ANCESTOR->B_LABEL->B_SEMI < v->B_LABEL->B_SEMI) { + v->B_LABEL = v->B_ANCESTOR->B_LABEL; + } + v->B_ANCESTOR = v->B_ANCESTOR->B_ANCESTOR; + } +} + + + +STATIC bblock_p eval(v) + bblock_p v; +{ + if (v->B_ANCESTOR == (bblock_p) 0) { + return v; + } else { + compress(v); + return v->B_LABEL; + } +} + + + +STATIC linkblocks(v,w) + bblock_p v,w; +{ + w->B_ANCESTOR = v; +} + + + +dominators(r,n) + bblock_p r; + short n; +{ + /* Compute the immediate dominator of every basic + * block in the control flow graph rooted by r. + */ + + register short i; + Lindex ind, next; + bblock_p v,w,u; + + dfs_nr = 0; + vertex = (bblock_p *) newmap(n); + /* allocate vertex (dynamic array). All remaining + * initializations were done by the routine + * nextblock of get.c. + */ + dfs(r); + for (i = dfs_nr; i > 1; i--) { + w = vertex[i]; + for (ind = Lfirst(w->b_pred); ind != (Lindex) 0; + ind = Lnext(ind,w->b_pred)) { + v = (bblock_p) Lelem(ind); + if (UNREACHABLE(v)) continue; + u = eval(v); + if (u->B_SEMI < w->B_SEMI) { + w->B_SEMI = u->B_SEMI; + } + } + Ladd(w,&(vertex[w->B_SEMI]->B_BUCKET)); + linkblocks(w->B_PARENT,w); + for (ind = Lfirst(w->B_PARENT->B_BUCKET); ind != (Lindex) 0; + ind = next) { + next = Lnext(ind,w->B_PARENT->B_BUCKET); + v = (bblock_p) Lelem(ind); + Lremove(v,&w->B_PARENT->B_BUCKET); + u = eval(v); + v->b_idom = (u->B_SEMI < v->B_SEMI ? u : w->B_PARENT); + } + } + for (i = 2; i <= dfs_nr; i++) { + w = vertex[i]; + if (w->b_idom != vertex[w->B_SEMI]) { + w->b_idom = w->b_idom->b_idom; + } + } + r->b_idom = (bblock_p) 0; + oldmap(vertex,n); /* release memory for dynamic array vertex */ +} diff --git a/util/ego/cf/cf_idom.h b/util/ego/cf/cf_idom.h new file mode 100644 index 000000000..7a644abaa --- /dev/null +++ b/util/ego/cf/cf_idom.h @@ -0,0 +1,15 @@ +/* C O N T R O L F L O W + * + * I M M E D I A T E D O M I N A T O R S + */ + + +extern dominator(); /* (bblock_p head, short n) + * Compute for every basic block its immediate + * dominator. The dominator relation is hence + * recorded as a tree in which every node contains + * a pointer to its parent, which is its + * immediate dominator. + * 'n' is the number of nodes (basic blocks) in + * the control flow graph. + */ diff --git a/util/ego/cf/cf_loop.c b/util/ego/cf/cf_loop.c new file mode 100644 index 000000000..e0a6ffe13 --- /dev/null +++ b/util/ego/cf/cf_loop.c @@ -0,0 +1,400 @@ +/* C O N T R O L F L O W + * + * C F _ L O O P . C + */ + + +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/lset.h" +#include "../share/alloc.h" +#include "../share/aux.h" +#include "cf.h" + +#define MARK_STRONG(b) b->b_flags |= BF_STRONG +#define MARK_FIRM(b) b->b_flags |= BF_FIRM +#define BF_MARK 04 +#define MARK(b) b->b_flags |= BF_MARK +#define MARKED(b) (b->b_flags&BF_MARK) +#define INSIDE_LOOP(b,lp) Lis_elem(b,lp->LP_BLOCKS) + + + +/* The algorithm to detect loops that is used here is taken + * from: Aho & Ullman, Principles of Compiler Design, section 13.1. + * The algorithm uses the dominator relation between nodes + * of the control flow graph: + * d DOM n => every path from the initial node to n goes through d. + * The dominator relation is recorded via the immediate dominator tree + * (b_idom field of bblock struct) from which the dominator relation + * can be easily computed (see procedure 'dom' below). + * The algorithm first finds 'back edges'. A back edge is an edge + * a->b in the flow graph whose head (b) dominates its tail (a). + * The 'natural loop' of back edge n->d consists of those nodes + * that can reach n without going through d. These nodes, plus d + * form the loop. + * The whole process is rather complex, because different back edges + * may result in the same loop and because loops may partly overlap + * each other (without one being nested inside the other). + */ + + + +STATIC bool same_loop(l1,l2) + loop_p l1,l2; +{ + /* Two loops are the same if: + * (1) they have the same number of basic blocks, and + * (2) the head of the back edge of the first loop + * also is part of the second loop, and + * (3) the tail of the back edge of the first loop + * also is part of the second loop. + */ + + return (l1->LP_COUNT == l2->LP_COUNT && + Lis_elem(l1->lp_entry, l2->LP_BLOCKS) && + Lis_elem(l1->lp_end, l2->LP_BLOCKS)); +} + + + +STATIC bool inner_loop(l1,l2) + loop_p l1,l2; +{ + /* Loop l1 is an inner loop of l2 if: + * (1) the first loop has fewer basic blocks than + * the second one, and + * (2) the head of the back edge of the first loop + * also is part of the second loop, and + * (3) the tail of the back edge of the first loop + * also is part of the second loop. + */ + + return (l1->LP_COUNT < l2->LP_COUNT && + Lis_elem(l1->lp_entry, l2->LP_BLOCKS) && + Lis_elem(l1->lp_end, l2->LP_BLOCKS)); +} + + + +STATIC insrt(b,lpb,s_p) + bblock_p b; + lset *lpb; + lset *s_p; +{ + /* Auxiliary routine used by 'natural_loop'. + * Note that we use a set rather than a stack, + * as Aho & Ullman do. + */ + + if (!Lis_elem(b,*lpb)) { + Ladd(b,lpb); + Ladd(b,s_p); + } +} + + +STATIC loop_p natural_loop(d,n) + bblock_p d,n; +{ + /* Find the basic blocks of the natural loop of the + * back edge 'n->d' (i.e. n->d is an edge in the control + * flow graph and d dominates n). The natural loop consists + * of those blocks which can reach n without going through d. + * We find these blocks by finding all predecessors of n, + * up to d. + */ + + loop_p lp; + bblock_p m; + lset loopblocks; + Lindex pi; + lset s; + + lp = newloop(); + lp->lp_extend = newcflpx(); + lp->lp_entry = d; /* loop entry block */ + lp->lp_end = n; /* tail of back edge */ + s = Lempty_set(); + loopblocks = Lempty_set(); + Ladd(d,&loopblocks); + insrt(n,&loopblocks,&s); + while ((pi = Lfirst(s)) != (Lindex) 0) { + m = (bblock_p) Lelem(pi); + Lremove(m,&s); + for (pi = Lfirst(m->b_pred); pi != (Lindex) 0; + pi = Lnext(pi,m->b_pred)) { + insrt((bblock_p) Lelem(pi),&loopblocks,&s); + } + } + lp->LP_BLOCKS = loopblocks; + lp->LP_COUNT = Lnrelems(loopblocks); + return lp; +} + + +STATIC loop_p org_loop(lp,loops) + loop_p lp; + lset loops; +{ + /* See if the loop lp was already found via another + * back edge; if so return this loop; else return 0. + */ + + register Lindex li; + + for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) { + if (same_loop((loop_p) Lelem(li), lp)) { +#ifdef DEBUG + /* printf("messy loop found\n"); */ +#endif + return (loop_p) Lelem(li); + } + } + return (loop_p) 0; +} + + + +STATIC collapse_loops(loops_p) + lset *loops_p; +{ + register Lindex li1, li2; + register loop_p lp1,lp2; + + for (li1 = Lfirst(*loops_p); li1 != (Lindex) 0; li1 = Lnext(li1,*loops_p)) { + lp1 = (loop_p) Lelem(li1); + lp1->lp_level = (short) 0; + for (li2 = Lfirst(*loops_p); li2 != (Lindex) 0; + li2 = Lnext(li2,*loops_p)) { + lp2 = (loop_p) Lelem(li2); + if (lp1 != lp2 && lp1->lp_entry == lp2->lp_entry) { + Ljoin(lp2->LP_BLOCKS,&lp1->LP_BLOCKS); + oldcflpx(lp2->lp_extend); + Lremove(lp2,loops_p); + } + } + } +} + + +STATIC loop_per_block(lp) + loop_p lp; +{ + bblock_p b; + + /* Update the b_loops sets */ + + register Lindex bi; + + for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0; + bi = Lnext(bi,lp->LP_BLOCKS)) { + b = (bblock_p) Lelem(bi); + Ladd(lp,&(b->b_loops)); + } +} + + + +STATIC loop_attrib(loops) + lset loops; +{ + /* Compute several attributes */ + + register Lindex li; + register loop_p lp; + loop_id lastlpid = 0; + + for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) { + lp = (loop_p) Lelem(li); + lp->lp_id = ++lastlpid; + loop_per_block(lp); + } +} + + + +STATIC nest_levels(loops) + lset loops; +{ + /* Compute the nesting levels of all loops of + * the current procedure. For every loop we just count + * all loops of which the former is an inner loop. + * The running time is quadratic in the number of loops + * of the current procedure. As this number tends to be + * very small, there is no cause for alarm. + */ + + register Lindex li1, li2; + register loop_p lp; + + for (li1 = Lfirst(loops); li1 != (Lindex) 0; li1 = Lnext(li1,loops)) { + lp = (loop_p) Lelem(li1); + lp->lp_level = (short) 0; + for (li2 = Lfirst(loops); li2 != (Lindex) 0; + li2 = Lnext(li2,loops)) { + if (inner_loop(lp,(loop_p) Lelem(li2))) { + lp->lp_level++; + } + } + } +} + + +STATIC cleanup(loops) + lset loops; +{ + /* Throw away the LP_BLOCKS sets */ + + register Lindex i; + + for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) { + Ldeleteset(((loop_p) Lelem(i))->LP_BLOCKS); + } +} + + +STATIC bool does_exit(b,lp) + bblock_p b; + loop_p lp; +{ + /* See if b may exit the loop, i.e. if it + * has a successor outside the loop + */ + + Lindex i; + + for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) { + if (!INSIDE_LOOP(Lelem(i),lp)) return TRUE; + } + return FALSE; +} + + +STATIC mark_succ(b,lp) + bblock_p b; + loop_p lp; +{ + Lindex i; + bblock_p succ; + + for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) { + succ = (bblock_p) Lelem(i); + if (succ != b && succ != lp->lp_entry && INSIDE_LOOP(succ,lp) && + !MARKED(succ)) { + MARK(succ); + mark_succ(succ,lp); + } + } +} + + +STATIC mark_blocks(lp) + loop_p lp; +{ + /* Mark the strong and firm blocks of a loop. + * The last set of blocks consists of the end-block + * of the loop (i.e. the head of the back edge + * of the natural loop) and its dominators + * (including the loop entry block, i.e. the + * tail of the back edge). + */ + + register bblock_p b; + + /* First mark all blocks that are the successor of a + * block that may exit the loop (i.e. contains a + * -possibly conditional- jump to somewhere outside + * the loop. + */ + + if (lp->LP_MESSY) return; /* messy loops are hopeless cases */ + for (b = lp->lp_entry; b != (bblock_p) 0; b = b->b_next) { + if (!MARKED(b) && does_exit(b,lp)) { + mark_succ(b,lp); + } + } + + /* Now find all firm blocks. A block is strong + * if it is firm and not marked. + */ + + for (b = lp->lp_end; ; b = b->b_idom) { + MARK_FIRM(b); + if (!MARKED(b)) { + MARK_STRONG(b); + } + if (b == lp->lp_entry) break; + } +} + + + +STATIC mark_loopblocks(loops) + lset loops; +{ + /* Determine for all loops which basic blocks + * of the loop are strong (i.e. are executed + * during every iteration) and which blocks are + * firm (i.e. executed during every iteration with + * the only possible exception of the last one). + */ + + Lindex i; + loop_p lp; + + for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) { + lp = (loop_p) Lelem(i); + mark_blocks(lp); + } +} + + + +loop_detection(p) + proc_p p; +{ + /* Find all natural loops of procedure p. Every loop is + * assigned a unique identifying number, a set of basic + * blocks, a loop entry block and a nesting level number. + * Every basic block is assigned a nesting level number + * and a set of loops it is part of. + */ + + lset loops; /* the set of all loops */ + loop_p lp,org; + register bblock_p b; + bblock_p s; + Lindex si; + + loops = Lempty_set(); + for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) { + for (si = Lfirst(b->b_succ); si != (Lindex) 0; + si = Lnext(si,b->b_succ)) { + s = (bblock_p) Lelem(si); + if (dom(s,b)) { + /* 'b->s' is a back edge */ + lp = natural_loop(s,b); + if ((org = org_loop(lp,loops)) == (loop_p) 0) { + /* new loop */ + Ladd(lp,&loops); + } else { + /* Same loop, generated by several back + * edges; such a loop is called a messy + * loop. + */ + org->LP_MESSY = TRUE; + Ldeleteset(lp->LP_BLOCKS); + oldcflpx(lp->lp_extend); + oldloop(lp); + } + } + } + } + collapse_loops(&loops); + loop_attrib(loops); + nest_levels(loops); + mark_loopblocks(loops); /* determine firm and strong blocks */ + cleanup(loops); + p->p_loops = loops; +} diff --git a/util/ego/cf/cf_loop.h b/util/ego/cf/cf_loop.h new file mode 100644 index 000000000..473651025 --- /dev/null +++ b/util/ego/cf/cf_loop.h @@ -0,0 +1,14 @@ +/* C O N T R O L F L O W + * + * L O O P D E T E C T I O N + */ + +extern loop_detection(); /* (proc_p p) + * Detect all loops of procedure p. + * Every basic block of p is assigned + * a set of all loops it is part of. + * For every loop we record the number + * of blocks it contains, the loop entry + * block and its nesting level (0 = outer + * loop, 1 = loop within loop etc.). + */ diff --git a/util/ego/cf/cf_succ.c b/util/ego/cf/cf_succ.c new file mode 100644 index 000000000..7ec419bee --- /dev/null +++ b/util/ego/cf/cf_succ.c @@ -0,0 +1,250 @@ +/* C O N T R O L F L O W + * + * C F _ S U C C . C + */ + + +#include +#include "../share/types.h" +#include "../share/def.h" +#include "../share/debug.h" +#include "../share/global.h" +#include "../share/lset.h" +#include "../share/cset.h" +#include "../../../h/em_spec.h" +#include "../../../h/em_pseu.h" +#include "../../../h/em_flag.h" +#include "../../../h/em_mnem.h" +#include "cf.h" +#include "../share/map.h" + +extern char em_flag[]; + + +STATIC succeeds(succ,pred) + bblock_p succ, pred; +{ + assert(pred != (bblock_p) 0); + if (succ != (bblock_p) 0) { + Ladd(succ, &pred->b_succ); + Ladd(pred, &succ->b_pred); + } +} + + +#define IS_RETURN(i) (i == op_ret || i == op_rtt) +#define IS_CASE_JUMP(i) (i == op_csa || i == op_csb) +#define IS_UNCOND_JUMP(i) (i <= sp_lmnem && (em_flag[i-sp_fmnem] & EM_FLO) == FLO_T) +#define IS_COND_JUMP(i) (i <= sp_lmnem && (em_flag[i-sp_fmnem] & EM_FLO) == FLO_C) +#define TARGET(lnp) (lbmap[INSTRLAB(lnp)]) +#define ATARGET(arg) (lbmap[arg->a_a.a_instrlab]) + + + +STATIC arg_p skip_const(arg) + arg_p arg; +{ + assert(arg != (arg_p) 0); + switch(arg->a_type) { + case ARGOFF: + case ARGICN: + case ARGUCN: + break; + default: + error("bad case descriptor"); + } + return arg->a_next; +} + + +STATIC arg_p use_label(arg,b) + arg_p arg; + bblock_p b; +{ + if (arg->a_type == ARGINSTRLAB) { + /* arg is a non-null label */ + succeeds(ATARGET(arg),b); + } + return arg->a_next; +} + + + +STATIC case_flow(instr,desc,b) + short instr; + line_p desc; + bblock_p b; +{ + /* Analyse the case descriptor (given as a ROM pseudo instruction). + * Every instruction label appearing in the descriptor + * heads a basic block that is a successor of the block + * in which the case instruction appears (b). + */ + + register arg_p arg; + + assert(instr == op_csa || instr == op_csb); + assert(TYPE(desc) == OPLIST); + arg = ARG(desc); + arg = use_label(arg,b); + /* See if there is a default label. If so, then + * its block is a successor of b. Set arg to + * next argument. + */ + if (instr == op_csa) { + arg = skip_const(arg); /* skip lower bound */ + arg = skip_const(arg); /* skip lower-upper bound */ + while (arg != (arg_p) 0) { + /* All following arguments are case labels + * or zeroes. + */ + arg = use_label(arg,b); + } + } else { + /* csb instruction */ + arg = skip_const(arg); /* skip #entries */ + while (arg != (arg_p) 0) { + /* All following arguments are alternatively + * an index and an instruction label (possibly 0). + */ + arg = skip_const(arg); /* skip index */ + arg = use_label(arg,b); + } + } +} + + + +STATIC line_p case_descr(lnp) + line_p lnp; +{ + /* lnp is the instruction just before a csa or csb, + * so it is the instruction that pushes the address + * of a case descriptor on the stack. Find that + * descriptor, i.e. a rom pseudo instruction. + * Note that this instruction will always be part + * of the procedure in which the csa/csb occurs. + */ + + register line_p l; + dblock_p d; + obj_p obj; + dblock_id id; + + if (lnp == (line_p) 0 || (INSTR(lnp)) != op_lae) { + error("cannot find 'lae descr' before csa/csb"); + } + /* We'll first find the ROM and its dblock_id */ + obj = OBJ(lnp); + if (obj->o_off != (offset) 0) { + error("bad 'lae descr' before csa/csb"); + /* We require a descriptor to be an entire rom, + * not part of a rom. + */ + } + d = obj->o_dblock; + assert(d != (dblock_p) 0); + if (d->d_pseudo != DROM) { + error("case descriptor must be in rom"); + } + id = d->d_id; + /* We'll use the dblock_id to find the defining occurrence + * of the rom in the EM text (i.e. a rom pseudo). As all + * pseudos appear at the beginning of a procedure, we only + * have to look in its first basic block. + */ + assert(curproc != (proc_p) 0); + assert(curproc->p_start != (bblock_p) 0); + l = curproc->p_start->b_start; /* first instruction of curproc */ + while (l != (line_p) 0) { + if ((INSTR(l)) == ps_sym && + SHORT(l) == id) { + /* found! */ + assert((INSTR(l->l_next)) == ps_rom); + return l->l_next; + } + l = l->l_next; + } + error("cannot find rom pseudo for case descriptor"); + /* NOTREACHED */ +} + + + +STATIC last2_instrs(b,last_out,prev_out) + bblock_p b; + line_p *last_out,*prev_out; +{ + /* Determine the last and one-but-last instruction + * of basic block b. An end-pseudo is not regarded + * as an instruction. If the block contains only 1 + * instruction, prev_out is 0. + */ + + register line_p l1,l2; + + l2 = b->b_start; /* first instruction of b */ + assert(l2 != (line_p) 0); /* block can not be empty */ + if ((l1 = l2->l_next) == (line_p) 0 || INSTR(l1) == ps_end) { + *last_out = l2; /* single instruction */ + *prev_out = (line_p) 0; + } else { + while(l1->l_next != (line_p) 0 && INSTR(l1->l_next) != ps_end) { + l2 = l1; + l1 = l1->l_next; + } + *last_out = l1; + *prev_out = l2; + } +} + + + +control_flow(head) + bblock_p head; +{ + /* compute the successor and predecessor relation + * for every basic block. + */ + + register bblock_p b; + line_p lnp, prev; + short instr; + + for (b = head; b != (bblock_p) 0; b = b->b_next) { + /* for every basic block, in textual order, do */ + last2_instrs(b, &lnp, &prev); + /* find last and one-but-last instruction */ + instr = INSTR(lnp); + /* The last instruction of the basic block + * determines the set of successors of the block. + */ + if (IS_CASE_JUMP(instr)) { + case_flow(instr,case_descr(prev),b); + /* If lnp is a csa or csb, then the instruction + * just before it (i.e. prev) must be the + * instruction that pushes the address of the + * case descriptor. This descriptor is found + * and analysed in order to build the successor + * and predecessor sets of b. + */ + } else { + if (!IS_RETURN(instr)) { + if (IS_UNCOND_JUMP(instr)) { + succeeds(TARGET(lnp),b); + } else { + if (IS_COND_JUMP(instr)) { + succeeds(TARGET(lnp),b); + succeeds(b->b_next, b); + /* Textually next block is + * a successor of b. + */ + } else { + /* normal instruction */ + succeeds(b->b_next, b); + } + } + } + } + } +} diff --git a/util/ego/cf/cf_succ.h b/util/ego/cf/cf_succ.h new file mode 100644 index 000000000..b475d1a77 --- /dev/null +++ b/util/ego/cf/cf_succ.h @@ -0,0 +1,10 @@ +/* C O N T R O L F L O W + * + * S U C C E S S O R / P R E D E C E S S O R R E L A T I O N S + */ + +extern control_flow(); /* (bblock_p head) + * Compute for every basic block + * its successors and predecessors + * in the control flow graph. + */ diff --git a/util/ego/cs/cs.h b/util/ego/cs/cs.h new file mode 100644 index 000000000..b53f33081 --- /dev/null +++ b/util/ego/cs/cs.h @@ -0,0 +1,123 @@ +typedef short valnum; +typedef struct entity *entity_p; +typedef struct avail *avail_p; +typedef struct token *token_p; +typedef struct occur *occur_p; + +struct token { + valnum tk_vn; + offset tk_size; + line_p tk_lfirst; /* Textually first instruction, involved + * in pushing this token. + */ +}; + + /* We distinguish these entities. */ +#define ENCONST 0 +#define ENLOCAL 1 +#define ENEXTERNAL 2 +#define ENINDIR 3 +#define ENOFFSETTED 4 +#define ENALOCAL 5 +#define ENAEXTERNAL 6 +#define ENAOFFSETTED 7 +#define ENALOCBASE 8 +#define ENAARGBASE 9 +#define ENPROC 10 +#define ENFZER 11 +#define ENARRELEM 12 +#define ENLOCBASE 13 +#define ENHEAPPTR 14 +#define ENIGNMASK 15 + +struct entity { + valnum en_vn; + bool en_static; + byte en_kind; /* ENLOCAL, ENEXTERNAL, etc. */ + offset en_size; + union { + offset en__val; /* ENCONST. */ + offset en__loc; /* ENLOCAL, ENALOCAL. */ + obj_p en__ext; /* ENEXTERNAL, ENAEXTERNAL. */ + valnum en__ind; /* ENINDIR. */ + struct { + valnum en__base; + offset en__off; + } en_offs; /* ENOFFSETTED, ENAOFFSETTED. */ + offset en__levels; /* ENALOCBASE, ENAARGBASE. */ + proc_p en__pro; /* ENPROC. */ + struct { + valnum en__arbase; + valnum en__index; + valnum en__adesc; + } en_arr; /* ENARRELEM. */ + } en_inf; +}; + + /* Macros to increase ease of use. */ +#define en_val en_inf.en__val +#define en_loc en_inf.en__loc +#define en_ext en_inf.en__ext +#define en_ind en_inf.en__ind +#define en_base en_inf.en_offs.en__base +#define en_off en_inf.en_offs.en__off +#define en_levels en_inf.en__levels +#define en_pro en_inf.en__pro +#define en_arbase en_inf.en_arr.en__arbase +#define en_index en_inf.en_arr.en__index +#define en_adesc en_inf.en_arr.en__adesc + +struct occur { + line_p oc_lfirst; /* First instruction of expression. */ + line_p oc_llast; /* Last one. */ + bblock_p oc_belongs; /* Basic block it belongs to. */ +}; + + /* We distinguish these groups of instructions. */ +#define SIMPLE_LOAD 0 +#define EXPENSIVE_LOAD 1 +#define LOAD_ARRAY 2 +#define STORE_DIRECT 3 +#define STORE_INDIR 4 +#define STORE_ARRAY 5 +#define UNAIR_OP 6 +#define BINAIR_OP 7 +#define TERNAIR_OP 8 +#define KILL_ENTITY 9 +#define SIDE_EFFECTS 10 +#define FIDDLE_STACK 11 +#define IGNORE 12 +#define HOPELESS 13 +#define BBLOCK_END 14 + +struct avail { + avail_p av_before; /* Ptr to earlier discovered expressions. */ + byte av_instr; /* Operator instruction. */ + offset av_size; + line_p av_found; /* Line where expression is first found. */ + lset av_occurs; /* Set of recurrences of expression. */ + entity_p av_saveloc; /* Local where result is put in. */ + valnum av_result; + union { + valnum av__operand; /* EXPENSIVE_LOAD, UNAIR_OP. */ + struct { + valnum av__oleft; + valnum av__oright; + } av_2; /* BINAIR_OP. */ + struct { + valnum av__ofirst; + valnum av__osecond; + valnum av__othird; + } av_3; /* TERNAIR_OP. */ + } av_o; +}; + + /* Macros to increase ease of use. */ +#define av_operand av_o.av__operand +#define av_oleft av_o.av_2.av__oleft +#define av_oright av_o.av_2.av__oright +#define av_ofirst av_o.av_3.av__ofirst +#define av_osecond av_o.av_3.av__osecond +#define av_othird av_o.av_3.av__othird + +extern int Scs; /* Number of optimizations found. */ diff --git a/util/ego/cs/cs_alloc.c b/util/ego/cs/cs_alloc.c new file mode 100644 index 000000000..e6cc18fea --- /dev/null +++ b/util/ego/cs/cs_alloc.c @@ -0,0 +1,44 @@ +#include "../share/types.h" +#include "../share/alloc.h" +#include "cs.h" + +occur_p newoccur(l1, l2, b) + line_p l1, l2; + bblock_p b; +{ + /* Allocate a new struct occur and initialize it. */ + + register occur_p rop; + + rop = (occur_p) newcore(sizeof(struct occur)); + rop->oc_lfirst = l1; rop->oc_llast = l2; rop->oc_belongs = b; + return rop; +} + +oldoccur(ocp) + occur_p ocp; +{ + oldcore((short *) ocp, sizeof(struct occur)); +} + +avail_p newavail() +{ + return (avail_p) newcore(sizeof(struct avail)); +} + +oldavail(avp) + avail_p avp; +{ + oldcore((short *) avp, sizeof(struct avail)); +} + +entity_p newentity() +{ + return (entity_p) newcore(sizeof(struct entity)); +} + +oldentity(enp) + entity_p enp; +{ + oldcore((short *) enp, sizeof(struct entity)); +} diff --git a/util/ego/cs/cs_alloc.h b/util/ego/cs/cs_alloc.h new file mode 100644 index 000000000..7390e9ae6 --- /dev/null +++ b/util/ego/cs/cs_alloc.h @@ -0,0 +1,24 @@ +extern occur_p newoccur(); /* (line_p l1, l2; bblock_p b) + * Returns a pointer to a new struct occur + * and initializes it. + */ + +extern oldoccur(); /* (occur_p ocp) + * Release the struct occur ocp points to. + */ + +extern avail_p newavail(); /* () + * Return a pointer to a new struct avail. + */ + +extern oldavail(); /* (avail_p avp) + * Release the struct avail avp points to. + */ + +extern entity_p newentity(); /* () + * Return a pointer to a new struct entity. + */ + +extern oldentity(); /* (entity_p enp) + * Release the struct entity enp points to. + */ diff --git a/util/ego/cs/cs_aux.c b/util/ego/cs/cs_aux.c new file mode 100644 index 000000000..296e5b0c0 --- /dev/null +++ b/util/ego/cs/cs_aux.c @@ -0,0 +1,64 @@ +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/aux.h" +#include "../share/global.h" +#include "../share/lset.h" +#include "cs.h" +#include "cs_entity.h" + +offset array_elemsize(vn) + valnum vn; +{ + /* Vn is the valuenumber of an entity that points to + * an array-descriptor. The third element of this descriptor holds + * the size of the array-elements. + * IF we can find this entity, AND IF we can find the descriptor AND IF + * this descriptor is located in ROM, then we return the size. + */ + entity_p enp; + + enp = find_entity(vn); + + if (enp == (entity_p) 0) + return UNKNOWN_SIZE; + + if (enp->en_kind != ENAEXTERNAL) + return UNKNOWN_SIZE; + + if (enp->en_ext->o_dblock->d_pseudo != DROM) + return UNKNOWN_SIZE; + + return aoff(enp->en_ext->o_dblock->d_values, 2); +} + +occur_p occ_elem(i) + Lindex i; +{ + return (occur_p) Lelem(i); +} + +entity_p en_elem(i) + Lindex i; +{ + return (entity_p) Lelem(i); +} + +/* The value numbers associated with each distinct value + * start at 1. + */ + +STATIC valnum val_no; + +valnum newvalnum() +{ + /* Return a completely new value number. */ + + return ++val_no; +} + +start_valnum() +{ + /* Restart value numbering. */ + + val_no = 0; +} diff --git a/util/ego/cs/cs_aux.h b/util/ego/cs/cs_aux.h new file mode 100644 index 000000000..09be0d270 --- /dev/null +++ b/util/ego/cs/cs_aux.h @@ -0,0 +1,25 @@ +extern offset array_elemsize(); /* (valnum vm) + * Returns the size of array-elements, + * if vn is the valuenumber of the + * address of an array-descriptor. + */ + +extern occur_p occ_elem(); /* (Lindex i) + * Returns a pointer to the occurrence + * of which i is an index in a set. + */ + +extern entity_p en_elem(); /* (Lindex i) + * Returns a pointer to the entity + * of which i is an index in a set. + */ + +extern valnum newvalnum(); /* () + * Returns a completely new + * value number. + */ + +extern start_valnum(); /* () + * Restart value numbering. + */ + diff --git a/util/ego/cs/cs_avail.h b/util/ego/cs/cs_avail.h new file mode 100644 index 000000000..2275df8c3 --- /dev/null +++ b/util/ego/cs/cs_avail.h @@ -0,0 +1,18 @@ +extern avail_p avails; /* The set of available expressions. */ + +extern avail_p av_enter(); /* (avail_p avp, occur_p ocp, byte kind) + * Puts the available expression in avp + * in the list of available expressions, + * if it is not already there. Add ocp to set of + * occurrences of this expression. + * If we have a new expression, we test whether + * the result is saved. When this expression + * recurs,we test if we can still use the + * variable into which it was saved. + * (Kind is the kind of the expression.) + * Returns a pointer into the list. + */ + +extern clr_avails(); /* Release all space occupied by the old list + * of available expressions. + */ diff --git a/util/ego/cs/cs_debug.c b/util/ego/cs/cs_debug.c new file mode 100644 index 000000000..0d4cdbdfc --- /dev/null +++ b/util/ego/cs/cs_debug.c @@ -0,0 +1,156 @@ +#include +#include "../../../h/em_spec.h" +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/lset.h" +#include "cs.h" +#include "cs_aux.h" +#include "cs_avail.h" +#include "cs_entity.h" + +#ifdef VERBOSE + +extern char em_mnem[]; /* The mnemonics of the EM instructions. */ + +STATIC showinstr(lnp) + line_p lnp; +{ + /* Makes the instruction in `lnp' human readable. Only lines that + * can occur in expressions that are going to be eliminated are + * properly handled. + */ + if (INSTR(lnp) < sp_fmnem && INSTR(lnp) > sp_lmnem) { + fprintf(stderr,"*** ?\n"); + return; + } + + fprintf(stderr,"%s", &em_mnem[4 * (INSTR(lnp)-sp_fmnem)]); + switch (TYPE(lnp)) { + case OPNO: + break; + case OPSHORT: + fprintf(stderr," %d", SHORT(lnp)); + break; + case OPOBJECT: + fprintf(stderr," %d", OBJ(lnp)->o_id); + break; + case OPOFFSET: + fprintf(stderr," %D", OFFSET(lnp)); + break; + default: + fprintf(stderr," ?"); + break; + } + fprintf(stderr,"\n"); +} + +SHOWOCCUR(ocp) + occur_p ocp; +{ + /* Shows all instructions in an occurrence. */ + + register line_p lnp, next; + + if (verbose_flag) { + for (lnp = ocp->oc_lfirst; lnp != (line_p) 0; lnp = next) { + next = lnp == ocp->oc_llast ? (line_p) 0 : lnp->l_next; + + showinstr(lnp); + } + } +} + +#endif + +#ifdef TRACE + +SHOWAVAIL(avp) + avail_p avp; +{ + /* Shows an available expression. */ + showinstr(avp->av_found); + fprintf(stderr,"result %d,", avp->av_result); + fprintf(stderr,"occurred %d times\n", Lnrelems(avp->av_occurs) + 1); + +} + +OUTAVAILS() +{ + register avail_p ravp; + + fprintf(stderr,"AVAILABLE EXPRESSIONS\n"); + + for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) { + SHOWAVAIL(ravp); + fprintf(stderr,"\n"); + } +} + +STATIC char *enkinds[] = { + "constant", + "local", + "external", + "indirect", + "offsetted", + "address of local", + "address of external", + "address of offsetted", + "address of local base", + "address of argument base", + "procedure", + "floating zero", + "array element", + "local base", + "heap pointer", + "ignore mask" +}; + +OUTENTITIES() +{ + register Lindex i; + + fprintf(stderr,"ENTITIES\n"); + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + register entity_p rep = en_elem(i); + + fprintf(stderr,"%s,", enkinds[rep->en_kind]); + fprintf(stderr,"size %D,", rep->en_size); + fprintf(stderr,"valno %d,", rep->en_vn); + switch (rep->en_kind) { + case ENCONST: + fprintf(stderr,"$%D\n", rep->en_val); + break; + case ENLOCAL: + case ENALOCAL: + fprintf(stderr,"%D(LB)\n", rep->en_loc); + break; + case ENINDIR: + fprintf(stderr,"*%d\n", rep->en_ind); + break; + case ENOFFSETTED: + case ENAOFFSETTED: + fprintf(stderr,"%D(%d)\n", rep->en_off, rep->en_base); + break; + case ENALOCBASE: + case ENAARGBASE: + fprintf(stderr,"%D levels\n", rep->en_levels); + break; + case ENARRELEM: + fprintf(stderr,"%d[%d], ",rep->en_arbase,rep->en_index); + fprintf(stderr,"rom at %d\n", rep->en_adesc); + break; + } + fprintf(stderr,"\n"); + } +} + +/* XXX */ +OUTTRACE(s, n) + char *s; +{ + fprintf(stderr,"trace: "); + fprintf(stderr,s, n); + fprintf(stderr,"\n"); +} + +#endif TRACE diff --git a/util/ego/cs/cs_debug.h b/util/ego/cs/cs_debug.h new file mode 100644 index 000000000..194aa62dd --- /dev/null +++ b/util/ego/cs/cs_debug.h @@ -0,0 +1,33 @@ +#ifdef VERBOSE + +extern SHOWOCCUR(); /* (occur_p ocp) + * Shows all lines in an occurrence. + */ + +#else + +#define SHOWOCCUR(x) + +#endif + +#ifdef TRACE + +extern OUTAVAILS(); /* () + * Prints all available expressions. + */ + +extern OUTENTITIES(); /* () + * Prints all entities. + */ + +extern SHOWAVAIL(); /* (avail_p avp) + * Shows an available expression. + */ + +#else TRACE + +#define OUTAVAILS() +#define OUTENTITIES() +#define SHOWAVAIL(x) + +#endif TRACE diff --git a/util/ego/cs/cs_entity.c b/util/ego/cs/cs_entity.c new file mode 100644 index 000000000..f3e95ca9b --- /dev/null +++ b/util/ego/cs/cs_entity.c @@ -0,0 +1,142 @@ +/* F U N C T I O N S F O R A C C E S S I N G T H E S E T + * + * O F E N T I T I E S + */ + +#include "../share/types.h" +#include "../share/global.h" +#include "../share/lset.h" +#include "../share/debug.h" +#include "cs.h" +#include "cs_alloc.h" +#include "cs_aux.h" + +lset entities; /* Our pseudo symbol-table. */ + +entity_p find_entity(vn) + valnum vn; +{ + /* Try to find the entity with valuenumber vn. */ + + register Lindex i; + + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + if (en_elem(i)->en_vn == vn) + return en_elem(i); + } + + return (entity_p) 0; +} + +STATIC bool same_entity(enp1, enp2) + entity_p enp1, enp2; +{ + if (enp1->en_kind != enp2->en_kind) return FALSE; + if (enp1->en_size != enp2->en_size) return FALSE; + if (enp1->en_size == UNKNOWN_SIZE) return FALSE; + + switch (enp1->en_kind) { + case ENCONST: + return enp1->en_val == enp2->en_val; + case ENLOCAL: + case ENALOCAL: + return enp1->en_loc == enp2->en_loc; + case ENEXTERNAL: + case ENAEXTERNAL: + return enp1->en_ext == enp2->en_ext; + case ENINDIR: + return enp1->en_ind == enp2->en_ind; + case ENOFFSETTED: + case ENAOFFSETTED: + return enp1->en_base == enp2->en_base && + enp1->en_off == enp2->en_off; + case ENALOCBASE: + case ENAARGBASE: + return enp1->en_levels == enp2->en_levels; + case ENPROC: + return enp1->en_pro == enp2->en_pro; + case ENARRELEM: + return enp1->en_arbase == enp2->en_arbase && + enp1->en_index == enp2->en_index && + enp1->en_adesc == enp2->en_adesc; + default: + return TRUE; + } +} + +STATIC copy_entity(src, dst) + entity_p src, dst; +{ + dst->en_static = src->en_static; + dst->en_kind = src->en_kind; + dst->en_size = src->en_size; + + switch (src->en_kind) { + case ENCONST: + dst->en_val = src->en_val; + break; + case ENLOCAL: + case ENALOCAL: + dst->en_loc = src->en_loc; + break; + case ENEXTERNAL: + case ENAEXTERNAL: + dst->en_ext = src->en_ext; + break; + case ENINDIR: + dst->en_ind = src->en_ind; + break; + case ENOFFSETTED: + case ENAOFFSETTED: + dst->en_base = src->en_base; + dst->en_off = src->en_off; + break; + case ENALOCBASE: + case ENAARGBASE: + dst->en_levels = src->en_levels; + break; + case ENPROC: + dst->en_pro = src->en_pro; + break; + case ENARRELEM: + dst->en_arbase = src->en_arbase; + dst->en_index = src->en_index; + dst->en_adesc = src->en_adesc; + break; + } +} + +entity_p en_enter(enp) + register entity_p enp; +{ + /* Put the entity in enp in the entity set, if it is not already there. + * Return pointer to stored entity. + */ + register Lindex i; + register entity_p new; + + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + if (same_entity(en_elem(i), enp)) + return en_elem(i); + } + /* A new entity. */ + new = newentity(); + new->en_vn = newvalnum(); + copy_entity(enp, new); + Ladd(new, &entities); + + return new; +} + +clr_entities() +{ + /* Throw away all pseudo-symboltable information. */ + + register Lindex i; + + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + oldentity(en_elem(i)); + } + Ldeleteset(entities); + entities = Lempty_set(); +} diff --git a/util/ego/cs/cs_entity.h b/util/ego/cs/cs_entity.h new file mode 100644 index 000000000..413de8121 --- /dev/null +++ b/util/ego/cs/cs_entity.h @@ -0,0 +1,15 @@ +extern lset entities; /* The pseudo-symboltable. */ + +extern entity_p find_entity(); /* (valnum vn) + * Tries to find an entity with value number vn. + */ + +extern entity_p en_enter(); /* (entity_p enp) + * Enter the entity in enp in the set of + * entities if it was not already there. + */ + +extern clr_entities(); /* () + * Release all space occupied by our + * pseudo-symboltable. + */ diff --git a/util/ego/cs/cs_kill.c b/util/ego/cs/cs_kill.c new file mode 100644 index 000000000..9a30f9083 --- /dev/null +++ b/util/ego/cs/cs_kill.c @@ -0,0 +1,372 @@ +#include "../../../h/em_mnem.h" +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/global.h" +#include "../share/lset.h" +#include "../share/cset.h" +#include "../share/aux.h" +#include "../share/map.h" +#include "cs.h" +#include "cs_aux.h" +#include "cs_debug.h" +#include "cs_avail.h" +#include "cs_entity.h" + +STATIC base_valno(enp) + entity_p enp; +{ + /* Return the value number of the (base) address of an indirectly + * accessed entity. + */ + switch (enp->en_kind) { + default: + assert(FALSE); + break; + case ENINDIR: + return enp->en_ind; + case ENOFFSETTED: + return enp->en_base; + case ENARRELEM: + return enp->en_arbase; + } + /* NOTREACHED */ +} + +STATIC entity_p find_base(vn) + valnum vn; +{ + /* Vn is the valuenumber of the (base) address of an indirectly + * accessed entity. Return the entity that holds this address + * recursively. + */ + register Lindex i; + register avail_p ravp; + + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + register entity_p renp = en_elem(i); + + if (renp->en_vn == vn) { + switch (renp->en_kind) { + case ENAEXTERNAL: + case ENALOCAL: + case ENALOCBASE: + case ENAARGBASE: + return renp; + case ENAOFFSETTED: + return find_base(renp->en_base); + } + } + } + + /* We couldn't find it among the entities. + * Let's try the available expressions. + */ + for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) { + if (ravp->av_result == vn) { + if (ravp->av_instr == (byte) op_aar) + return find_base(ravp->av_ofirst); + if (ravp->av_instr == (byte) op_ads) + return find_base(ravp->av_oleft); + } + } + + /* Bad luck. */ + return (entity_p) 0; +} + +STATIC bool obj_overlap(op1, op2) + obj_p op1, op2; +{ + /* Op1 and op2 point to two objects in the same datablock. + * Obj_overlap returns whether these objects might overlap. + */ + obj_p tmp; + + if (op1->o_off > op2->o_off) { + /* Exchange them. */ + tmp = op1; op1 = op2; op2 = tmp; + } + return op1->o_size == UNKNOWN_SIZE || + op1->o_off + op1->o_size > op2->o_off; +} + +#define same_datablock(o1, o2) ((o1)->o_dblock == (o2)->o_dblock) + +STATIC bool addr_local(enp) + entity_p enp; +{ + /* Is enp the address of a stack item. */ + + if (enp == (entity_p) 0) return FALSE; + + return enp->en_kind == ENALOCAL || enp->en_kind == ENALOCBASE || + enp->en_kind == ENAARGBASE; +} + +STATIC bool addr_external(enp) + entity_p enp; +{ + /* Is enp the address of an external. */ + + return enp != (entity_p) 0 && enp->en_kind == ENAEXTERNAL; +} + +STATIC kill_external(obp, indir) + obj_p obp; + int indir; +{ + /* A store is done via the object in obp. If this store is direct + * we kill directly accessed entities in the same data block only + * if they overlap with obp, otherwise we kill everything in the + * data block. Indirectly accessed entities of which it can not be + * proven taht they are not in the same data block, are killed in + * both cases. + */ + register Lindex i; + + OUTTRACE("kill external", 0); + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + entity_p enp = en_elem(i); + entity_p base; + + switch (enp->en_kind) { + case ENEXTERNAL: + if (!same_datablock(enp->en_ext, obp)) + break; + if (!indir && !obj_overlap(enp->en_ext, obp)) + break; + OUTTRACE("kill %d", enp->en_vn); + enp->en_vn = newvalnum(); + break; + case ENINDIR: + case ENOFFSETTED: + case ENARRELEM: + /* We spare its value number if we are sure + * that its (base) address points into the + * stack or into another data block. + */ + base = find_base(base_valno(enp)); + if (addr_local(base)) + break; + if (addr_external(base) && + !same_datablock(base->en_ext, obp) + ) + break; + OUTTRACE("kill %d", enp->en_vn); + enp->en_vn = newvalnum(); + break; + } + } +} + +STATIC bool loc_overlap(enp1, enp2) + entity_p enp1, enp2; +{ + /* Enp1 and enp2 point to two locals. Loc_overlap returns whether + * they overlap. + */ + entity_p tmp; + + assert(enp1->en_kind == ENLOCAL && enp2->en_kind == ENLOCAL); + + if (enp1->en_loc > enp2->en_loc) { + /* Exchange them. */ + tmp = enp1; enp1 = enp2; enp2 = tmp; + } + if (enp1->en_loc < 0 && enp2->en_loc >= 0) + return FALSE; /* Locals and parameters do not overlap. */ + else return enp1->en_size == UNKNOWN_SIZE || + enp1->en_loc + enp1->en_size > enp2->en_loc; +} + +STATIC kill_local(enp, indir) + entity_p enp; + bool indir; +{ + /* This time a store is done into an ENLOCAL. */ + + register Lindex i; + + OUTTRACE("kill local", 0); + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + entity_p rep = en_elem(i); + entity_p base; + + switch (rep->en_kind) { + case ENLOCAL: + if (indir) { + /* Kill locals that might be stored into + * via a pointer. Note: enp not used. + */ + if (!is_regvar(rep->en_loc)) { + OUTTRACE("kill %d", rep->en_vn); + rep->en_vn = newvalnum(); + } + } else if (loc_overlap(rep, enp)) { + /* Only kill overlapping locals. */ + OUTTRACE("kill %d", rep->en_vn); + rep->en_vn = newvalnum(); + } + break; + case ENINDIR: + case ENOFFSETTED: + case ENARRELEM: + if (!is_regvar(enp->en_loc)) { + base = find_base(base_valno(rep)); + if (!addr_external(base)) { + OUTTRACE("kill %d", rep->en_vn); + rep->en_vn = newvalnum(); + } + } + break; + } + } +} + +STATIC kill_sim() +{ + /* A store is done into the ENIGNMASK. */ + + register Lindex i; + + OUTTRACE("kill sim", 0); + for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) { + register entity_p rep = en_elem(i); + + if (rep->en_kind == ENIGNMASK) { + OUTTRACE("kill %d", rep->en_vn); + rep->en_vn = newvalnum(); + return; /* There is only one ignoremask. */ + } + } +} + +kill_direct(enp) + entity_p enp; +{ + /* A store will be done into enp. We must forget the values of all the + * entities this one may overlap with. + */ + switch (enp->en_kind) { + default: + assert(FALSE); + break; + case ENEXTERNAL: + kill_external(enp->en_ext, FALSE); + break; + case ENLOCAL: + kill_local(enp, FALSE); + break; + case ENIGNMASK: + kill_sim(); + break; + } +} + +kill_indir(enp) + entity_p enp; +{ + /* An indirect store is done, in an ENINDIR, + * an ENOFFSETTED or an ENARRELEM. + */ + entity_p p; + + /* If we can find the (base) address of this entity, then we can spare + * the entities that are provably not pointed to by the address. + * We will also make use of the MES 3 pseudo's, generated by + * the front-end. When a MES 3 is generated for a local, this local + * will not be referenced indirectly. + */ + if ((p = find_base(base_valno(enp))) == (entity_p) 0) { + kill_much(); /* Kill all entities without registermessage. */ + } else { + switch (p->en_kind) { + case ENAEXTERNAL: + /* An indirect store into global data. */ + kill_external(p->en_ext, TRUE); + break; + case ENALOCAL: + case ENALOCBASE: + case ENAARGBASE: + /* An indirect store into stack data. */ + kill_local(p, TRUE); + break; + } + } +} + +kill_much() +{ + /* Kills all killable entities, + * except the locals for which a registermessage was generated. + */ + register Lindex i; + + OUTTRACE("kill much", 0); + for (i = Lfirst(entities); i != (Lindex) i; i = Lnext(i, entities)) { + register entity_p rep = en_elem(i); + + if (rep->en_static) continue; + if (rep->en_kind == ENLOCAL && is_regvar(rep->en_loc)) continue; + OUTTRACE("kill %d", rep->en_vn); + rep->en_vn = newvalnum(); + } +} + +STATIC bool bad_procflags(pp) + proc_p pp; +{ + /* Return whether the flags about the procedure in pp indicate + * that we have little information about it. It might be that + * we haven't seen the text of pp, or that we have seen that pp + * calls a procedure which we haven't seen the text of. + */ + return !(pp->p_flags1 & PF_BODYSEEN) || (pp->p_flags1 & PF_CALUNKNOWN); +} + +STATIC kill_globset(s) + cset s; +{ + /* S is a set of global variables that might be changed. + * We act as if a direct store is done into each of them. + */ + register Cindex i; + + OUTTRACE("kill globset", 0); + for (i = Cfirst(s); i != (Cindex) 0; i = Cnext(i,s)) { + kill_external(omap[Celem(i)], FALSE); + } +} + +kill_call(pp) + proc_p pp; +{ + /* Kill everything that might be destroyed by calling + * the procedure in pp. + */ + if (bad_procflags(pp)) { + /* We don't know enough about this procedure. */ + kill_much(); + } else if (pp->p_change->c_flags & CF_INDIR) { + /* The procedure does an indirect store. */ + kill_much(); + } else { + /* Procedure might affect global data. */ + kill_globset(pp->p_change->c_ext); + } +} + +kill_all() +{ + /* Kills all entities. */ + + register Lindex i; + + OUTTRACE("kill all entities", 0); + for (i = Lfirst(entities); i != (Lindex) i; i = Lnext(i, entities)) { + entity_p enp = en_elem(i); + + OUTTRACE("kill %d", enp->en_vn); + enp->en_vn = newvalnum(); + } +} diff --git a/util/ego/cs/cs_kill.h b/util/ego/cs/cs_kill.h new file mode 100644 index 000000000..96d831d22 --- /dev/null +++ b/util/ego/cs/cs_kill.h @@ -0,0 +1,24 @@ +extern kill_call(); /* (proc_p pp) + * Kill all entities that might have an other value + * after execution of the procedure in pp. + */ + +extern kill_much(); /* () + * Kill all killable entities except those for which + * a register message was generated. + * Constants, addresses, etc are not killable. + */ + +extern kill_indir(); /* (entity_p enp) + * Kill all entities that might have an other value + * after indirect assignment to the entity in enp. + */ + +extern kill_direct(); /* (entity_p enp) + * Kill all entities that might have an other value + * after direct assignment to the entity in enp. + */ + +extern kill_all(); /* () + * Kill all entities. + */ diff --git a/util/ego/cs/cs_profit.h b/util/ego/cs/cs_profit.h new file mode 100644 index 000000000..535b6b904 --- /dev/null +++ b/util/ego/cs/cs_profit.h @@ -0,0 +1,10 @@ +extern cs_machinit(); /* (FILE *f) + * Read phase-specific information from f. + */ + +extern bool desirable(); /* (avail_p avp) + * Return whether it is desirable to eliminate + * the recurrences of the expression in avp. + * At the same time delete the recurrences + * for which it is not allowed. + */ diff --git a/util/ego/cs/cs_stack.c b/util/ego/cs/cs_stack.c new file mode 100644 index 000000000..2070dad6c --- /dev/null +++ b/util/ego/cs/cs_stack.c @@ -0,0 +1,132 @@ +/* + * S T A C K M O D U L E + */ +#include "../share/types.h" +#include "../share/global.h" +#include "../share/debug.h" +#include "../share/aux.h" +#include "cs.h" +#include "cs_aux.h" + +#define STACK_DEPTH 50 + +STATIC struct token Stack[STACK_DEPTH]; +STATIC token_p free_token; + +#define Delete_top() {--free_token; } +#define Empty_stack() {free_token = &Stack[0]; } +#define Stack_empty() (free_token == &Stack[0]) +#define Top (free_token - 1) + +Push(tkp) + token_p tkp; +{ + if (tkp->tk_size == UNKNOWN_SIZE) { + Empty_stack(); /* The contents of the Stack is useless. */ + } else { + assert(free_token < &Stack[STACK_DEPTH]); + + free_token->tk_vn = tkp->tk_vn; + free_token->tk_size = tkp->tk_size; + free_token++->tk_lfirst = tkp->tk_lfirst; + } +} + +#define WORD_MULTIPLE(n) ((n / ws) * ws + ( n % ws ? ws : 0 )) + +Pop(tkp, size) + token_p tkp; + offset size; +{ + /* Pop a token with given size from the valuenumber stack into tkp. */ + + /* First simple case. */ + if (size != UNKNOWN_SIZE && !Stack_empty() && size == Top->tk_size) { + tkp->tk_vn = Top->tk_vn; + tkp->tk_size = size; + tkp->tk_lfirst = Top->tk_lfirst; + Delete_top(); + return; + } + /* Now we're in trouble: we must pop something that is not there! + * We just put a dummy into tkp and pop tokens until we've + * popped size bytes. + */ + /* Create dummy. */ + tkp->tk_vn = newvalnum(); + tkp->tk_lfirst = (line_p) 0; + + /* Now fiddle with the Stack. */ + if (Stack_empty()) return; + if (size == UNKNOWN_SIZE) { + Empty_stack(); + return; + } + if (size > Top->tk_size) { + while (!Stack_empty() && size >= Top->tk_size) { + size -= Top->tk_size; + Delete_top(); + } + } + /* Now Stack_empty OR size < Top->tk_size. */ + if (!Stack_empty()) { + if (Top->tk_size - size < ws) { + Delete_top(); + } else { + Top->tk_vn = newvalnum(); + Top->tk_size -= WORD_MULTIPLE(size); + } + } +} + +Dup(lnp) + line_p lnp; +{ + /* Duplicate top bytes on the Stack. */ + + register token_p bottom = Top; + register token_p oldtop = Top; + register offset nbytes = off_set(lnp); + struct token dummy; + + /* Find the bottom of the bytes to be duplicated. + * It is possible that we cannot find it. + */ + while (bottom > &Stack[0] && bottom->tk_size < nbytes) { + nbytes -= bottom->tk_size; + bottom--; + } + + if (bottom < &Stack[0]) { + /* There was nothing. */ + dummy.tk_vn = newvalnum(); + dummy.tk_size = nbytes; + dummy.tk_lfirst = lnp; + Push(&dummy); + } else { + if (bottom->tk_size < nbytes) { + /* Not enough, bottom == &Stack[0]. */ + dummy.tk_vn = newvalnum(); + dummy.tk_size = nbytes - bottom->tk_size; + dummy.tk_lfirst = lnp; + Push(&dummy); + } else if (bottom->tk_size > nbytes) { + /* Not integral # tokens. */ + dummy.tk_vn = newvalnum(); + dummy.tk_size = nbytes; + dummy.tk_lfirst = lnp; + Push(&dummy); + bottom++; + } + /* Bottom points to lowest token to be dupped. */ + while (bottom <= oldtop) { + Push(bottom++); + Top->tk_lfirst = lnp; + } + } +} + +clr_stack() +{ + free_token = &Stack[0]; +} diff --git a/util/ego/cs/cs_stack.h b/util/ego/cs/cs_stack.h new file mode 100644 index 000000000..cd43c6577 --- /dev/null +++ b/util/ego/cs/cs_stack.h @@ -0,0 +1,18 @@ +extern Push(); /* (token_p tkp) + * Push the token in tkp on the fake-stack. + */ + +extern Pop(); /* (token_p tkp; offset size) + * Pop a token of size bytes from the fake-stack + * into tkp. If such a token is not there + * we put a dummy in tkp and adjust the fake-stack. + */ + +extern Dup(); /* (line_p lnp) + * Reflect the changes made by the dup-instruction + * in lnp to the EM-stack into the fake-stack. + */ + +extern clr_stack(); /* () + * Clear the fake-stack. + */ diff --git a/util/ego/cs/cs_vnm.h b/util/ego/cs/cs_vnm.h new file mode 100644 index 000000000..cf4be2835 --- /dev/null +++ b/util/ego/cs/cs_vnm.h @@ -0,0 +1,4 @@ +extern vnm(); /* (bblock_p bp) + * Performs the valuenumbering algorithm on the basic + * block in bp. + */ diff --git a/util/ego/ic/Makefile b/util/ego/ic/Makefile new file mode 100644 index 000000000..521880737 --- /dev/null +++ b/util/ego/ic/Makefile @@ -0,0 +1,88 @@ +EMH=../../../h +EML=../../../lib +CFLAGS= +DEBUG=../share +SHARE=../share +MALLOC= +IC=. +OBJECTS=ic.o ic_aux.o ic_lookup.o ic_io.o ic_lib.o +MOBJECTS=ic.m ic_aux.m ic_lookup.m ic_io.m ic_lib.m +SHOBJECTS=$(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)/aux.o +MSHOBJECTS=$(SHARE)/put.m $(SHARE)/alloc.m $(SHARE)/global.m $(SHARE)/debug.m $(SHARE)/files.m $(SHARE)/map.m $(SHARE)/lset.m $(SHARE)/cset.m +SRC=ic.h ic_aux.h ic_lib.h ic_lookup.h ic_io.h ic.c ic_aux.c ic_lib.c ic_lookup.c ic_io.c +.SUFFIXES: .m +.c.m: + ack -O -L -c.m $(CFLAGS) $< +.c.o: + cc $(CFLAGS) -c $< +all: $(OBJECTS) +ic: \ + $(OBJECTS) $(SHOBJECTS) + cc -i -o ic $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a $(MALLOC) +optim: $(MOBJECTS) $(MSHOBJECTS) + ego IC CF $(F) CA $(MOBJECTS) $(MSHOBJECTS) + ack -O -o ic.ego -.c lfile.m $(EML)/em_data.a + +lpr: + pr $(SRC) | lpr +dumpflop: + tar -uf /mnt/ego/ic/ic.tarf $(SRC) Makefile +# the next lines are generated automatically +# AUTOAUTOAUTOAUTOAUTOAUTO +ic.o: ../../../h/em_flag.h +ic.o: ../../../h/em_mes.h +ic.o: ../../../h/em_pseu.h +ic.o: ../../../h/em_spec.h +ic.o: ../share/alloc.h +ic.o: ../share/aux.h +ic.o: ../share/debug.h +ic.o: ../share/def.h +ic.o: ../share/files.h +ic.o: ../share/global.h +ic.o: ../share/map.h +ic.o: ../share/put.h +ic.o: ../share/types.h +ic.o: ic.h +ic.o: ic_aux.h +ic.o: ic_io.h +ic.o: ic_lib.h +ic.o: ic_lookup.h +ic_aux.o: ../../../h/em_mnem.h +ic_aux.o: ../../../h/em_pseu.h +ic_aux.o: ../../../h/em_spec.h +ic_aux.o: ../share/alloc.h +ic_aux.o: ../share/aux.h +ic_aux.o: ../share/debug.h +ic_aux.o: ../share/def.h +ic_aux.o: ../share/global.h +ic_aux.o: ../share/types.h +ic_aux.o: ic.h +ic_aux.o: ic_aux.h +ic_aux.o: ic_io.h +ic_aux.o: ic_lookup.h +ic_io.o: ../../../h/em_pseu.h +ic_io.o: ../../../h/em_spec.h +ic_io.o: ../share/alloc.h +ic_io.o: ../share/debug.h +ic_io.o: ../share/types.h +ic_io.o: ic.h +ic_io.o: ic_io.h +ic_io.o: ic_lookup.h +ic_lib.o: ../../../h/em_mes.h +ic_lib.o: ../../../h/em_pseu.h +ic_lib.o: ../../../h/em_spec.h +ic_lib.o: ../share/debug.h +ic_lib.o: ../share/files.h +ic_lib.o: ../share/global.h +ic_lib.o: ../share/types.h +ic_lib.o: ic.h +ic_lib.o: ic_io.h +ic_lib.o: ic_lib.h +ic_lib.o: ic_lookup.h +ic_lookup.o: ../../../h/em_spec.h +ic_lookup.o: ../share/alloc.h +ic_lookup.o: ../share/debug.h +ic_lookup.o: ../share/map.h +ic_lookup.o: ../share/types.h +ic_lookup.o: ic.h +ic_lookup.o: ic_lookup.h diff --git a/util/ego/ic/ic.c b/util/ego/ic/ic.c new file mode 100644 index 000000000..ee19c4656 --- /dev/null +++ b/util/ego/ic/ic.c @@ -0,0 +1,520 @@ +/* I N T E R M E D I A T E C O D E + * + * I C . C + */ + +#include +#include "../share/types.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_flag.h" +#include "../../../h/em_mes.h" +#include "ic_lookup.h" +#include "ic.h" +#include "ic_aux.h" +#include "ic_io.h" +#include "ic_lib.h" +#include "../share/alloc.h" +#include "../share/global.h" +#include "../share/files.h" +#include "../share/put.h" +#include "../share/aux.h" + + +/* Global variables */ + + +dblock_p db; +dblock_p curhol = (dblock_p) 0; /* hol block in current scope */ +dblock_p ldblock; /* last dblock */ +proc_p lproc; /* last proc */ +short tabval; /* used by table1, table2 and table3 */ +offset tabval2; +char string[IDL+1]; +line_p firstline; /* first line of current procedure */ +line_p lastline; /* last line read */ +int labelcount; /* # labels in current procedure */ +short fragm_type = DUNKNOWN; /* fragm. type: DCON, DROM or DUNKNOWN */ +short fragm_nr = 0; /* fragment number */ +obj_id lastoid = 0; +proc_id lastpid = 0; +dblock_id lastdid = 0; +lab_id lastlid = 0; + +offset mespar = UNKNOWN_SIZE; + /* argumument of ps_par message of current procedure */ + + +extern process_lines(); +extern int readline(); +extern line_p readoperand(); +extern line_p inpseudo(); + + +main(argc,argv) + int argc; + char *argv[]; +{ + /* The input files must be legal EM Compact + * Assembly Language files, as produced by the EM Peephole + * Optimizer. + * Their file names are passed as arguments. + * The output consists of the files: + * - lfile: the EM code in Intermediate Code format + * - dfile: the data block table file + * - pfile: the proc table file + * - pdump: the names of all procedures + * - ddump: the names of all data blocks + */ + + FILE *lfile, *dfile, *pfile, *pdump, *ddump; + + lfile = openfile(lname2,"w"); + pdump = openfile(argv[1],"w"); + ddump = openfile(argv[2],"w"); + while (next_file(argc,argv) != NULL) { + /* Read all EM input files, process the code + * and concatenate all output. + */ + process_lines(lfile); + dump_procnames(prochash,NPROCHASH,pdump); + dump_dblocknames(symhash,NSYMHASH,ddump); + /* Save the names of all procedures that were + * first come accross in this file. + */ + cleanprocs(prochash,NPROCHASH,PF_EXTERNAL); + cleandblocks(symhash,NSYMHASH,DF_EXTERNAL); + /* Make all procedure names that were internal + * in this input file invisible. + */ + } + fclose(lfile); + fclose(pdump); + fclose(ddump); + + + /* remove the remainder of the hashing tables */ + cleanprocs(prochash,NPROCHASH,0); + cleandblocks(symhash,NSYMHASH,0); + /* Now write the datablock table and the proctable */ + dfile = openfile(dname2,"w"); + putdtable(fdblock, dfile); + pfile = openfile(pname2,"w"); + putptable(fproc, pfile,FALSE); +} + + + +/* Value returned by readline */ + +#define NORMAL 0 +#define WITH_OPERAND 1 +#define EOFILE 2 +#define PRO_INSTR 3 +#define END_INSTR 4 +#define DELETED_INSTR 5 + + +STATIC add_end() +{ + /* Add an end-pseudo to the current instruction list */ + + lastline->l_next = newline(OPNO); + lastline = lastline->l_next; + lastline->l_instr = ps_end; +} + + +process_lines(fout) + FILE *fout; +{ + line_p lnp; + short instr; + bool eof; + + /* Read and process the code contained in the current file, + * on a per procedure basis. + * On the fly, fragments are formed. Recall that two + * successive CON pseudos are allocated consecutively + * in a single fragment, unless these CON pseudos are + * separated in the assembly language program by one + * of: ROM, BSS, HOL and END (and of course EndOfFile). + * The same is true for ROM pseudos. + * We keep track of a fragment type (DROM after a ROM + * pseudo, DCON after a CON and DUNKNOWN after a HOL, + * BSS, END or EndOfFile) and a fragment number (which + * is incremented every time we enter a new fragment). + * Every data block is assigned such a number + * when we come accross its defining occurrence. + */ + + eof = FALSE; + firstline = (line_p) 0; + lastline = (line_p) 0; + while (!eof) { + linecount++; /* for error messages */ + switch(readline(&instr, &lnp)) { + /* read one line, see what kind it is */ + case WITH_OPERAND: + /* instruction with operand, e.g. LOL 10 */ + lnp = readoperand(instr); + lnp->l_instr = instr; + /* Fall through! */ + case NORMAL: + VL(lnp); + if (lastline != (line_p) 0) { + lastline->l_next = lnp; + } + lastline = lnp; + break; + case EOFILE: + eof = TRUE; + fragm_type = DUNKNOWN; + if (firstline != (line_p) 0) { + add_end(); + putlines(firstline,fout); + firstline = (line_p) 0; + } + break; + case PRO_INSTR: + VL(lnp); + labelcount = 0; + if (firstline != lnp) { + /* If PRO is not the first + * instruction: + */ + add_end(); + putlines(firstline,fout); + firstline = lnp; + } + lastline = lnp; + break; + case END_INSTR: + curproc->p_nrformals = mespar; + mespar = UNKNOWN_SIZE; + assert(lastline != (line_p) 0); + lastline->l_next = lnp; + putlines(firstline,fout); + /* write and delete code */ + firstline = (line_p) 0; + lastline = (line_p) 0; + cleaninstrlabs(); + /* scope of instruction labels ends here, + * so forget about them. + */ + fragm_type = DUNKNOWN; + break; + case DELETED_INSTR: + /* EXP, INA etc. are deleted */ + break; + default: + error("illegal readline"); + } + } +} + + + +int readline(instr_out, lnp_out) + short *instr_out; + line_p *lnp_out; +{ + register line_p lnp; + short n; + + /* Read one line. If it is a normal EM instruction without + * operand, we can allocate a line struct for it here. + * If so, return a pointer to it via lnp_out, else just + * return the instruction code via instr_out. + */ + + VA((short *) instr_out); + VA((short *) lnp_out); + switch(table1()) { + /* table1 sets string, tabval or tabval2 and + * returns an indication of what was read. + */ + case ATEOF: + return EOFILE; + case INST: + *instr_out = tabval; /* instruction code */ + return WITH_OPERAND; + case DLBX: + /* data label defining occurrence, precedes + * a data block. + */ + db = block_of_lab(string); + /* global variable, used by inpseudo */ + lnp = newline(OPSHORT); + SHORT(lnp) = (short) db->d_id; + lnp->l_instr = ps_sym; + *lnp_out = lnp; + if (firstline == (line_p) 0) { + firstline = lnp; + /* only a pseudo (e.g. PRO) or data label + * can be the first instruction. + */ + } + return NORMAL; + case ILBX: + /* instruction label defining occurrence */ + labelcount++; + lnp = newline(OPINSTRLAB); + lnp->l_instr = op_lab; + INSTRLAB(lnp) = instr_lab(tabval); + *lnp_out = lnp; + return NORMAL; + case PSEU: + n = tabval; + lnp = inpseudo(n); /* read a pseudo */ + if (lnp == (line_p) 0) return DELETED_INSTR; + *lnp_out = lnp; + lnp->l_instr = n; + if (firstline == (line_p) 0) { + firstline = lnp; + /* only a pseudo (e.g. PRO) or data label + * can be the first instruction. + */ + } + if (n == ps_end) return END_INSTR; + if (n == ps_pro) return PRO_INSTR; + return NORMAL; + } + /* NOTREACHED */ +} + + +line_p readoperand(instr) + short instr; +{ + /* Read the operand of the given instruction. + * Create a line struct and return a pointer to it. + */ + + + register line_p lnp; + short flag; + + VI(instr); + flag = em_flag[ instr - sp_fmnem] & EM_PAR; + if (flag == PAR_NO) { + return (newline(OPNO)); + } + switch(table2()) { + case sp_cend: + return(newline(OPNO)); + case CSTX1: + /* constant */ + /* If the instruction has the address + * of an external variable as argument, + * the constant must be regarded as an + * offset in the current hol block, + * so an object must be created. + * Similarly, the instruction may have + * an instruction label as argument. + */ + switch(flag) { + case PAR_G: + lnp = newline(OPOBJECT); + OBJ(lnp) = + object((char *) 0,(offset) tabval, + opr_size(instr)); + break; + case PAR_B: + lnp = newline(OPINSTRLAB); + INSTRLAB(lnp) = instr_lab(tabval); + break; + default: + lnp = newline(OPSHORT); + SHORT(lnp) = tabval; + break; + } + break; +#ifdef LONGOFF + case CSTX2: + /* double constant */ + lnp = newline(OPOFFSET); + OFFSET(lnp) = tabval2; + break; +#endif + case ILBX: + /* applied occurrence instruction label */ + lnp = newline(OPINSTRLAB); + INSTRLAB(lnp) = instr_lab(tabval); + break; + case DLBX: + /* applied occurrence data label */ + lnp = newline(OPOBJECT); + OBJ(lnp) = object(string, (offset) 0, + opr_size(instr) ); + break; + case VALX1: + lnp = newline(OPOBJECT); + OBJ(lnp) = object(string, (offset) tabval, + opr_size(instr) ); + break; +#ifdef LONGOFF + case VALX2: + lnp = newline(OPOBJECT); + OBJ(lnp) = object(string,tabval2, + opr_size(instr) ); + break; +#endif + case sp_pnam: + lnp = newline(OPPROC); + PROC(lnp) = proclookup(string,OCCURRING); + VP(PROC(lnp)); + break; + default: + assert(FALSE); + } + return lnp; +} + + + +line_p inpseudo(n) + short n; +{ + int m; + line_p lnp; + byte pseu; + short nlast; + + /* Read the (remainder of) a pseudo instruction, the instruction + * code of which is n. The END pseudo may be deleted (return 0). + * The pseudos INA, EXA, INP and EXP (visibility pseudos) must + * also be deleted, although the effects they have on the + * visibility of global names and procedure names must first + * be recorded in the datablock or procedure table. + */ + + + switch(n) { + case ps_hol: + case ps_bss: + case ps_rom: + case ps_con: + if (lastline == (line_p) 0 || !is_datalabel(lastline)) { + if (n == ps_hol) { + /* A HOL need not be preceded + * by a label. + */ + curhol = db = block_of_lab((char *) 0); + } else { + assert(lastline != (line_p) 0); + nlast = INSTR(lastline); + if (n == nlast && + (n == ps_rom || n == ps_con)) { + /* Two successive roms/cons are + * combined into one data block + * if the second is not preceded by + * a data label. + */ + lnp = arglist(0); + pseu = (byte) (n == ps_rom?DROM:DCON); + combine(db,lastline,lnp,pseu); + oldline(lnp); + return (line_p) 0; + } else { + error("datablock without label"); + } + } + } + VD(db); + m = (n == ps_hol || n == ps_bss ? 3 : 0); + lnp = arglist(m); + /* Read the arguments, 3 for hol or bss and a list + * of undetermined length for rom and con. + */ + dblockdef(db,n,lnp); + /* Fill in d_pseudo, d_size and d_values fields of db */ + if (fragm_type != db->d_pseudo & BMASK) { + /* Keep track of fragment numbers, + * enter a new fragment. + */ + fragm_nr++; + switch(db->d_pseudo) { + case DCON: + case DROM: + fragm_type = db->d_pseudo; + break; + default: + fragm_type = DUNKNOWN; + break; + } + } + db->d_fragmnr = fragm_nr; + return lnp; + case ps_ina: + getsym(DEFINING); + /* Read and lookup a symbol. As this must be + * the first occurrence of the symbol and we + * say it's a defining occurrence, getsym will + * automatically make it internal (according to + * the EM visibility rules). + * The result (a dblock pointer) is voided. + */ + return (line_p) 0; + case ps_inp: + getproc(DEFINING); /* same idea */ + return (line_p) 0; + case ps_exa: + getsym(OCCURRING); + return (line_p) 0; + case ps_exp: + getproc(OCCURRING); + return (line_p) 0; + case ps_pro: + curproc = getproc(DEFINING); + /* This is a real defining occurrence of a proc */ + curproc->p_localbytes = get_off(); + curproc->p_flags1 |= PF_BODYSEEN; + /* Record the fact that we came accross + * the body of this procedure. + */ + lnp = newline(OPPROC); + PROC(lnp) = curproc; + lnp->l_instr = (byte) ps_pro; + return lnp; + case ps_end: + curproc->p_nrlabels = labelcount; + lnp = newline(OPNO); + get_off(); + /* Void # localbytes, which we already know + * from the PRO instruction. + */ + return lnp; + case ps_mes: + lnp = arglist(0); + switch((int) aoff(ARG(lnp),0)) { + case ms_err: + error("ms_err encountered"); + case ms_opt: + error("ms_opt encountered"); + case ms_emx: + ws = aoff(ARG(lnp),1); + ps = aoff(ARG(lnp),2); + break; + case ms_ext: + /* this message was already processed + * by the lib package + */ + case ms_src: + /* Don't bother about linecounts */ + oldline(lnp); + return (line_p) 0; + case ms_par: + mespar = aoff(ARG(lnp),1); + /* #bytes of parameters of current proc */ + break; + } + return lnp; + default: + assert(FALSE); + } + /* NOTREACHED */ +} diff --git a/util/ego/ic/ic.h b/util/ego/ic/ic.h new file mode 100644 index 000000000..c3e9f9e4b --- /dev/null +++ b/util/ego/ic/ic.h @@ -0,0 +1,42 @@ +/* I N T E R M E D I A T E C O D E + * + * G L O B A L C O N S T A N T S & V A R I A B L E S + */ + +/* macros used by ic_lib.c and ic_io.c: */ + +#define ARCHIVE 0 +#define NO_ARCHIVE 1 + + +/* + * The next constants are close to sp_cend for fast switches + */ +#define INST 256 /* instruction: number in tabval */ +#define PSEU 257 /* pseudo: number in tabval */ +#define ILBX 258 /* label: number in tabval */ +#define DLBX 259 /* symbol: name in string[] */ +#define CSTX1 260 /* short constant: stored in tabval */ +#define CSTX2 261 /* offset: value in tabval2 */ +#define VALX1 262 /* symbol+short: in string[] and tabval */ +#define VALX2 263 /* symbol+offset: in string[] and tabval2 */ +#define ATEOF 264 /* bumped into end of file */ + +/* Global variables */ + +extern dblock_p db; +extern dblock_p curhol; /* hol block in current scope */ +extern dblock_p ldblock; /* last dblock processed so far */ +extern proc_p lproc; /* last proc processed so far */ +extern short tabval; /* used by table1, table2 and table3 */ +extern offset tabval2; +extern char string[]; +extern line_p lastline; /* last line read */ +extern int labelcount; /* # labels in current procedure */ +extern obj_id lastoid; /* last object identifier used */ +extern proc_id lastpid; /* last proc identifier used */ +extern lab_id lastlid; /* last label identifier used */ +extern dblock_id lastdid; /* last dblock identifier used */ + +extern byte em_flag[]; + diff --git a/util/ego/ic/ic_aux.c b/util/ego/ic/ic_aux.c new file mode 100644 index 000000000..211d05a39 --- /dev/null +++ b/util/ego/ic/ic_aux.c @@ -0,0 +1,459 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ A U X . C + */ + + + +#include "../share/types.h" +#include "../share/global.h" +#include "../share/debug.h" +#include "../share/def.h" +#include "../share/aux.h" +#include "../../../h/em_pseu.h" +#include "../../../h/em_spec.h" +#include "../../../h/em_mnem.h" +#include "ic.h" +#include "ic_io.h" +#include "ic_lookup.h" +#include "../share/alloc.h" +#include "ic_aux.h" + + + +/* opr_size */ + +offset opr_size(instr) + short instr; +{ + switch(instr) { + case op_loe: + case op_ste: + case op_ine: + case op_dee: + case op_zre: + return (offset) ws; + case op_lde: + case op_sde: + return (offset) 2*ws; + case op_lae: + case op_fil: + return (offset) UNKNOWN_SIZE; + default: + error("illegal operand of opr_size: %d", instr); + } + /* NOTREACHED */ +} + + + +/* dblockdef */ + +STATIC offset argsize(arg) + arg_p arg; +{ + /* Compute the size (in bytes) that the given initializer + * will occupy. + */ + + offset s; + argb_p argb; + + switch(arg->a_type) { + case ARGOFF: + /* See if value fits in a short */ + if ((short) arg->a_a.a_offset == arg->a_a.a_offset) { + return ws; + } else { + return 2*ws; + } + case ARGINSTRLAB: + case ARGOBJECT: + case ARGPROC: + return ps; /* pointer size */ + case ARGSTRING: + /* strings are partitioned into pieces */ + s = 0; + for (argb = &arg->a_a.a_string; argb != (argb_p) 0; + argb = argb->ab_next) { + s += argb->ab_index; + } + return s; + case ARGICN: + case ARGUCN: + case ARGFCN: + return arg->a_a.a_con.ac_length; + default: + assert(FALSE); + } + /* NOTREACHED */ +} + + +STATIC offset blocksize(pseudo,args) + byte pseudo; + arg_p args; +{ + /* Determine the number of bytes of a datablock */ + + arg_p arg; + offset sum; + + switch(pseudo) { + case DHOL: + case DBSS: + if (args->a_type != ARGOFF) { + error("offset expected"); + } + return args->a_a.a_offset; + case DCON: + case DROM: + sum = 0; + for (arg = args; arg != (arg_p) 0; arg = arg->a_next) { + /* Add the sizes of all initializers */ + sum += argsize(arg); + } + return sum; + default: + assert(FALSE); + } + /* NOTREACHED */ +} + + +STATIC arg_p copy_arg(arg) + arg_p arg; +{ + /* Copy one argument */ + + arg_p new; + + assert(arg->a_type == ARGOFF); + new = newarg(ARGOFF); + new->a_a.a_offset = arg->a_a.a_offset; + return new; +} + + + +STATIC arg_p copy_rom(args) + arg_p args; +{ + /* Make a copy of the values of a rom, + * provided that the rom contains only integer values, + */ + + arg_p arg, arg2, argh; + + for (arg = args; arg != (arg_p) 0; arg = arg->a_next) { + if (arg->a_type != ARGOFF) { + return (arg_p) 0; + } + } + /* Now make the copy */ + arg2 = argh = copy_arg(args); + for (arg = args->a_next; arg != (arg_p) 0; arg = arg->a_next) { + arg2->a_next = copy_arg(arg); + arg2 = arg2->a_next; + } + return argh; +} + + + +dblockdef(db,n,lnp) + dblock_p db; + int n; + line_p lnp; +{ + /* Process a data block defining occurrence */ + + byte m; + + switch(n) { + case ps_hol: + m = DHOL; + break; + case ps_bss: + m = DBSS; + break; + case ps_con: + m = DCON; + break; + case ps_rom: + m = DROM; + break; + default: + assert(FALSE); + } + db->d_pseudo = m; + db->d_size = blocksize(m, ARG(lnp)); + if (m == DROM) { + /* We keep the values of a rom block in the data block + * table if the values consist of integers only. + */ + db->d_values = copy_rom(ARG(lnp)); + } +} + + + +/* combine */ + +combine(db,l1,l2,pseu) + dblock_p db; + line_p l1,l2; + byte pseu; +{ + /* Combine two successive ROMs/CONs (without a data label + * in between into a single ROM. E.g.: + * xyz + * rom 3,6,9,12 + * rom 7,0,2 + * is changed into: + * xyz + * rom 3,6,9,12,7,0,2 + */ + + arg_p v; + + db->d_size += blocksize(pseu,ARG(l2)); + /* db is the data block that was already assigned to the + * first rom/con. The second one is not assigned a new + * data block of course, as the two are combined into + * one instruction. + */ + if (pseu == DROM && db->d_values != (arg_p) 0) { + /* The values contained in a ROM are only copied + * to the data block if they may be useful to us + * (e.g. they certainly may not be strings). In our + * case it means that both ROMs must have useful + * arguments. + */ + for (v = db->d_values; v->a_next != (arg_p) 0; v = v->a_next); + /* The first rom contained useful arguments. v now points to + * its last argument. Append the arguments of the second + * rom to this list. If the second rom has arguments that are + * not useful, throw away the entire list (we want to copy + * everything or nothing). + */ + if ((v->a_next = copy_rom(ARG(l2))) == (arg_p) 0) { + oldargs(db->d_values); + db->d_values = (arg_p) 0; + } + } + for (v = ARG(l1); v->a_next != (arg_p) 0; v = v->a_next); + /* combine the arguments of both instructions. */ + v->a_next = ARG(l2); + ARG(l2) = (arg_p) 0; +} + + + +/* arglist */ + +STATIC arg_string(length,abp) + offset length; + register argb_p abp; +{ + + while (length--) { + if (abp->ab_index == NARGBYTES) + abp = abp->ab_next = newargb(); + abp->ab_contents[abp->ab_index++] = readchar(); + } +} + + +line_p arglist(n) + int n; +{ + line_p lnp; + register arg_p ap,*app; + bool moretocome; + offset length; + + + /* + * creates an arglist with n elements + * if n == 0 the arglist is variable and terminated by sp_cend + */ + + lnp = newline(OPLIST); + app = &ARG(lnp); + moretocome = TRUE; + do { + switch(table2()) { + default: + error("unknown byte in arglist"); + case CSTX1: + tabval2 = (offset) tabval; + case CSTX2: + *app = ap = newarg(ARGOFF); + ap->a_a.a_offset = tabval2; + app = &ap->a_next; + break; + case ILBX: + *app = ap = newarg(ARGINSTRLAB); + ap->a_a.a_instrlab = instr_lab((short) tabval); + app = &ap->a_next; + break; + case DLBX: + *app = ap = newarg(ARGOBJECT); + ap->a_a.a_obj = object(string,(offset) 0, (offset) 0); + /* The size of the object is unknown */ + app = &ap->a_next; + break; + case sp_pnam: + *app = ap = newarg(ARGPROC); + ap->a_a.a_proc = proclookup(string,OCCURRING); + app = &ap->a_next; + break; + case VALX1: + tabval2 = (offset) tabval; + case VALX2: + *app = ap = newarg(ARGOBJECT); + ap->a_a.a_obj = object(string, tabval2, (offset) 0); + app = &ap->a_next; + break; + case sp_scon: + *app = ap = newarg(ARGSTRING); + length = get_off(); + arg_string(length,&ap->a_a.a_string); + app = &ap->a_next; + break; + case sp_icon: + *app = ap = newarg(ARGICN); + goto casecon; + case sp_ucon: + *app = ap = newarg(ARGUCN); + goto casecon; + case sp_fcon: + *app = ap = newarg(ARGFCN); + casecon: + length = get_int(); + ap->a_a.a_con.ac_length = (short) length; + arg_string(get_off(),&ap->a_a.a_con.ac_con); + app = &ap->a_next; + break; + case sp_cend: + moretocome = FALSE; + } + if (n && (--n) == 0) + moretocome = FALSE; + } while (moretocome); + return(lnp); +} + + + +/* is_datalabel */ + +bool is_datalabel(l) + line_p l; +{ + VL(l); + return (l->l_instr == (byte) ps_sym); +} + + + +/* block_of_lab */ + +dblock_p block_of_lab(ident) + char *ident; +{ + dblock_p dbl; + + /* Find the datablock with the given name. + * Used for defining occurrences. + */ + + dbl = symlookup(ident,DEFINING); + VD(dbl); + if (dbl->d_pseudo != DUNKNOWN) { + error("identifier redeclared"); + } + return dbl; +} + + + +/* object */ + +STATIC obj_p make_object(dbl,off,size) + dblock_p dbl; + offset off; + offset size; +{ + /* Allocate an obj struct with the given attributes + * (if it did not exist already). + * Return a pointer to the found or newly created object struct. + */ + + obj_p obj, prev, new; + + /* See if the object was already present in the object list + * of the given datablock. If it is not yet present, find + * the right place to insert the new object. Note that + * the objects are sorted by offset. + */ + prev = (obj_p) 0; + for (obj = dbl->d_objlist; obj != (obj_p) 0; obj = obj->o_next) { + if (obj->o_off >= off) { + break; + } + prev = obj; + } + /* Note that the data block may contain several objects + * with the required offset; we also want the size to + * be the right one. + */ + while (obj != (obj_p) 0 && obj->o_off == off) { + if (obj->o_size == UNKNOWN_SIZE) { + obj->o_size = size; + return obj; + } else { + if (size == UNKNOWN_SIZE || obj->o_size == size) { + return obj; + /* This is the right one */ + } else { + prev = obj; + obj = obj->o_next; + } + } + } + /* Allocate a new object */ + new = newobject(); + new->o_id = ++lastoid; /* create a unique object id */ + new->o_off = off; + new->o_size = size; + new->o_dblock = dbl; + /* Insert the new object */ + if (prev == (obj_p) 0) { + dbl->d_objlist = new; + } else { + prev->o_next = new; + } + new->o_next = obj; + return new; +} + + + +obj_p object(ident,off,size) + char *ident; + offset off; + offset size; +{ + dblock_p dbl; + + /* Create an object struct (if it did not yet exist) + * for the object with the given size and offset + * within the datablock of the given name. + */ + + dbl = (ident == (char *) 0 ? curhol : symlookup(ident, OCCURRING)); + VD(dbl); + return(make_object(dbl,off,size)); +} diff --git a/util/ego/ic/ic_aux.h b/util/ego/ic/ic_aux.h new file mode 100644 index 000000000..887e43150 --- /dev/null +++ b/util/ego/ic/ic_aux.h @@ -0,0 +1,39 @@ +/* I N T E R M E D I A T E C O D E + * + * A U X I L I A R Y R O U T I N E S + */ + + + +extern offset opr_size(); /* ( short instr ) + * size of operand of given instruction. + * The operand is an object , so the + * instruction can be loe, zre etc.. + */ +extern dblockdef(); /* (dblock_p db, int n, line_p lnp) + * Fill in d_pseudo, d_size and + * d_values fields of db. + */ +extern combine(); /* (dblock_p db;line_p l1,l2;byte pseu) + * Combine two successive ROMs or CONs + * (with no data label in between) + * into one ROM or CON. + */ +extern line_p arglist(); /* ( int m) + * Read a list of m arguments. If m + * is 0, then the list is of + * undetermined length; it is + * then terminated by a cend symbol. + */ +extern bool is_datalabel(); /* ( line_p l) + * TRUE if l is a data label defining + * occurrence (i.e. its l_instr + * field is ps_sym). + */ +extern dblock_p block_of_lab(); /* (char *ident) + * Find the datablock with + * the given name. + */ +extern obj_p object(); /* (char *ident,offset off,short size) + * Create an object struct. + */ diff --git a/util/ego/ic/ic_io.c b/util/ego/ic/ic_io.c new file mode 100644 index 000000000..017ff1e60 --- /dev/null +++ b/util/ego/ic/ic_io.c @@ -0,0 +1,204 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ I O . C + */ + + + +#include +#include "../share/types.h" +#include "../share/debug.h" +#include "../../../h/em_pseu.h" +#include "../../../h/em_spec.h" +#include "../../../h/arch.h" +#include "ic.h" +#include "ic_lookup.h" +#include "../share/alloc.h" +#include "ic_io.h" + + +STATIC short libstate; +STATIC long bytecnt; + +STATIC FILE *infile; /* The current EM input file */ + +STATIC int readbyte() +{ + if (libstate == ARCHIVE && bytecnt-- == 0L) { + /* If we're reading from an archive file, we'll + * have to count the number of characters read, + * to know where the current module ends. + */ + return EOF; + } + return getc(infile); +} + + + + +short readshort() { + register int l_byte, h_byte; + + l_byte = readbyte(); + h_byte = readbyte(); + if ( h_byte>=128 ) h_byte -= 256 ; + return l_byte | (h_byte*256) ; +} + +#ifdef LONGOFF +offset readoffset() { + register long l; + register int h_byte; + + l = readbyte(); + l |= ((unsigned) readbyte())*256 ; + l |= readbyte()*256L*256L ; + h_byte = readbyte() ; + if ( h_byte>=128 ) h_byte -= 256 ; + return l | (h_byte*256L*256*256L) ; +} +#endif + + +short get_int() { + + switch(table2()) { + default: error("int expected"); + case CSTX1: + return(tabval); + } +} + +char readchar() +{ + return(readbyte()); +} + + + +offset get_off() { + + switch (table2()) { + default: error("offset expected"); + case CSTX1: + return((offset) tabval); +#ifdef LONGOFF + case CSTX2: + return(tabval2); +#endif + } +} + +STATIC make_string(n) int n; { + register char *s; + extern char *sprintf(); + + s=sprintf(string,".%u",n); + assert(s == string); +} + +STATIC inident() { + register n; + register char *p = string; + register c; + + n = get_int(); + while (n--) { + c = readbyte(); + if (p<&string[IDL]) + *p++ = c; + } + *p++ = 0; +} + +int table3(n) int n; { + + switch (n) { + case sp_ilb1: tabval = readbyte(); return(ILBX); + case sp_ilb2: tabval = readshort(); return(ILBX); + case sp_dlb1: make_string(readbyte()); return(DLBX); + case sp_dlb2: make_string(readshort()); return(DLBX); + case sp_dnam: inident(); return(DLBX); + case sp_pnam: inident(); return(n); + case sp_cst2: tabval = readshort(); return(CSTX1); +#ifdef LONGOFF + case sp_cst4: tabval2 = readoffset(); return(CSTX2); +#endif + case sp_doff: if (table2()!=DLBX) error("symbol expected"); + switch(table2()) { + default: error("offset expected"); + case CSTX1: return(VALX1); +#ifdef LONGOFF + case CSTX2: return(VALX2); +#endif + } + default: return(n); + } +} + +int table1() { + register n; + + n = readbyte(); + if (n == EOF) + return(ATEOF); + if ((n <= sp_lmnem) && (n >= sp_fmnem)) { + tabval = n; + return(INST); + } + if ((n <= sp_lpseu) && (n >= sp_fpseu)) { + tabval = n; + return(PSEU); + } + if ((n < sp_filb0 + sp_nilb0) && (n >= sp_filb0)) { + tabval = n - sp_filb0; + return(ILBX); + } + return(table3(n)); +} + +int table2() { + register n; + + n = readbyte(); + if ((n < sp_fcst0 + sp_ncst0) && (n >= sp_fcst0)) { + tabval = n - sp_zcst0; + return(CSTX1); + } + return(table3(n)); +} + + + + +file_init(f,state,length) + FILE *f; + short state; + long length; +{ + short n; + + infile = f; + libstate = state; + bytecnt = length; + linecount = 0; + n = readshort(); + if (n != (short) sp_magic) { + error("wrong magic number: %d", n); + } +} + + + +arch_init(arch) + FILE *arch; +{ + short n; + + infile = arch; + n = readshort(); + if (n != ARMAG) { + error("wrong archive magic number: %d",n); + } +} diff --git a/util/ego/ic/ic_io.h b/util/ego/ic/ic_io.h new file mode 100644 index 000000000..30bb194fe --- /dev/null +++ b/util/ego/ic/ic_io.h @@ -0,0 +1,34 @@ +/* I N T E R M E D I A T E C O D E + * + * L O W L E V E L I / O R O U T I N E S + */ + + +extern int table1(); /* ( ) + * Read an instruction from the + * Compact Assembly Language input + * file (in 'neutral state'). + */ +extern int table2(); /* ( ) + * Read an instruction argument. + */ +extern int table3(); /* ( int ) + * Read 'Common Table' item. + */ +extern short get_int(); /* ( ) */ +extern offset get_off(); /* ( ) */ +extern char readchar(); /* ( ) */ +extern file_init(); /* (FILE *f, short state, long length) + * Input file initialization. All + * following read operations will read + * from the given file f. Also checks + * the magic number and sets global + * variable 'linecount' to 0. + * If the state is ARCHIVE, length + * specifies the length of the module. + */ +extern arch_init(); /* (FILE *arch) + * Same as file_init,but opens an + * archive file. So it checks the + * magic number for archives. + */ diff --git a/util/ego/ic/ic_lib.c b/util/ego/ic/ic_lib.c new file mode 100644 index 000000000..b30cd5ace --- /dev/null +++ b/util/ego/ic/ic_lib.c @@ -0,0 +1,274 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ L I B . C + */ + + +#include +#include "../share/types.h" +#include "../share/debug.h" +#include "../../../h/em_spec.h" +#include "../../../h/em_pseu.h" +#include "../../../h/em_mes.h" +#include "../../../h/arch.h" +#include "ic_lookup.h" +#include "ic.h" +#include "ic_io.h" +#include "../share/global.h" +#include "../share/files.h" +#include "ic_lib.h" + + +STATIC skip_string(n) + offset n; +{ + /* Read a string of length n and void it */ + + while (n--) { + readchar(); + } +} + + +STATIC skip_arguments() +{ + /* Skip the arguments of a MES pseudo. The argument + * list is terminated by a sp_cend byte. + */ + + for (;;) { + switch(table2()) { + case sp_scon: + get_off(); /* void */ + /* fall through !!! */ + case sp_icon: + case sp_ucon: + case sp_fcon: + get_int(); /* void */ + skip_string(get_off()); + break; + case sp_cend: + return; + default: + break; + } + } +} + + + +STATIC bool proc_wanted(name) + char *name; +{ + /* See if 'name' is the name of an external procedure + * that has been used before, but for which no body + * has been given so far. + */ + + proc_p p; + + if (( p = proclookup(name,IMPORTING)) != (proc_p) 0 && + !(p->p_flags1 & PF_BODYSEEN)) { + return TRUE; + } else { + return FALSE; + } +} + + + +STATIC bool data_wanted(name) + char *name; +{ + /* See if 'name' is the name of an externally visible + * data block that has been used before, but for which + * no defining occurrence has been given yet. + */ + + dblock_p db; + + if ((db = symlookup(name,IMPORTING)) != (dblock_p) 0 && + db->d_pseudo == DUNKNOWN) { + return TRUE; + } else { + return FALSE; + } +} + + + +STATIC bool wanted_names() +{ + /* Read the names of procedures and data labels, + * appearing in a 'MES ms_ext' pseudo. Those are + * the names of entities that are imported by + * a library module. + * If any of them is wanted, return TRUE. + * A name is wanted if it is the name of a procedure + * or data block for which applied occurrences but + * no defining occurrence has been met. + */ + + for (;;) { + switch(table2()) { + case DLBX: + if (data_wanted(string)) { + return TRUE; + } + /* A data entity with the name + * string is available. + */ + break; + case sp_pnam: + if (proc_wanted(string)) { + return TRUE; + } + break; + case sp_cend: + return FALSE; + default: + error("wrong argument of MES %d", ms_ext); + } + } +} + + + +STATIC FILE *curfile = NULL; +STATIC bool useful() +{ + /* Determine if any entity imported by the current + * compact EM assembly file (which will usually be + * part of an archive file) is useful to us. + * The file must contain (before any other non-MES line) + * a 'MES ms_ext' pseudo that has as arguments the names + * of the entities imported. + */ + + for (;;) { + if (table1() != PSEU || tabval != ps_mes) { + error("cannot find MES %d in library file",ms_ext); + } + if (table2() != CSTX1) { + error("message number expected"); + } + if (tabval == ms_ext) { + /* This is the one we searched */ + return wanted_names(); + /* Read the names of the imported entities + * and check if any of them is wanted. + */ + } else { + skip_arguments(); /* skip remainder of this MES */ + } + } +} + + + +STATIC bool is_archive(name) + char *name; +{ + /* See if 'name' is the name of an archive file, i.e. it + * should end on ".a" and should at least be three characters + * long (i.e. the name ".a" is not accepted as an archive name!). + */ + + register char *p; + + for (p = name; *p; p++); + return (p > name+2) && (*--p == 'a') && (*--p == '.'); +} + + + +STATIC struct ar_hdr hdr; + +STATIC bool read_hdr() +{ + /* Read the header of an archive module */ + + + fread(&hdr, sizeof(hdr), 1, curfile); + return !feof(curfile); +} + + + +STATIC int argcnt = ARGSTART - 1; +STATIC short arstate = NO_ARCHIVE; + + +FILE *next_file(argc,argv) + int argc; + char *argv[]; +{ + /* See if there are more EM input files. The file names + * are given via argv. If a file is an archive file + * it is supposed to be a library of EM compact assembly + * files. A module (file) contained in this archive file + * is only used if it imports at least one procedure or + * datalabel for which we have not yet seen a defining + * occurrence, although we have seen a used occurrence. + */ + + long ptr; + + for (;;) { + /* This loop is only exited via a return */ + if (arstate == ARCHIVE) { + /* We were reading an archive file */ + if (ftell(curfile) & 1) { + /* modules in an archive file always + * begin on a word boundary, i.e. at + * an even address. + */ + fseek(curfile,1L,1); + } + if (read_hdr()) { /* read header of next module */ + ptr = ftell(curfile); /* file position */ + file_init(curfile,ARCHIVE,hdr.ar_size); + /* tell i/o package that we're reading + * an archive module of given length. + */ + if (useful()) { + /* re-initialize file, because 'useful' + * has read some bytes too. + */ + fseek(curfile,ptr,0); /* start module */ + file_init(curfile,ARCHIVE,hdr.ar_size); + return curfile; + } else { + /* skip this module */ + fseek(curfile, + ptr+hdr.ar_size,0); + } + } else { + /* done with this archive */ + arstate = NO_ARCHIVE; + } + } else { + /* open next file, close old */ + if (curfile != NULL) { + fclose(curfile); + } + argcnt++; + if (argcnt >= argc) { + /* done with all arguments */ + return NULL; + } + filename = argv[argcnt]; + if ((curfile = fopen(filename,"r")) == NULL) { + error("cannot open %s",filename); + } + if (is_archive(filename)) { + /* ends on '.a' */ + arstate = ARCHIVE; + arch_init(curfile); /* read magic ar number */ + } else { + file_init(curfile,NO_ARCHIVE,0L); + return curfile; + } + } + } +} diff --git a/util/ego/ic/ic_lib.h b/util/ego/ic/ic_lib.h new file mode 100644 index 000000000..75d0b22e9 --- /dev/null +++ b/util/ego/ic/ic_lib.h @@ -0,0 +1,14 @@ +/* I N T E R M E D I A T E C O D E + * + * L I B R A R Y M A N A G E R + */ + + +extern FILE *next_file(); /* (int argc, char *argv[]) + * See if there are any more EM input files. + * 'argv' contains the names of the files + * that are passed as arguments to ic. + * If an argument is a library (archive + * file) only those modules that are useful + * are used. + */ diff --git a/util/ego/ic/ic_lookup.c b/util/ego/ic/ic_lookup.c new file mode 100644 index 000000000..69f2f4d38 --- /dev/null +++ b/util/ego/ic/ic_lookup.c @@ -0,0 +1,405 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ L O O K U P . C + */ + + +#include +#include "../share/types.h" +#include "../share/debug.h" +#include "../share/map.h" +#include "../../../h/em_spec.h" +#include "ic.h" +#include "ic_lookup.h" +#include "../share/alloc.h" + + +sym_p symhash[NSYMHASH]; +prc_p prochash[NPROCHASH]; +num_p numhash[NNUMHASH]; + + + +/* instr_lab */ + + + + + +lab_id instr_lab(number) + short number; +{ + register num_p *npp, np; + + /* In EM assembly language, a label is an unsigned number, + * e.g. 120 in 'BRA *120'. In IC the labels of a procedure + * are represented by consecutive integer numbers, called + * lab_id. The mapping takes place here. + */ + + + npp = &numhash[number%NNUMHASH]; + while (*npp != (num_p) 0) { + if ((*npp)->n_number == number) { + return(*npp)->n_labid; + } else { + npp = &(*npp)->n_next; + } + } + + /* The label was not found in the hashtable, so + * create a new entry for it. + */ + + *npp = np = newnum(); + np->n_number = number; + np->n_labid = ++lastlid; + /* Assign a new label identifier to the num struct. + * lastlid is reset to 0 at the beginning of + * every new EM procedure (by cleaninstrlabs). + */ + return (np->n_labid); +} + + + +/* symlookup */ + +STATIC unsigned hash(string) char *string; { + register char *p; + register unsigned i,sum; + + for (sum=i=0,p=string;*p;i += 3) + sum ^= (*p++)<<(i&07); + return(sum); +} + +dblock_p symlookup(name, status) + char *name; + int status; +{ + /* Look up the name of a data block. The name can appear + * in either a defining or applied occurrence (status is + * DEFINING, OCCURRING resp.), or in a MES ms_ext instruction + * as the name of a data block imported by a library module + * (status is IMPORTING). Things get complicated, + * because a HOL pseudo need not be preceded by a + * data label, i.e. a hol block need not have a name. + */ + + + register sym_p *spp, sp; + register dblock_p dp; + + if (name == (char *) 0) { + assert(status == DEFINING); + dp = newdblock(); + } else { + spp = &symhash[hash(name)%NSYMHASH]; + while (*spp != (sym_p) 0) { + /* Every hashtable entry points to a list + * of synonyms (i.e. names with the same + * hash values). Try to find 'name' in its + * list. + */ + if (strncmp((*spp)->sy_name, name, IDL) == 0) { + /* found */ + return ((*spp)->sy_dblock); + } else { + spp = &(*spp)->sy_next; + } + } + /* The name is not found, so create a new entry for it. + * However, if the status is IMPORTING, we just return 0, + * indicating that we don't need this name. + */ + if (status == IMPORTING) return (dblock_p) 0; + *spp = sp = newsym(); + strncpy(sp->sy_name, name, IDL); + dp = sp->sy_dblock = newdblock(); + } + if (fdblock == (dblock_p) 0) { + fdblock = dp; + /* first data block */ + } else { + ldblock->d_next = dp; /* link to last dblock */ + } + ldblock = dp; + dp->d_pseudo = DUNKNOWN; /* clear all fields */ + dp->d_id = ++lastdid; + dp->d_size = 0; + dp->d_objlist = (obj_p) 0; + dp->d_values = (arg_p) 0; + dp->d_next = (dblock_p) 0; + dp->d_flags1 = 0; + dp->d_flags2 = 0; + if (status == OCCURRING) { + /* This is the first occurrence of the identifier, + * so if it is a used occurrence make the + * identifier externally visible, else make it + * internal. + */ + dp->d_flags1 |= DF_EXTERNAL; + } + return dp; +} + + + +/* getsym */ + +dblock_p getsym(status) + int status; +{ + if (table2() != DLBX) { + error("symbol expected"); + } + return(symlookup(string,status)); +} + + + +/* getproc */ + +proc_p getproc(status) + int status; +{ + if (table2() != sp_pnam) { + error("proc name expected"); + } + return(proclookup(string,status)); +} + + + +/* proclookup */ + +proc_p proclookup(name, status) + char *name; + int status; +{ + register prc_p *ppp, pp; + register proc_p dp; + + ppp = &prochash[hash(name)%NPROCHASH]; + while (*ppp != (prc_p) 0) { + /* Every hashtable entry points to a list + * of synonyms (i.e. names with the same + * hash values). Try to find 'name' in its + * list. + */ + if (strncmp((*ppp)->pr_name, name, IDL) == 0) { + /* found */ + return ((*ppp)->pr_proc); + } else { + ppp = &(*ppp)->pr_next; + } + } + /* The name is not found, so create a new entry for it, + * unless the status is IMPORTING, in which case we + * return 0, indicating we don't want this proc. + */ + if (status == IMPORTING) return (proc_p) 0; + *ppp = pp = newprc(); + strncpy(pp->pr_name, name, IDL); + dp = pp->pr_proc = newproc(); + if (fproc == (proc_p) 0) { + fproc = dp; /* first proc */ + } else { + lproc->p_next = dp; + } + lproc = dp; + dp->p_id = ++lastpid; /* create a unique proc_id */ + dp->p_next = (proc_p) 0; + dp->p_flags1 = 0; + dp->p_flags2 = 0; + if (status == OCCURRING) { + /* This is the first occurrence of the identifier, + * so if it is a used occurrence the make the + * identifier externally visible, else make it + * internal. + */ + dp->p_flags1 |= PF_EXTERNAL; + } + return dp; +} + + + +/* cleaninstrlabs */ + +cleaninstrlabs() +{ + register num_p *npp, np, next; + + for (npp = numhash; npp < &numhash[NNUMHASH]; npp++) { + for (np = *npp; np != (num_p) 0; np = next) { + next = np->n_next; + oldnum(np); + } + *npp = (num_p) 0; + } + /* Reset last label id (used by instr_lab). */ + lastlid = (lab_id) 0; +} + + + +/* dump_procnames */ + +dump_procnames(hash,n,f) + prc_p hash[]; + int n; + FILE *f; +{ + /* Save the names of the EM procedures in file f. + * Note that the Optimizer Intermediate Code does not + * use identifiers but proc_ids, object_ids etc. + * The names, however, can be used after optimization + * is completed, to reconstruct Compact Assembly Language. + * The output consists of tuples (proc_id, name). + * This routine is called once for every input file. + * To prevent names of external procedures being written + * more than once, the PF_WRITTEN flag is used. + */ + + register prc_p *pp, ph; + proc_p p; + char str[IDL+1]; + register int i; + +#define PF_WRITTEN 01 + + + for (pp = &hash[0]; pp < &hash[n]; pp++) { + /* Traverse the entire hash table */ + for (ph = *pp; ph != (prc_p) 0; ph = ph->pr_next) { + /* Traverse the list of synonyms */ + p = ph->pr_proc; + if ((p->p_flags2 & PF_WRITTEN) == 0) { + /* not been written yet */ + for(i = 0; i < IDL; i++) { + str[i] = ph->pr_name[i]; + } + str[IDL] = '\0'; + fprintf(f,"%d %s\n",p->p_id, str); + p->p_flags2 |= PF_WRITTEN; + } + } + } +} + + + +/* cleanprocs */ + +cleanprocs(hash,n,mask) + prc_p hash[]; + int n,mask; +{ + /* After an EM input file has been processed, the names + * of those procedures that are internal (i.e. not visible + * outside the file they are defined in) must be removed + * from the procedure hash table. This is accomplished + * by removing the 'prc struct' from its synonym list. + * After the final input file has been processed, all + * remaining prc structs are also removed. + */ + + register prc_p *pp, ph, x, next; + + for (pp = &hash[0]; pp < &hash[n]; pp++) { + /* Traverse the hash table */ + x = (prc_p) 0; + for (ph = *pp; ph != (prc_p) 0; ph = next) { + /* Traverse the synonym list. + * x points to the prc struct just before ph, + * or is 0 if ph is the first struct of + * the list. + */ + next = ph->pr_next; + if ((ph->pr_proc->p_flags1 & mask) == 0) { + if (x == (prc_p) 0) { + *pp = next; + } else { + x->pr_next = next; + } + oldprc(ph); /* delete the struct */ + } else { + x = ph; + } + } + } +} + + + +/* dump_dblocknames */ + +dump_dblocknames(hash,n,f) + sym_p hash[]; + int n; + FILE *f; +{ + /* Save the names of the EM data blocks in file f. + * The output consists of tuples (dblock_id, name). + * This routine is called once for every input file. + */ + + register sym_p *sp, sh; + dblock_p d; + char str[IDL+1]; + register int i; + +#define DF_WRITTEN 01 + + + for (sp = &hash[0]; sp < &hash[n]; sp++) { + /* Traverse the entire hash table */ + for (sh = *sp; sh != (sym_p) 0; sh = sh->sy_next) { + /* Traverse the list of synonyms */ + d = sh->sy_dblock; + if ((d->d_flags2 & DF_WRITTEN) == 0) { + /* not been written yet */ + for (i = 0; i < IDL; i++) { + str[i] = sh->sy_name[i]; + str[IDL] = '\0'; + } + fprintf(f,"%d %s\n",d->d_id, str); + d->d_flags2 |= DF_WRITTEN; + } + } + } +} + + + +/* cleandblocks */ + +cleandblocks(hash,n,mask) + sym_p hash[]; + int n,mask; +{ + /* After an EM input file has been processed, the names + * of those data blocks that are internal must be removed. + */ + + register sym_p *sp, sh, x, next; + + for (sp = &hash[0]; sp < &hash[n]; sp++) { + x = (sym_p) 0; + for (sh = *sp; sh != (sym_p) 0; sh = next) { + next = sh->sy_next; + if ((sh->sy_dblock->d_flags1 & mask) == 0) { + if (x == (sym_p) 0) { + *sp = next; + } else { + x->sy_next = next; + } + oldsym(sh); /* delete the struct */ + } else { + x = sh; + } + } + } +} diff --git a/util/ego/ic/ic_lookup.h b/util/ego/ic/ic_lookup.h new file mode 100644 index 000000000..6d7d287a2 --- /dev/null +++ b/util/ego/ic/ic_lookup.h @@ -0,0 +1,71 @@ +/* I N T E R M E D I A T E C O D E + * + * L O O K - U P R O U T I N E S + */ + +/* During Intermediate Code generation data label names ('symbols'), + * procedure names and instruction labels (numbers) are translated + * to resp. a data block pointer, a proc pointer and a label identifier. + * We use three hash tables for this purpose (symhash, prochash, numhash). + * Every name/number is hashed to an index in a specific table. A table + * entry contains a list of structs (sym, prc, num), each one representing + * a 'synonym'. (Synonyms are names/numbers having the same hash value). + */ + + +/* status passed as argument to look_up routines: + * resp. used occurrence, defining occurrence, occurrence in + * a MES ms_ext pseudo. + */ + +#define OCCURRING 0 +#define DEFINING 1 +#define IMPORTING 2 + +#define NSYMHASH 127 +#define NPROCHASH 127 +#define NNUMHASH 37 + +extern sym_p symhash[]; +extern prc_p prochash[]; +extern num_p numhash[]; + +extern lab_id instr_lab(); /* ( short number) + * Maps EM labels to sequential + * integers. + */ +extern dblock_p symlookup(); /* (char *ident, int status) + * Look up the data block with + * the given name. + */ +extern dblock_p getsym(); /* ( int status) + * Read and look up a symbol. + * If this is the first occurrence + * of it, then make it external + * (if status=OCCURRING) or + * internal (if DEFINING). + */ +extern proc_p getproc(); /* (int status) + * Same as getsym, but for procedure + * names. + */ +extern proc_p proclookup(); /* ( char *ident, int status) + * Find (in the hashtable) the + * procedure with the given name. + */ +extern cleaninstrlabs(); /* ( ) + * Forget about all instruction labels. + */ +extern dump_procnames(); /* (prc_p hash[], int n, FILE *f) + * Save the names of the procedures + * in file f; hash is the hashtable + * used and n is its length. + */ +extern cleanprocs(); /* (prc_p hash[], int n,mask) + * Make the names of all procedures + * for which p_flags1&mask = 0 invisible + */ +extern cleandblocks(); /* (sym_p hash[], int n) + * Make the names of all data blocks + * for which d_flags1&mask = 0 invisible + */