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 /sml/trunk/src/MLRISC/IR/mlrisc-cfg-util.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/IR/mlrisc-cfg-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1084 - (view) (download)

1 : monnier 245 (*
2 : monnier 411 * Some basic local CFG transformations. See the signature for descriptions.
3 :     *
4 :     * -- Allen
5 : monnier 245 *)
6 : george 545 functor CFGUtil
7 :     (structure CFG : CONTROL_FLOW_GRAPH
8 :     structure InsnProps : INSN_PROPERTIES
9 :     sharing CFG.I = InsnProps.I
10 : monnier 245 ) : CFG_UTIL =
11 :     struct
12 :    
13 :     structure CFG = CFG
14 :     structure I = CFG.I
15 :     structure W = CFG.W
16 :     structure G = Graph
17 :     structure H = HashArray
18 :     structure S = BitSet
19 :    
20 :     exception Can'tMerge
21 :    
22 : leunga 657 fun error msg = MLRiscErrorMsg.error("CFGUtil",msg)
23 : monnier 245
24 :     fun labelOf(G.GRAPH cfg) node = CFG.defineLabel(#node_info cfg node)
25 :    
26 :     fun copyEdge(CFG.EDGE{a,w,k}) = CFG.EDGE{a=ref(!a),w=ref(!w),k=k}
27 :    
28 :     (*=====================================================================
29 :     *
30 :     * Check whether block i must preceed block j in any linear layout.
31 :     * This may be true if i falls through to j (transitively)
32 :     *
33 :     *=====================================================================*)
34 :     fun mustPreceed (G.GRAPH cfg) (i,j) =
35 :     let val visited = H.array(23,false)
36 :     fun chase [] = false
37 :     | chase((u,v,CFG.EDGE{k=(CFG.FALLSTHRU|CFG.BRANCH false),...})::_) =
38 :     if H.sub(visited,u) then false
39 :     else u = i orelse (H.update(visited,u,true); chase(#in_edges cfg u))
40 :     | chase(_::es) = chase es
41 :     in i = j orelse chase(#in_edges cfg j)
42 :     end
43 :    
44 :     (*=====================================================================
45 :     *
46 :     * Predicates on nodes and edges
47 :     *
48 :     *=====================================================================*)
49 :     fun isMerge (G.GRAPH cfg) node = length(#in_edges cfg node) > 1
50 :     fun isSplit (G.GRAPH cfg) node = length(#out_edges cfg node) > 1
51 : jhr 1084 (*
52 : monnier 245 fun hasSideExits (G.GRAPH cfg) node =
53 :     List.exists (fn (_,_,CFG.EDGE{k=CFG.SIDEEXIT _,...}) => true
54 :     | _ => false) (#out_edges cfg node)
55 : jhr 1084 *)
56 :     fun hasSideExits _ _ = false
57 : monnier 411 fun isCriticalEdge CFG (_,_,CFG.EDGE{k=CFG.ENTRY,...}) = false
58 :     | isCriticalEdge CFG (_,_,CFG.EDGE{k=CFG.EXIT,...}) = false
59 :     | isCriticalEdge CFG (i,j,_) = isSplit CFG i andalso isMerge CFG j
60 : monnier 245
61 :     (*=====================================================================
62 :     *
63 :     * Update the label of the branch instruction in a certain block
64 :     * to be consistent with the control flow edges. This doesn't work
65 :     * on hyperblocks!!!
66 :     *
67 :     *=====================================================================*)
68 :     fun updateJumpLabel(CFG as G.GRAPH cfg) =
69 :     let val labelOf = labelOf CFG
70 :     fun update node =
71 :     case #node_info cfg node of
72 :     CFG.BLOCK{insns=ref [],...} => ()
73 :     | CFG.BLOCK{kind=CFG.START,...} => ()
74 :     | CFG.BLOCK{kind=CFG.STOP,...} => ()
75 :     | CFG.BLOCK{insns=insns as ref(jmp::rest),...} =>
76 :     (case #out_edges cfg node of
77 :     [] => ()
78 :     | [(_,_,CFG.EDGE{k=(CFG.ENTRY | CFG.EXIT),...})] => ()
79 :     | [(i,j,_)] =>
80 : george 545 if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
81 :     insns := InsnProps.setTargets(jmp,[labelOf j])::rest
82 : monnier 245 else ()
83 :     | [(_,i,CFG.EDGE{k=CFG.BRANCH x,...}),
84 :     (_,j,CFG.EDGE{k=CFG.BRANCH y,...})] =>
85 :     let val (i,j) = if x then (j,i) else (i,j)
86 : george 545 in insns :=
87 :     InsnProps.setTargets(jmp,[labelOf i,labelOf j])::rest
88 : monnier 245 end
89 :     | es =>
90 : monnier 429 let fun gt ((_,_,CFG.EDGE{k=CFG.SWITCH i,...}),
91 :     (_,_,CFG.EDGE{k=CFG.SWITCH j,...})) = i > j
92 :     | gt _ = error "gt"
93 :     val es = ListMergeSort.sort gt es
94 : monnier 245 val labels = map (fn (_,j,_) => labelOf j) es
95 : george 545 in insns := InsnProps.setTargets(jmp,labels)::rest;
96 : monnier 411 error "updateJumpLabel"
97 : monnier 245 end
98 :     )
99 :     in update
100 :     end
101 :    
102 :     (*=====================================================================
103 :     *
104 :     * Merge a control flow edge i -> j.
105 :     * Raise Can't Merge if it is illegal.
106 :     * After merging blocks i and j will become block i.
107 :     *
108 :     *=====================================================================*)
109 :     fun mergeEdge (CFG as G.GRAPH cfg) (i,j,e as CFG.EDGE{w,k,...}) =
110 :     let val _ = case k of
111 :     (CFG.ENTRY | CFG.EXIT) => raise Can'tMerge
112 :     | _ => ()
113 :     val _ = case (#out_edges cfg i,#in_edges cfg j) of
114 :     ([(_,j',_)],[(i',_,_)]) =>
115 :     if j' <> j orelse i' <> i then raise Can'tMerge
116 :     else ()
117 :     | _ => raise Can'tMerge
118 :     val _ = if mustPreceed CFG (i,j) then raise Can'tMerge else ()
119 : monnier 469 val CFG.BLOCK{data=d2,insns=i2,annotations=a2,...} =
120 : monnier 411 #node_info cfg j
121 : monnier 245 val _ = case !d2 of [] => () | _ => raise Can'tMerge
122 : monnier 469 val CFG.BLOCK{data=d1,insns=i1,annotations=a1,...} =
123 : monnier 411 #node_info cfg i
124 : leunga 606 (* If both blocks have annotations then don't merge them.
125 :     * But instead, just try to removed the jump instruction instead.
126 :     *)
127 :     val canMerge = case (!a1, !a2) of
128 :     (_::_, _::_) => false
129 :     | _ => true
130 : monnier 245 val insns1 = case !i1 of
131 :     [] => []
132 :     | insns as jmp::rest =>
133 : george 545 if InsnProps.instrKind jmp = InsnProps.IK_JUMP
134 :     then rest else insns
135 : leunga 606 in if canMerge then
136 :     (i1 := !i2 @ insns1;
137 :     a1 := !a1 @ !a2;
138 :     #set_out_edges cfg
139 :     (i,map (fn (_,j',e) => (i,j',e)) (#out_edges cfg j));
140 :     #remove_node cfg j;
141 :     updateJumpLabel CFG i
142 :     )
143 :     else (* Just eliminate the jump instruction at the end *)
144 :     (i1 := insns1;
145 :     #set_out_edges cfg
146 :     (i,map (fn (i,j,CFG.EDGE{w,a,...}) =>
147 :     (i,j,CFG.EDGE{k=CFG.FALLSTHRU,w=w,a=a}))
148 :     (#out_edges cfg i))
149 :     );
150 : monnier 245 true
151 :     end handle Can'tMerge => false
152 :    
153 :     (*=====================================================================
154 :     *
155 :     * Eliminate the jump at the end of a basic block if feasible
156 :     *
157 :     *=====================================================================*)
158 :     fun eliminateJump (CFG as G.GRAPH cfg) i =
159 :     (case #out_edges cfg i of
160 :     [e as (i,j,CFG.EDGE{k,w,a})] =>
161 :     (case CFG.fallsThruFrom(CFG,j) of
162 :     SOME _ => false
163 :     | NONE =>
164 :     if mustPreceed CFG (j,i) then false
165 :     else
166 :     let val CFG.BLOCK{insns,...} = #node_info cfg i
167 :     val CFG.BLOCK{data,...} = #node_info cfg j
168 :     in case (!data,!insns) of
169 :     ([],jmp::rest) =>
170 : george 545 if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
171 : monnier 245 (insns := rest;
172 :     CFG.removeEdge CFG e;
173 :     #add_edge cfg (i,j,CFG.EDGE{k=CFG.FALLSTHRU,w=w,a=a});
174 :     true
175 :     )
176 :     else false
177 :     | _ => false
178 :     end
179 :     )
180 :     | _ => false
181 :     )
182 :    
183 :     (*=====================================================================
184 :     *
185 :     * Insert a jump at the end of a basic block if feasible
186 :     *
187 :     *=====================================================================*)
188 :     fun insertJump (CFG as G.GRAPH cfg) i =
189 :     (case #out_edges cfg i of
190 :     [e as (i,j,CFG.EDGE{k=CFG.FALLSTHRU,w,a,...})] =>
191 :     let val CFG.BLOCK{insns,...} = #node_info cfg i
192 : george 545 in insns := InsnProps.jump(labelOf CFG j) :: !insns;
193 : monnier 245 CFG.removeEdge CFG e;
194 :     #add_edge cfg (i,j,CFG.EDGE{k=CFG.JUMP,w=w,a=a});
195 :     true
196 :     end
197 :     | _ => false
198 :     )
199 :    
200 :     (*=====================================================================
201 :     *
202 :     * Split a control flow edge, return a new edge and the new block
203 :     *
204 :     *=====================================================================*)
205 : monnier 429 fun splitEdge (CFG as G.GRAPH cfg)
206 :     {kind, edge=(i,j,e as CFG.EDGE{w,...}),jump} =
207 : monnier 245 let val k = #new_id cfg ()
208 :     val jump = jump orelse i = j orelse
209 :     (case CFG.fallsThruFrom(CFG,j) of
210 :     NONE => false
211 :     | SOME _ => true)
212 : george 545 val insns = ref(if jump then [InsnProps.jump(labelOf CFG j)] else [])
213 : monnier 429 val node =
214 : monnier 469 CFG.BLOCK{id=k, kind=kind,
215 : monnier 429 freq= ref(!w), data=ref [], labels = ref [],
216 :     insns=insns, annotations=ref []}
217 : monnier 245 val kind = if jump then CFG.JUMP else CFG.FALLSTHRU
218 :     val edge = (k,j,CFG.EDGE{w=ref(!w),a=ref [],k=kind})
219 :     in CFG.removeEdge CFG (i,j,e);
220 :     #add_edge cfg (i,k,e);
221 :     #add_node cfg (k,node);
222 :     #add_edge cfg edge;
223 :     updateJumpLabel CFG i;
224 :     {node=(k,node),edge=edge}
225 :     end
226 :    
227 :     (*=====================================================================
228 :     *
229 :     * Split all critical edges in the CFG
230 :     *
231 :     *=====================================================================*)
232 :     fun splitAllCriticalEdges (CFG as G.GRAPH cfg) =
233 : leunga 606 let val changed = ref false
234 :     in #forall_edges cfg
235 :     (fn e => if isCriticalEdge CFG e then
236 :     (splitEdge CFG {edge=e,kind=CFG.NORMAL,jump=false}; changed := true)
237 :     else ());
238 :     if !changed then CFG.changed CFG else ()
239 :     end
240 : monnier 245
241 :     (*=====================================================================
242 :     *
243 :     * Tail duplicate a region until there are no side entry edges
244 :     * entering into the region. Return the set of new edges and nodes
245 :     *
246 :     *=====================================================================*)
247 :     fun tailDuplicate (CFG as G.GRAPH cfg : CFG.cfg)
248 :     {subgraph=G.GRAPH subgraph : CFG.cfg,root} =
249 :     let exception NotFound
250 :     val blockMap = H.array'(10,fn v => raise NotFound)
251 :     val _ = print("[root "^Int.toString root^"]\n")
252 :    
253 :     fun duplicate v =
254 :     H.sub(blockMap,v) handle NotFound =>
255 :     let val w = #new_id cfg ()
256 :     val w' = CFG.copyBlock(w,#node_info cfg v)
257 :     in #add_node cfg (w,w');
258 :     H.update(blockMap,v,(w,w'));
259 :     app (#add_edge cfg)
260 :     (map (fn (i,j,e) => (w,j,copyEdge e)) (#out_edges cfg v));
261 :     updateJumpLabel CFG w;
262 :     (w,w')
263 :     end
264 :    
265 :     fun process((n,_)::rest,ns,Ns,Es) =
266 :     process(rest,collect(#entry_edges subgraph n,ns),Ns,Es)
267 :     | process([],ns,Ns,Es) = dupl(ns,Ns,Es,false)
268 :    
269 :     and collect([],ns) = ns
270 :     | collect((i,_,_)::es,ns) = collect(es,if i = root then ns else i::ns)
271 :    
272 :     and dupl([],Ns,Es,changed) = (Ns,Es,changed)
273 :     | dupl(n::ns,Ns,Es,changed) =
274 :     redirect(#out_edges cfg n,ns,Ns,Es,changed)
275 :    
276 :     and redirect([],ns,Ns,Es,changed) = dupl(ns,Ns,Es,changed)
277 :     | redirect((u,v,e)::es,ns,Ns,Es,changed) =
278 :     if v <> root andalso
279 :     #has_edge cfg (u,v) andalso
280 :     #has_node subgraph v andalso
281 :     not(#has_edge subgraph (u,v)) then
282 :     (*
283 :     * u -> v is a side entry edge, duplicate v
284 :     *)
285 :     let val _ = print("[tail duplicating "^Int.toString u^" -> "^
286 :     Int.toString v^"]\n")
287 :     val (w,w') = duplicate v
288 :     in CFG.removeEdge CFG (u,v,e);
289 :     #add_edge cfg (u,w,e);
290 :     updateJumpLabel CFG u;
291 :     redirect(es,w::ns,(w,w')::Ns,(u,w,e)::Es,true)
292 :     end
293 :     else redirect(es,ns,Ns,Es,changed)
294 :    
295 :     fun iter(Ns,Es) =
296 :     let val (Ns,Es,changed) = process(#nodes subgraph (),[],Ns,Es)
297 :     in if changed then (CFG.changed CFG; iter(Ns,Es))
298 :     else {nodes=Ns,edges=Es}
299 :     end
300 :    
301 :     in iter([],[])
302 :     end
303 :    
304 :    
305 :     (*=====================================================================
306 :     *
307 :     * Remove unreachable code in the CFG
308 :     *
309 :     *=====================================================================*)
310 :     fun removeUnreachableCode(CFG as G.GRAPH cfg) =
311 :     let val N = #capacity cfg ()
312 :     val visited = S.create N
313 :     fun mark n = if S.markAndTest(visited,n) then ()
314 :     else app mark (#succ cfg n)
315 :     val changed = ref false
316 :     fun remove(b,CFG.BLOCK{data,insns,...}) =
317 :     if S.contains(visited,b) then ()
318 :     else
319 :     (changed :=true;
320 :     case #in_edges cfg b of
321 :     [] => #remove_node cfg b
322 :     | _ => (insns := []; #set_out_edges cfg (b,[]))
323 :     )
324 :     in app mark (#entries cfg ());
325 :     #forall_nodes cfg remove;
326 :     if !changed then CFG.changed CFG else ()
327 :     end
328 :    
329 :    
330 :     (*=====================================================================
331 :     *
332 : monnier 429 * Merge all edges in the CFG.
333 :     * Merge higher frequency edges first
334 : monnier 245 *
335 :     *=====================================================================*)
336 :     fun mergeAllEdges(CFG as G.GRAPH cfg) =
337 :     let val mergeEdge = mergeEdge CFG
338 : monnier 411 fun higherFreq((_,_,CFG.EDGE{w=x,...}),(_,_,CFG.EDGE{w=y,...}))= !x < !y
339 : monnier 245 fun mergeAll([],changed) = changed
340 :     | mergeAll(e::es,changed) = mergeAll(es,mergeEdge e orelse changed)
341 : monnier 429 (* note: sort expects the gt operator and sorts in ascending order *)
342 :     val changed = mergeAll(ListMergeSort.sort higherFreq (#edges cfg ()),
343 :     false)
344 : monnier 245 in if changed then CFG.changed CFG else ()
345 :     end
346 :    
347 :     end
348 :    

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