godzil/ack
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
bal
1984-11-26 13:43:22 +00:00
parent 5481dd47a9
commit 7b798175ad
36 changed files with 4585 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
util/ego/cf/Makefile Normal file
View File

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

334
util/ego/cf/cf.c Normal file
View File

@@ -0,0 +1,334 @@
/* C O N T R O L F L O W
*
* M A I N R O U T I N E
*/
#include <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);
}

13
util/ego/cf/cf.h Normal file
View File

@@ -0,0 +1,13 @@
/* C O N T R O L F L O W */
/* Macro's for extended data structures: */
#define B_SEMI b_extend->bx_cf.bx_semi
#define B_PARENT b_extend->bx_cf.bx_parent
#define B_BUCKET b_extend->bx_cf.bx_bucket
#define B_ANCESTOR b_extend->bx_cf.bx_ancestor
#define B_LABEL b_extend->bx_cf.bx_label
#define LP_BLOCKS lp_extend->lpx_cf.lpx_blocks
#define LP_COUNT lp_extend->lpx_cf.lpx_count
#define LP_MESSY lp_extend->lpx_cf.lpx_messy

138
util/ego/cf/cf_idom.c Normal file
View File

@@ -0,0 +1,138 @@
/* C O N T R O L F L O W
*
* C F _ I D O M . C
*/
#include "../share/types.h"
#include "../share/debug.h"
#include "../share/lset.h"
#include "../share/alloc.h"
#include "cf.h"
/* The algorithm for finding dominators in a flowgraph
* that is used here, was developed by Thomas Lengauer
* and Robert E. Tarjan of Stanford University.
* The algorithm is described in their article:
* A Fast Algorithm for Finding Dominators
* in a Flowgraph
* which was published in:
* ACM Transactions on Programming Languages and Systems,
* Vol. 1, No. 1, July 1979, Pages 121-141.
*/
#define UNREACHABLE(b) (b->B_SEMI == (short) 0)
short dfs_nr;
bblock_p *vertex; /* dynamically allocated array */
STATIC dfs(v)
bblock_p v;
{
/* Depth First Search */
Lindex i;
bblock_p w;
v->B_SEMI = ++dfs_nr;
vertex[dfs_nr] = v->B_LABEL = v;
v->B_ANCESTOR = (bblock_p) 0;
for (i = Lfirst(v->b_succ); i != (Lindex) 0; i = Lnext(i,v->b_succ)) {
w = (bblock_p) Lelem(i);
if (w->B_SEMI == 0) {
w->B_PARENT = v;
dfs(w);
}
}
}
STATIC compress(v)
bblock_p v;
{
if (v->B_ANCESTOR->B_ANCESTOR != (bblock_p) 0) {
compress(v->B_ANCESTOR);
if (v->B_ANCESTOR->B_LABEL->B_SEMI < v->B_LABEL->B_SEMI) {
v->B_LABEL = v->B_ANCESTOR->B_LABEL;
}
v->B_ANCESTOR = v->B_ANCESTOR->B_ANCESTOR;
}
}
STATIC bblock_p eval(v)
bblock_p v;
{
if (v->B_ANCESTOR == (bblock_p) 0) {
return v;
} else {
compress(v);
return v->B_LABEL;
}
}
STATIC linkblocks(v,w)
bblock_p v,w;
{
w->B_ANCESTOR = v;
}
dominators(r,n)
bblock_p r;
short n;
{
/* Compute the immediate dominator of every basic
* block in the control flow graph rooted by r.
*/
register short i;
Lindex ind, next;
bblock_p v,w,u;
dfs_nr = 0;
vertex = (bblock_p *) newmap(n);
/* allocate vertex (dynamic array). All remaining
* initializations were done by the routine
* nextblock of get.c.
*/
dfs(r);
for (i = dfs_nr; i > 1; i--) {
w = vertex[i];
for (ind = Lfirst(w->b_pred); ind != (Lindex) 0;
ind = Lnext(ind,w->b_pred)) {
v = (bblock_p) Lelem(ind);
if (UNREACHABLE(v)) continue;
u = eval(v);
if (u->B_SEMI < w->B_SEMI) {
w->B_SEMI = u->B_SEMI;
}
}
Ladd(w,&(vertex[w->B_SEMI]->B_BUCKET));
linkblocks(w->B_PARENT,w);
for (ind = Lfirst(w->B_PARENT->B_BUCKET); ind != (Lindex) 0;
ind = next) {
next = Lnext(ind,w->B_PARENT->B_BUCKET);
v = (bblock_p) Lelem(ind);
Lremove(v,&w->B_PARENT->B_BUCKET);
u = eval(v);
v->b_idom = (u->B_SEMI < v->B_SEMI ? u : w->B_PARENT);
}
}
for (i = 2; i <= dfs_nr; i++) {
w = vertex[i];
if (w->b_idom != vertex[w->B_SEMI]) {
w->b_idom = w->b_idom->b_idom;
}
}
r->b_idom = (bblock_p) 0;
oldmap(vertex,n); /* release memory for dynamic array vertex */
}

15
util/ego/cf/cf_idom.h Normal file
View File

@@ -0,0 +1,15 @@
/* C O N T R O L F L O W
*
* I M M E D I A T E D O M I N A T O R S
*/
extern dominator(); /* (bblock_p head, short n)
* Compute for every basic block its immediate
* dominator. The dominator relation is hence
* recorded as a tree in which every node contains
* a pointer to its parent, which is its
* immediate dominator.
* 'n' is the number of nodes (basic blocks) in
* the control flow graph.
*/

400
util/ego/cf/cf_loop.c Normal file
View File

@@ -0,0 +1,400 @@
/* C O N T R O L F L O W
*
* C F _ L O O P . C
*/
#include "../share/types.h"
#include "../share/debug.h"
#include "../share/lset.h"
#include "../share/alloc.h"
#include "../share/aux.h"
#include "cf.h"
#define MARK_STRONG(b) b->b_flags |= BF_STRONG
#define MARK_FIRM(b) b->b_flags |= BF_FIRM
#define BF_MARK 04
#define MARK(b) b->b_flags |= BF_MARK
#define MARKED(b) (b->b_flags&BF_MARK)
#define INSIDE_LOOP(b,lp) Lis_elem(b,lp->LP_BLOCKS)
/* The algorithm to detect loops that is used here is taken
* from: Aho & Ullman, Principles of Compiler Design, section 13.1.
* The algorithm uses the dominator relation between nodes
* of the control flow graph:
* d DOM n => every path from the initial node to n goes through d.
* The dominator relation is recorded via the immediate dominator tree
* (b_idom field of bblock struct) from which the dominator relation
* can be easily computed (see procedure 'dom' below).
* The algorithm first finds 'back edges'. A back edge is an edge
* a->b in the flow graph whose head (b) dominates its tail (a).
* The 'natural loop' of back edge n->d consists of those nodes
* that can reach n without going through d. These nodes, plus d
* form the loop.
* The whole process is rather complex, because different back edges
* may result in the same loop and because loops may partly overlap
* each other (without one being nested inside the other).
*/
STATIC bool same_loop(l1,l2)
loop_p l1,l2;
{
/* Two loops are the same if:
* (1) they have the same number of basic blocks, and
* (2) the head of the back edge of the first loop
* also is part of the second loop, and
* (3) the tail of the back edge of the first loop
* also is part of the second loop.
*/
return (l1->LP_COUNT == l2->LP_COUNT &&
Lis_elem(l1->lp_entry, l2->LP_BLOCKS) &&
Lis_elem(l1->lp_end, l2->LP_BLOCKS));
}
STATIC bool inner_loop(l1,l2)
loop_p l1,l2;
{
/* Loop l1 is an inner loop of l2 if:
* (1) the first loop has fewer basic blocks than
* the second one, and
* (2) the head of the back edge of the first loop
* also is part of the second loop, and
* (3) the tail of the back edge of the first loop
* also is part of the second loop.
*/
return (l1->LP_COUNT < l2->LP_COUNT &&
Lis_elem(l1->lp_entry, l2->LP_BLOCKS) &&
Lis_elem(l1->lp_end, l2->LP_BLOCKS));
}
STATIC insrt(b,lpb,s_p)
bblock_p b;
lset *lpb;
lset *s_p;
{
/* Auxiliary routine used by 'natural_loop'.
* Note that we use a set rather than a stack,
* as Aho & Ullman do.
*/
if (!Lis_elem(b,*lpb)) {
Ladd(b,lpb);
Ladd(b,s_p);
}
}
STATIC loop_p natural_loop(d,n)
bblock_p d,n;
{
/* Find the basic blocks of the natural loop of the
* back edge 'n->d' (i.e. n->d is an edge in the control
* flow graph and d dominates n). The natural loop consists
* of those blocks which can reach n without going through d.
* We find these blocks by finding all predecessors of n,
* up to d.
*/
loop_p lp;
bblock_p m;
lset loopblocks;
Lindex pi;
lset s;
lp = newloop();
lp->lp_extend = newcflpx();
lp->lp_entry = d; /* loop entry block */
lp->lp_end = n; /* tail of back edge */
s = Lempty_set();
loopblocks = Lempty_set();
Ladd(d,&loopblocks);
insrt(n,&loopblocks,&s);
while ((pi = Lfirst(s)) != (Lindex) 0) {
m = (bblock_p) Lelem(pi);
Lremove(m,&s);
for (pi = Lfirst(m->b_pred); pi != (Lindex) 0;
pi = Lnext(pi,m->b_pred)) {
insrt((bblock_p) Lelem(pi),&loopblocks,&s);
}
}
lp->LP_BLOCKS = loopblocks;
lp->LP_COUNT = Lnrelems(loopblocks);
return lp;
}
STATIC loop_p org_loop(lp,loops)
loop_p lp;
lset loops;
{
/* See if the loop lp was already found via another
* back edge; if so return this loop; else return 0.
*/
register Lindex li;
for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
if (same_loop((loop_p) Lelem(li), lp)) {
#ifdef DEBUG
/* printf("messy loop found\n"); */
#endif
return (loop_p) Lelem(li);
}
}
return (loop_p) 0;
}
STATIC collapse_loops(loops_p)
lset *loops_p;
{
register Lindex li1, li2;
register loop_p lp1,lp2;
for (li1 = Lfirst(*loops_p); li1 != (Lindex) 0; li1 = Lnext(li1,*loops_p)) {
lp1 = (loop_p) Lelem(li1);
lp1->lp_level = (short) 0;
for (li2 = Lfirst(*loops_p); li2 != (Lindex) 0;
li2 = Lnext(li2,*loops_p)) {
lp2 = (loop_p) Lelem(li2);
if (lp1 != lp2 && lp1->lp_entry == lp2->lp_entry) {
Ljoin(lp2->LP_BLOCKS,&lp1->LP_BLOCKS);
oldcflpx(lp2->lp_extend);
Lremove(lp2,loops_p);
}
}
}
}
STATIC loop_per_block(lp)
loop_p lp;
{
bblock_p b;
/* Update the b_loops sets */
register Lindex bi;
for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
bi = Lnext(bi,lp->LP_BLOCKS)) {
b = (bblock_p) Lelem(bi);
Ladd(lp,&(b->b_loops));
}
}
STATIC loop_attrib(loops)
lset loops;
{
/* Compute several attributes */
register Lindex li;
register loop_p lp;
loop_id lastlpid = 0;
for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
lp = (loop_p) Lelem(li);
lp->lp_id = ++lastlpid;
loop_per_block(lp);
}
}
STATIC nest_levels(loops)
lset loops;
{
/* Compute the nesting levels of all loops of
* the current procedure. For every loop we just count
* all loops of which the former is an inner loop.
* The running time is quadratic in the number of loops
* of the current procedure. As this number tends to be
* very small, there is no cause for alarm.
*/
register Lindex li1, li2;
register loop_p lp;
for (li1 = Lfirst(loops); li1 != (Lindex) 0; li1 = Lnext(li1,loops)) {
lp = (loop_p) Lelem(li1);
lp->lp_level = (short) 0;
for (li2 = Lfirst(loops); li2 != (Lindex) 0;
li2 = Lnext(li2,loops)) {
if (inner_loop(lp,(loop_p) Lelem(li2))) {
lp->lp_level++;
}
}
}
}
STATIC cleanup(loops)
lset loops;
{
/* Throw away the LP_BLOCKS sets */
register Lindex i;
for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) {
Ldeleteset(((loop_p) Lelem(i))->LP_BLOCKS);
}
}
STATIC bool does_exit(b,lp)
bblock_p b;
loop_p lp;
{
/* See if b may exit the loop, i.e. if it
* has a successor outside the loop
*/
Lindex i;
for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) {
if (!INSIDE_LOOP(Lelem(i),lp)) return TRUE;
}
return FALSE;
}
STATIC mark_succ(b,lp)
bblock_p b;
loop_p lp;
{
Lindex i;
bblock_p succ;
for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) {
succ = (bblock_p) Lelem(i);
if (succ != b && succ != lp->lp_entry && INSIDE_LOOP(succ,lp) &&
!MARKED(succ)) {
MARK(succ);
mark_succ(succ,lp);
}
}
}
STATIC mark_blocks(lp)
loop_p lp;
{
/* Mark the strong and firm blocks of a loop.
* The last set of blocks consists of the end-block
* of the loop (i.e. the head of the back edge
* of the natural loop) and its dominators
* (including the loop entry block, i.e. the
* tail of the back edge).
*/
register bblock_p b;
/* First mark all blocks that are the successor of a
* block that may exit the loop (i.e. contains a
* -possibly conditional- jump to somewhere outside
* the loop.
*/
if (lp->LP_MESSY) return; /* messy loops are hopeless cases */
for (b = lp->lp_entry; b != (bblock_p) 0; b = b->b_next) {
if (!MARKED(b) && does_exit(b,lp)) {
mark_succ(b,lp);
}
}
/* Now find all firm blocks. A block is strong
* if it is firm and not marked.
*/
for (b = lp->lp_end; ; b = b->b_idom) {
MARK_FIRM(b);
if (!MARKED(b)) {
MARK_STRONG(b);
}
if (b == lp->lp_entry) break;
}
}
STATIC mark_loopblocks(loops)
lset loops;
{
/* Determine for all loops which basic blocks
* of the loop are strong (i.e. are executed
* during every iteration) and which blocks are
* firm (i.e. executed during every iteration with
* the only possible exception of the last one).
*/
Lindex i;
loop_p lp;
for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) {
lp = (loop_p) Lelem(i);
mark_blocks(lp);
}
}
loop_detection(p)
proc_p p;
{
/* Find all natural loops of procedure p. Every loop is
* assigned a unique identifying number, a set of basic
* blocks, a loop entry block and a nesting level number.
* Every basic block is assigned a nesting level number
* and a set of loops it is part of.
*/
lset loops; /* the set of all loops */
loop_p lp,org;
register bblock_p b;
bblock_p s;
Lindex si;
loops = Lempty_set();
for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
for (si = Lfirst(b->b_succ); si != (Lindex) 0;
si = Lnext(si,b->b_succ)) {
s = (bblock_p) Lelem(si);
if (dom(s,b)) {
/* 'b->s' is a back edge */
lp = natural_loop(s,b);
if ((org = org_loop(lp,loops)) == (loop_p) 0) {
/* new loop */
Ladd(lp,&loops);
} else {
/* Same loop, generated by several back
* edges; such a loop is called a messy
* loop.
*/
org->LP_MESSY = TRUE;
Ldeleteset(lp->LP_BLOCKS);
oldcflpx(lp->lp_extend);
oldloop(lp);
}
}
}
}
collapse_loops(&loops);
loop_attrib(loops);
nest_levels(loops);
mark_loopblocks(loops); /* determine firm and strong blocks */
cleanup(loops);
p->p_loops = loops;
}

14
util/ego/cf/cf_loop.h Normal file
View File

@@ -0,0 +1,14 @@
/* C O N T R O L F L O W
*
* L O O P D E T E C T I O N
*/
extern loop_detection(); /* (proc_p p)
* Detect all loops of procedure p.
* Every basic block of p is assigned
* a set of all loops it is part of.
* For every loop we record the number
* of blocks it contains, the loop entry
* block and its nesting level (0 = outer
* loop, 1 = loop within loop etc.).
*/

250
util/ego/cf/cf_succ.c Normal file
View File

@@ -0,0 +1,250 @@
/* 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);
}
}
}
}
}
}

10
util/ego/cf/cf_succ.h Normal file
View File

@@ -0,0 +1,10 @@
/* C O N T R O L F L O W
*
* S U C C E S S O R / P R E D E C E S S O R R E L A T I O N S
*/
extern control_flow(); /* (bblock_p head)
* Compute for every basic block
* its successors and predecessors
* in the control flow graph.
*/