--- /dev/null
+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
--- /dev/null
+/* C O N T R O L F L O W
+ *
+ * M A I N R O U T I N E
+ */
+
+#include <stdio.h>
+#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);
+}
--- /dev/null
+/* 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
--- /dev/null
+/* 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 */
+}
--- /dev/null
+/* 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.
+ */
--- /dev/null
+/* 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;
+}
--- /dev/null
+/* 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.).
+ */
--- /dev/null
+/* C O N T R O L F L O W
+ *
+ * C F _ S U C C . C
+ */
+
+
+#include <stdio.h>
+#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);
+ }
+ }
+ }
+ }
+ }
+}
--- /dev/null
+/* 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.
+ */
--- /dev/null
+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. */
--- /dev/null
+#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));
+}
--- /dev/null
+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.
+ */
--- /dev/null
+#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;
+}
--- /dev/null
+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.
+ */
+
--- /dev/null
+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.
+ */
--- /dev/null
+#include <stdio.h>
+#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
--- /dev/null
+#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
--- /dev/null
+/* 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();
+}
--- /dev/null
+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.
+ */
--- /dev/null
+#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();
+ }
+}
--- /dev/null
+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.
+ */
--- /dev/null
+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.
+ */
--- /dev/null
+/*
+ * 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];
+}
--- /dev/null
+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.
+ */
--- /dev/null
+extern vnm(); /* (bblock_p bp)
+ * Performs the valuenumbering algorithm on the basic
+ * block in bp.
+ */
--- /dev/null
+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
--- /dev/null
+/* I N T E R M E D I A T E C O D E
+ *
+ * I C . C
+ */
+
+#include <stdio.h>
+#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 */
+}
--- /dev/null
+/* 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[];
+
--- /dev/null
+/* 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));
+}
--- /dev/null
+/* 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.
+ */
--- /dev/null
+/* I N T E R M E D I A T E C O D E
+ *
+ * I C _ I O . C
+ */
+
+
+
+#include <stdio.h>
+#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);
+ }
+}
--- /dev/null
+/* 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.
+ */
--- /dev/null
+/* I N T E R M E D I A T E C O D E
+ *
+ * I C _ L I B . C
+ */
+
+
+#include <stdio.h>
+#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;
+ }
+ }
+ }
+}
--- /dev/null
+/* 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.
+ */
--- /dev/null
+/* 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 <stdio.h>
+#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;
+ }
+ }
+ }
+}
--- /dev/null
+/* 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
+ */
public / ack.git / commitdiff