Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/cluster/clusterGraph.sml
ViewVC logotype

Annotation of /MLRISC/trunk/cluster/clusterGraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : monnier 467 (*
2 :     * This gives a cluster a graph view so that all graph based algorithms
3 :     * can be applied on the cluster. The view is readonly though.
4 :     *
5 :     * -- Allen
6 :     *)
7 : george 545 functor ClusterGraph(F : FLOWGRAPH) : CLUSTER_GRAPH =
8 : monnier 467 struct
9 :    
10 :     structure F = F
11 : leunga 624 structure I = F.I
12 : monnier 467 structure W = F.W
13 :     structure G = Graph
14 :     structure A = Array
15 :    
16 : leunga 624 datatype info = INFO of F.cluster * F.block A.array
17 : monnier 467
18 : leunga 624 type block = F.block
19 :     type edge_info = W.freq ref
20 : monnier 467
21 : leunga 624 type cfg = (block,edge_info,info) Graph.graph
22 : monnier 467
23 :     fun error msg = MLRiscErrorMsg.error("ClusterGraph",msg)
24 :    
25 :     fun table(G.GRAPH{graph_info=INFO(_,table),...}) = table
26 :     fun cluster(G.GRAPH{graph_info=INFO(cluster,_),...}) = cluster
27 :    
28 :     (* In a cluster the basic blocks are numbered consecutively.
29 :     *)
30 :     fun isTakenBranch(i,j,_) = i+1 <> j
31 :    
32 : leunga 624 fun annotations(G.GRAPH{graph_info=INFO(F.CLUSTER{annotations=a, ...},_),
33 :     ...}) = a
34 : monnier 467 (*
35 :     * Extract the node frequency of a block
36 :     *)
37 : leunga 624 fun freq(F.BBLOCK{freq,...}) = freq
38 :     | freq(F.ENTRY{freq,...}) = freq
39 :     | freq(F.EXIT{freq,...}) = freq
40 :     | freq _ = error "freq"
41 : monnier 467
42 : leunga 624 (*
43 :     * Extract the instructions
44 :     *)
45 :     fun insns(F.BBLOCK{insns, ...}) = insns
46 :     | insns _ = error "insns"
47 :    
48 :     (*
49 :     * Extract the liveOut set
50 :     *)
51 :     fun liveOut(F.BBLOCK{liveOut, ...}) = !liveOut
52 :     | liveOut _ = I.C.empty
53 :    
54 : monnier 467 fun clusterGraph(cluster as F.CLUSTER{blocks,blkCounter,exit,entry,...}) =
55 :     let fun readonly _ = raise G.Readonly
56 :     fun do_nothing _ = ()
57 :     val table = A.array(!blkCounter,F.LABEL(Label.newLabel "dummy"))
58 :     fun number(F.BBLOCK{blknum,...}) = blknum
59 :     | number(F.ENTRY{blknum,...}) = blknum
60 :     | number(F.EXIT{blknum,...}) = blknum
61 :     | number _ = raise G.Graph "clusterGraph"
62 :     fun fill([],size,order,entry,exit) = (size,order,entry,exit)
63 :     | fill((b as F.ENTRY{blknum,succ,...})::rest,size,order,entry,exit) =
64 :     (A.update(table,blknum,b);
65 :     fill(rest,size+length(!succ),order+1,blknum,exit)
66 :     )
67 :     | fill((b as F.EXIT{blknum,...})::rest,size,order,entry,exit) =
68 :     (A.update(table,blknum,b);
69 :     fill(rest,size,order+1,entry,blknum)
70 :     )
71 :     | fill((b as F.BBLOCK{blknum,succ,...})::rest,size,order,entry,exit) =
72 :     (A.update(table,blknum,b);
73 :     fill(rest,size+length(!succ),order+1,entry,exit)
74 :     )
75 :     | fill(_::rest,size,order,entry,exit) =
76 :     fill(rest,size,order,entry,exit)
77 :     val (size,order,entryId,exitId) = fill(entry::exit::blocks,0,0,~1,~1)
78 :     fun nodes() = A.foldri(fn (_,F.LABEL _,rest) => rest
79 :     | (b,b',rest) => (b,b')::rest) [] (table,0,NONE)
80 :     fun edges() =
81 :     let fun f(i,succ,es) =
82 :     foldr (fn ((j,e),es) => (i,number j,e)::es) es (!succ)
83 :     in A.foldri
84 :     (fn (i,F.BBLOCK{succ,...},es) => f(i,succ,es)
85 :     | (i,F.ENTRY{succ,...},es) => f(i,succ,es)
86 :     | (_,_,es) => es) [] (table,0,NONE)
87 :     end
88 :    
89 :     fun out_edges i =
90 :     let fun f succ = map (fn (j,e) => (i,number j,e)) (!succ)
91 :     in case A.sub(table,i) of
92 :     F.BBLOCK{succ,...} => f succ
93 :     | F.ENTRY{succ,...} => f succ
94 :     | _ => []
95 :     end
96 :    
97 :     fun in_edges j =
98 :     let fun f pred = map (fn (i,e) => (number i,j,e)) (!pred)
99 :     in case A.sub(table,j) of
100 :     F.BBLOCK{pred,...} => f pred
101 :     | F.EXIT{pred,...} => f pred
102 :     | _ => []
103 :     end
104 :    
105 :     fun succ i =
106 :     let fun f succ = map (fn (j,e) => number j) (!succ)
107 :     in case A.sub(table,i) of
108 :     F.BBLOCK{succ,...} => f succ
109 :     | F.ENTRY{succ,...} => f succ
110 :     | _ => []
111 :     end
112 :    
113 :     fun pred j =
114 :     let fun f pred = map (fn (i,e) => number i) (!pred)
115 :     in case A.sub(table,j) of
116 :     F.BBLOCK{pred,...} => f pred
117 :     | F.EXIT{pred,...} => f pred
118 :     | _ => []
119 :     end
120 :    
121 :     fun has_edge(i,j) =
122 :     let fun find [] = false
123 :     | find((k,_)::es) = j = number k orelse find es
124 :     in case A.sub(table,i) of
125 :     F.BBLOCK{succ,...} => find(!succ)
126 :     | F.ENTRY{succ,...} => find(!succ)
127 :     | _ => false
128 :     end handle _ => false
129 :    
130 :     fun has_node i =
131 :     (case A.sub(table,i) of
132 :     F.BBLOCK _ => true
133 :     | F.ENTRY _ => true
134 :     | F.EXIT _ => true
135 :     | _ => false
136 :     ) handle _ => false
137 :    
138 :     fun node_info i = A.sub(table,i) handle _ => raise G.NotFound
139 :    
140 :     fun empty _ = []
141 :     fun forall_nodes f =
142 :     A.appi (fn (i,i' as F.LABEL _) => ()
143 :     | (i,i') => f(i,i')) (table,0,NONE)
144 :     fun forall_edges f =
145 :     let fun g(_,[]) = ()
146 :     | g(i,(j,e)::es) = (f(i,number j,e); g(i,es))
147 :     in A.appi (fn (i,F.BBLOCK{succ,...}) => g(i,!succ)
148 :     | (i,F.ENTRY{succ,...}) => g(i,!succ)
149 :     | _ => ()) (table,0,NONE)
150 :     end
151 :    
152 :     in G.GRAPH
153 :     { name = "cluster",
154 :     graph_info = INFO(cluster,table),
155 :     new_id = readonly,
156 :     add_node = readonly,
157 :     add_edge = readonly,
158 :     remove_node = readonly,
159 :     set_out_edges = readonly,
160 :     set_in_edges = readonly,
161 :     set_entries = readonly,
162 :     set_exits = readonly,
163 :     garbage_collect = do_nothing,
164 :     nodes = nodes,
165 :     edges = edges,
166 :     order = fn _ => order,
167 :     size = fn _ => size,
168 :     capacity = fn _ => !blkCounter,
169 :     succ = succ,
170 :     pred = pred,
171 :     out_edges = out_edges,
172 :     in_edges = in_edges,
173 :     has_edge = has_edge,
174 :     has_node = has_node,
175 :     node_info = node_info,
176 :     entries = fn _ => [entryId],
177 :     exits = fn _ => [exitId],
178 :     entry_edges = empty,
179 :     exit_edges = empty,
180 :     forall_nodes = forall_nodes,
181 :     forall_edges = forall_edges
182 :     }
183 :     end
184 :    
185 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0