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/IR/mlrisc-cfg2cluster.sml
ViewVC logotype

Annotation of /MLRISC/trunk/IR/mlrisc-cfg2cluster.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 469 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/IR/mlrisc-cfg2cluster.sml

1 : monnier 245 (*
2 :     * Convert the new control flow graph format back into the old cluster format
3 : monnier 411 *
4 :     * -- Allen
5 : monnier 245 *)
6 :    
7 :     signature CFG2CLUSTER =
8 :     sig
9 :     structure CFG : CONTROL_FLOW_GRAPH
10 :     structure F : FLOWGRAPH
11 :     sharing CFG.I = F.I
12 :     sharing CFG.P = F.P
13 :    
14 :     (*
15 :     * If relayout is true, then always use the layout algorithm.
16 :     * Otherwise, try to preserve the original layout if possible.
17 :     *)
18 :     val cfg2cluster : { cfg : CFG.cfg,
19 :     relayout : bool
20 :     } -> F.cluster
21 :    
22 :     end
23 :    
24 :     functor CFG2ClusterFn
25 :     (structure CFG : CONTROL_FLOW_GRAPH
26 :     structure F : FLOWGRAPH
27 :     sharing CFG.I = F.I
28 :     sharing CFG.P = F.P
29 :     ) : CFG2CLUSTER =
30 :     struct
31 :    
32 :     structure CFG = CFG
33 :     structure W = CFG.W
34 :     structure F = F
35 :     structure G = Graph
36 :     structure Q = PriorityQueue
37 :     structure Set = BitSet
38 :     structure A = Array
39 :    
40 : monnier 411 fun error msg = MLRiscErrorMsg.error("CFG2Cluster",msg)
41 : monnier 245
42 : monnier 429 val dummyNode = F.LABEL(Label.Label{id= ~1, addr=ref ~1, name=""})
43 :    
44 : monnier 245 fun pseudo_op (CFG.LABEL l) = F.LABEL l
45 :     | pseudo_op (CFG.PSEUDO p) = F.PSEUDO p
46 :    
47 :     (* create a new BBLOCK with id i *)
48 :     fun bblock M (i,b as
49 : monnier 469 CFG.BLOCK{kind,freq,annotations,insns,labels,data,...}) =
50 : monnier 245 let val labels = map F.LABEL (!labels)
51 :     in case kind of
52 :     CFG.STOP => map pseudo_op (!data)
53 :     | _ =>
54 : monnier 469 let val block = F.BBLOCK{blknum = i,
55 : monnier 411 freq = freq,
56 : monnier 469 annotations = ref(#rmv CFG.LIVEOUT
57 :     (!annotations)),
58 : monnier 411 insns = insns,
59 :     liveIn = ref F.C.empty,
60 :     liveOut = ref (CFG.liveOut b),
61 :     pred = ref [],
62 :     succ = ref []
63 : monnier 245 }
64 :     in A.update(M,i,block);
65 :     map pseudo_op (!data) @ labels @ [block]
66 :     end
67 :     end
68 :    
69 :     fun bblock' (M,M',M'') =
70 :     let val bblock = bblock M
71 :     in fn (i,b as CFG.BLOCK{id,...}) =>
72 :     let val block = bblock(i,b)
73 :     in A.update(M',i,id); A.update(M'',id,i); block end
74 :     end
75 :    
76 :     (* create a new ENTRY with id i *)
77 : monnier 411 fun entry(M,i,freq) =
78 :     let val entry = F.ENTRY{succ=ref [], blknum=i, freq=freq}
79 : monnier 245 in A.update(M,i,entry);
80 :     entry
81 :     end
82 :    
83 : monnier 411 fun entry'(M,M',M'',i,id,freq) =
84 :     let val entry = entry(M,i,freq)
85 : monnier 245 in A.update(M',i,id); A.update(M'',id,i); entry
86 :     end
87 :    
88 :     (* create a new EXIT with id i *)
89 : monnier 411 fun exit(M,i,freq) =
90 :     let val exit = F.EXIT{pred=ref [], blknum=i, freq=freq}
91 : monnier 245 in A.update(M,i,exit);
92 :     exit
93 :     end
94 :    
95 : monnier 411 fun exit'(M,M',M'',i,id,freq) =
96 :     let val exit = exit(M,i,freq)
97 : monnier 245 in A.update(M',i,id); A.update(M'',id,i); exit
98 :     end
99 :    
100 :     fun id_of(F.BBLOCK{blknum,...}) = blknum
101 :     | id_of(F.ENTRY{blknum,...}) = blknum
102 :     | id_of(F.EXIT{blknum,...}) = blknum
103 :    
104 : monnier 429 fun delete_preentries (ENTRY,CFG as G.GRAPH cfg) =
105 :     let val CFG.INFO{regmap,...} = #graph_info cfg
106 : monnier 411 fun remove (ENTRY,i,_) =
107 : monnier 429 let val block as CFG.BLOCK{labels,kind,insns,...} = #node_info cfg i
108 :     in if kind = CFG.FUNCTION_ENTRY then
109 :     let val [(i,j,e)] = #out_edges cfg i
110 :     val CFG.BLOCK{labels=l,...} = #node_info cfg j
111 :     in case !insns of
112 :     [] => ()
113 :     | _ => (print (CFG.show_block [] regmap block);
114 :     error "delete_preentries");
115 :     #add_edge cfg (ENTRY,j,e);
116 :     l := !labels @ !l;
117 :     #remove_node cfg i
118 : monnier 245 end
119 : monnier 429 else ()
120 :     end
121 : monnier 245 in app remove (#out_edges cfg ENTRY)
122 :     end
123 :    
124 :     fun remove_entry_to_exit (ENTRY,EXIT,CFG) =
125 :     Graph.remove_edge CFG (ENTRY,EXIT)
126 :    
127 : monnier 411 fun freqOf (G.GRAPH cfg) id =
128 :     let val CFG.BLOCK{freq,...} = #node_info cfg id in freq end
129 :    
130 : monnier 245 (*
131 :     * Convert cfg -> cluster, assuming the layout is unchanged
132 :     *)
133 :     fun computeOldLayout (CFG as G.GRAPH cfg) =
134 :     let val M = #capacity cfg ()
135 : monnier 411 val ENTRY = case #entries cfg () of
136 :     [ENTRY] => ENTRY
137 :     | _ => raise Graph.NotSingleEntry
138 :     val EXIT = case #exits cfg () of
139 :     [EXIT] => EXIT
140 :     | _ => raise Graph.NotSingleExit
141 :     val CFG.INFO{regmap,annotations,...} = #graph_info cfg
142 : monnier 245 val _ = delete_preentries(ENTRY,CFG)
143 :     val _ = remove_entry_to_exit(ENTRY,EXIT,CFG)
144 : monnier 429 val A = A.array(M,dummyNode)
145 : monnier 245 val nodes = List.filter(fn (i,CFG.BLOCK{kind,...}) =>
146 :     i <> ENTRY andalso i <> EXIT andalso
147 :     kind <> CFG.FUNCTION_ENTRY)
148 :     (#nodes cfg ())
149 :     val blocks = List.concat(
150 :     map (bblock A) (nodes @ [(EXIT,#node_info cfg EXIT)]))
151 : monnier 411 val entry = entry (A,ENTRY,freqOf CFG ENTRY)
152 :     val exit = exit (A,EXIT,freqOf CFG EXIT)
153 :     fun succs i = map (fn (_,i,CFG.EDGE{w,...}) => (A.sub(A,i),w))
154 :     (#out_edges cfg i)
155 :     fun preds i = map (fn (i,_,CFG.EDGE{w,...}) => (A.sub(A,i),w))
156 :     (#in_edges cfg i)
157 : monnier 245 fun set_links(F.BBLOCK{blknum,pred,succ,insns,...}) =
158 :     (pred := preds blknum; succ := succs blknum)
159 :     | set_links(F.ENTRY{blknum,succ,...}) = succ := succs blknum
160 :     | set_links(F.EXIT{blknum,pred,...}) = pred := preds blknum
161 :     | set_links _ = ()
162 :     val _ = A.app set_links A
163 : monnier 411 in F.CLUSTER{ blkCounter = ref M,
164 : monnier 429 regmap = regmap,
165 : monnier 411 blocks = blocks,
166 :     entry = entry,
167 :     exit = exit,
168 :     annotations = annotations
169 : monnier 245 }
170 :     end
171 :    
172 :     (*
173 :     * Convert cfg -> cluster, while computing a new code layout.
174 :     *)
175 :     fun computeNewLayout (CFG as G.GRAPH cfg) =
176 :     let val M = #capacity cfg ()
177 : monnier 411 val ENTRY = case #entries cfg () of
178 :     [ENTRY] => ENTRY
179 :     | _ => raise Graph.NotSingleEntry
180 :     val EXIT = case #exits cfg () of
181 :     [EXIT] => EXIT
182 :     | _ => raise Graph.NotSingleExit
183 : monnier 245 val _ = delete_preentries(ENTRY,CFG)
184 : monnier 429 val CFG.INFO{firstBlock,regmap=regmap,annotations,...} =
185 : monnier 411 #graph_info cfg
186 : monnier 429 val A = A.array(M,dummyNode) (* new id -> F.block *)
187 : monnier 245 val A' = A.array(M,~1) (* new id -> old id *)
188 :     val A'' = A.array(M,~1) (* old id -> new id *)
189 :     val min_pred = A.array(M,10000000)
190 :     val in_degs = A.tabulate(M,fn i => length(#in_edges cfg i))
191 :     val nodes = GraphTopsort.topsort CFG (ENTRY::map #1 (#nodes cfg ()))
192 :    
193 :     fun higher_freq(i,j) =
194 :     let val CFG.BLOCK{freq=w1,...} = #node_info cfg i
195 :     val CFG.BLOCK{freq=w2,...} = #node_info cfg j
196 : monnier 411 in !w1 > !w2
197 : monnier 245 end
198 :    
199 :     fun older(i,j) = A.sub(min_pred,i) < A.sub(min_pred,j)
200 :    
201 :     val marked = Set.create M
202 :     val node_queue = Q.create (* older *) higher_freq
203 :     val insert_node = Q.insert node_queue
204 :    
205 :     fun node b = (b,#node_info cfg b)
206 :    
207 :     val make_a_block = bblock' (A,A',A'')
208 :     fun make_block(id,B as CFG.BLOCK{id=i,
209 :     insns=ref [],data,labels,...}) =
210 :     (case #in_edges cfg i of
211 :     [] => map pseudo_op (!data) @ map F.LABEL (!labels)
212 :     | _ => make_a_block(id,B)
213 :     )
214 :     | make_block(id,B) = make_a_block(id,B)
215 :    
216 :     fun update_succs (id,[]) = ()
217 :     | update_succs (id,((i,j,_)::es)) =
218 :     let val count = A.sub(in_degs,j) - 1
219 :     in A.update(min_pred,j,Int.min(id,A.sub(min_pred,j)));
220 :     A.update(in_degs,j,count);
221 :     if count = 0 andalso
222 :     j <> EXIT andalso
223 :     (case CFG.fallsThruFrom(CFG,j) of SOME _ => false
224 :     | NONE => true) then
225 :     insert_node j
226 :     else ();
227 :     update_succs(id,es)
228 :     end
229 :    
230 :     fun layout(id,(i,B),waiting,blocks) =
231 :     if Set.markAndTest(marked,i) then
232 :     layout_all(id,waiting,blocks)
233 :     else let val blocks = make_block(id,B)::blocks
234 :     in update_succs(id,#out_edges cfg i);
235 :     case CFG.fallsThruTo(CFG,i) of
236 :     SOME j => layout(id+1,node j,waiting,blocks)
237 :     | NONE => layout_all(id+1,waiting,blocks)
238 :     end
239 :    
240 :     and layout_all(id,waiting,blocks) =
241 :     if Q.isEmpty node_queue then
242 :     layout_waiting(id,waiting,blocks)
243 :     else
244 :     let val b = Q.deleteMin node_queue
245 :     in layout(id,node b,waiting,blocks)
246 :     end
247 :    
248 :     and layout_waiting(id,[],blocks) =
249 :     (id,List.concat(rev blocks))
250 :     | layout_waiting(id,n::waiting,blocks) =
251 :     case CFG.fallsThruFrom(CFG,n) of
252 :     SOME _ => layout_waiting(id,waiting,blocks)
253 :     | NONE => layout(id,node n,waiting,blocks)
254 :    
255 :     val _ = Set.set(marked,ENTRY)
256 :     val _ = Set.set(marked,EXIT)
257 :     val (id,blocks) = layout_all(0,(!firstBlock)::nodes,[])
258 :     (*val _ = print("M="^Int.toString M^ " id="^Int.toString id^"\n")*)
259 :    
260 : monnier 411 val exit = exit'(A,A',A'',id,EXIT,freqOf CFG EXIT)
261 :     val entry = entry'(A,A',A'',id+1,ENTRY,freqOf CFG ENTRY)
262 : monnier 245 val blocks = blocks @ bblock A (EXIT,#node_info cfg EXIT)
263 : monnier 411 fun succs i = map (fn (_,i,CFG.EDGE{w,...}) =>
264 :     (A.sub(A,A.sub(A'',i)),w))
265 :     (#out_edges cfg (A.sub(A',i)))
266 :     fun preds i = map (fn (i,_,CFG.EDGE{w,...}) =>
267 :     (A.sub(A,A.sub(A'',i)),w))
268 :     (#in_edges cfg (A.sub(A',i)))
269 : monnier 245 fun set_links(F.BBLOCK{blknum,pred,succ,insns,...}) =
270 : monnier 411 let fun isBackwardBranch((F.BBLOCK{blknum=next,...},_)::bs) =
271 : monnier 245 next <= blknum orelse isBackwardBranch bs
272 :     | isBackwardBranch(_::bs) = isBackwardBranch bs
273 :     | isBackwardBranch [] = false
274 :     in pred := preds blknum;
275 : monnier 411 succ := succs blknum
276 : monnier 245 end
277 :     | set_links(F.ENTRY{blknum,succ,...}) = succ := succs blknum
278 :     | set_links(F.EXIT{blknum,pred,...}) = pred := preds blknum
279 :     | set_links _ = ()
280 :     val _ = A.app set_links A
281 : monnier 411 in F.CLUSTER{ blkCounter = ref(id+2),
282 :     regmap = regmap,
283 :     blocks = blocks,
284 :     entry = entry,
285 :     exit = exit,
286 :     annotations = annotations
287 : monnier 245 }
288 :     end
289 :    
290 :     fun cfg2cluster {cfg=CFG as G.GRAPH cfg,relayout} =
291 :     let val CFG.INFO{reorder,...} = #graph_info cfg
292 :     in if !reorder orelse relayout then computeNewLayout CFG
293 :     else computeOldLayout CFG
294 :     end
295 :    
296 :     end
297 :    

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