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/flowgraph/cfg.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/flowgraph/cfg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1192 - (view) (download)

1 : jhr 1104 (* cfg.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 : george 906 * The control flow graph representation used for optimizations.
6 :     *
7 :     * -- Allen
8 :     *)
9 : jhr 1104
10 : george 906 functor ControlFlowGraph
11 : george 984 (structure I : INSTRUCTIONS
12 : george 906 structure GraphImpl : GRAPH_IMPLEMENTATION
13 : jhr 1084 structure InsnProps : INSN_PROPERTIES where I = I
14 : george 984 structure Asm : INSTRUCTION_EMITTER where I = I
15 : george 906 ) : CONTROL_FLOW_GRAPH =
16 :     struct
17 :    
18 :     structure I = I
19 : george 984 structure P = Asm.S.P
20 : george 906 structure C = I.C
21 :     structure G = Graph
22 :     structure S = Asm.S
23 : leunga 1156 structure A = Array
24 :     structure H = IntHashTable
25 :    
26 : jhr 1125 type weight = real
27 :    
28 : george 906 datatype block_kind =
29 :     START (* entry node *)
30 :     | STOP (* exit node *)
31 :     | NORMAL (* normal node *)
32 :    
33 : george 984 and block =
34 : george 906 BLOCK of
35 :     { id : int, (* block id *)
36 :     kind : block_kind, (* block kind *)
37 :     freq : weight ref, (* execution frequency *)
38 :     labels : Label.label list ref, (* labels on blocks *)
39 :     insns : I.instruction list ref, (* in rev order *)
40 : george 984 align : P.pseudo_op option ref, (* alignment only *)
41 : george 906 annotations : Annotations.annotations ref (* annotations *)
42 :     }
43 :    
44 : jhr 1084 and edge_kind (* edge kinds (see cfg.sig for more info) *)
45 :     = ENTRY (* entry edge *)
46 :     | EXIT (* exit edge *)
47 :     | JUMP (* unconditional jump *)
48 :     | FALLSTHRU (* falls through to next block *)
49 :     | BRANCH of bool (* branch *)
50 :     | SWITCH of int (* computed goto *)
51 :     | FLOWSTO (* FLOW_TO edge *)
52 : george 906
53 : jhr 1084 and edge_info = EDGE of {
54 :     k : edge_kind, (* edge kind *)
55 :     w : weight ref, (* edge freq *)
56 :     a : Annotations.annotations ref (* annotations *)
57 :     }
58 : george 906
59 :     type edge = edge_info Graph.edge
60 :     type node = block Graph.node
61 :    
62 :     datatype info =
63 :     INFO of { annotations : Annotations.annotations ref,
64 :     firstBlock : int ref,
65 : george 984 reorder : bool ref,
66 : george 1192 data : P.pseudo_op list ref,
67 :     decls : P.pseudo_op list ref
68 : george 906 }
69 :    
70 :     type cfg = (block,edge_info,info) Graph.graph
71 :    
72 :     fun error msg = MLRiscErrorMsg.error("ControlFlowGraph",msg)
73 :    
74 :     (*========================================================================
75 :     *
76 :     * Various kinds of annotations
77 :     *
78 :     *========================================================================*)
79 :     (* escaping live out information *)
80 :     val LIVEOUT = Annotations.new
81 :     (SOME(fn c => "Liveout: "^
82 :     (LineBreak.lineBreak 75
83 :     (CellsBasis.CellSet.toString c))))
84 :     exception Changed of string * (unit -> unit)
85 :     val CHANGED = Annotations.new'
86 :     {create=Changed,
87 :     get=fn Changed x => x | e => raise e,
88 :     toString=fn (name,_) => "CHANGED:"^name
89 :     }
90 :    
91 :     (*========================================================================
92 :     *
93 :     * Methods for manipulating basic blocks
94 :     *
95 :     *========================================================================*)
96 :     fun defineLabel(BLOCK{labels=ref(l::_),...}) = l
97 : george 984 | defineLabel(BLOCK{labels, ...}) = let
98 : george 906 val l = Label.anon ()
99 :     in
100 :     labels := [l];
101 :     l
102 :     end
103 :     fun insns(BLOCK{insns, ...}) = insns
104 :     fun freq(BLOCK{freq, ...}) = freq
105 : leunga 1156 fun edgeFreq(_,_,EDGE{w, ...}) = w
106 :     fun sumEdgeFreqs es = foldr (fn (e,w) => !(edgeFreq e) + w) 0.0 es
107 : george 906
108 :     fun newBlock'(id,kind,insns,freq) =
109 :     BLOCK{ id = id,
110 :     kind = kind,
111 :     freq = freq,
112 :     labels = ref [],
113 :     insns = ref insns,
114 : george 984 align = ref NONE,
115 : george 906 annotations = ref []
116 :     }
117 :    
118 : george 984 fun copyBlock(id,BLOCK{kind,freq,align,labels,insns,annotations,...}) =
119 : george 906 BLOCK{ id = id,
120 :     kind = kind,
121 :     freq = ref (!freq),
122 :     labels = ref [],
123 : george 984 align = ref (!align),
124 : george 906 insns = ref (!insns),
125 :     annotations = ref (!annotations)
126 :     }
127 :    
128 :     fun newBlock(id,freq) = newBlock'(id,NORMAL,[],freq)
129 :     fun newStart(id,freq) = newBlock'(id,START,[],freq)
130 :     fun newStop(id,freq) = newBlock'(id,STOP,[],freq)
131 :    
132 : jhr 1172 fun newNode (G.GRAPH graph) wt = let
133 :     val id = #new_id graph ()
134 :     val nd = (id, newBlock (id, ref wt))
135 :     in
136 :     #add_node graph nd;
137 :     nd
138 :     end
139 :    
140 : george 906 fun branchOf(EDGE{k=BRANCH b,...}) = SOME b
141 :     | branchOf _ = NONE
142 :     fun edgeDir(_,_,e) = branchOf e
143 :    
144 :     (*========================================================================
145 :     *
146 :     * Emit a basic block
147 :     *
148 :     *========================================================================*)
149 :     fun kindName START = "START"
150 :     | kindName STOP = "STOP"
151 :     | kindName NORMAL = "Block"
152 :    
153 :     fun nl() = TextIO.output(!AsmStream.asmOutStream,"\n")
154 :    
155 :     fun emitHeader (S.STREAM{comment,annotation,...})
156 :     (BLOCK{id,kind,freq,annotations,...}) =
157 :     (comment(kindName kind ^"["^Int.toString id^
158 : jhr 1125 "] ("^Real.toString (!freq)^")");
159 : george 906 nl();
160 :     app annotation (!annotations)
161 :     )
162 :    
163 :     fun emitFooter (S.STREAM{comment,...}) (BLOCK{annotations,...}) =
164 :     (case #get LIVEOUT (!annotations) of
165 :     SOME s =>
166 :     let val regs = String.tokens Char.isSpace(CellsBasis.CellSet.toString s)
167 :     val K = 7
168 :     fun f(_,[],s,l) = s::l
169 :     | f(0,vs,s,l) = f(K,vs," ",s::l)
170 :     | f(n,[v],s,l) = v^s::l
171 :     | f(n,v::vs,s,l) = f(n-1,vs,s^" "^v,l)
172 :     val text = rev(f(K,regs,"",[]))
173 :     in app (fn c => (comment c; nl())) text
174 :     end
175 :     | NONE => ()
176 :     ) handle Overflow => print("Bad footer\n")
177 :    
178 :     fun emitStuff outline annotations
179 : george 984 (block as BLOCK{insns,labels,...}) =
180 : george 906 let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
181 :     Asm.makeStream annotations
182 :     in emitHeader S block;
183 : george 959 app defineLabel (!labels);
184 : george 906 if outline then () else app emit (rev (!insns));
185 :     emitFooter S block
186 :     end
187 :    
188 :     val emit = emitStuff false
189 :     val emitOutline = emitStuff true []
190 :    
191 :     (*========================================================================
192 :     *
193 :     * Methods for manipulating CFG
194 :     *
195 :     *========================================================================*)
196 :     fun cfg info = GraphImpl.graph("CFG",info,10)
197 :     fun new() =
198 :     let val info = INFO{ annotations = ref [],
199 :     firstBlock = ref 0,
200 : george 984 reorder = ref false,
201 : george 1192 data = ref [],
202 :     decls = ref []
203 : george 906 }
204 :     in cfg info end
205 :    
206 :     fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
207 :     let val info = INFO{ annotations = ref [],
208 :     firstBlock = #firstBlock graph_info,
209 : george 984 reorder = #reorder graph_info,
210 : george 1192 data = #data graph_info,
211 :     decls = #decls graph_info
212 : george 906 }
213 :     in UpdateGraphInfo.update CFG info end
214 :    
215 :     fun init(G.GRAPH cfg) =
216 :     (case #entries cfg () of
217 :     [] =>
218 :     let val i = #new_id cfg ()
219 : jhr 1125 val start = newStart(i,ref 0.0)
220 : george 906 val _ = #add_node cfg (i,start)
221 :     val j = #new_id cfg ()
222 : jhr 1125 val stop = newStop(j,ref 0.0)
223 : george 906 val _ = #add_node cfg (j,stop)
224 :     in (* #add_edge cfg (i,j,EDGE{k=ENTRY,w=ref 0,a=ref []}); *)
225 :     #set_entries cfg [i];
226 :     #set_exits cfg [j]
227 :     end
228 :     | _ => ()
229 :     )
230 :    
231 :     fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =
232 :     let fun signal [] = ()
233 :     | signal(Changed(_,f)::an) = (f (); signal an)
234 :     | signal(_::an) = signal an
235 :     in signal(!annotations);
236 :     reorder := true
237 :     end
238 :    
239 :     fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a
240 :    
241 :     fun liveOut (BLOCK{annotations, ...}) =
242 :     case #get LIVEOUT (!annotations) of
243 :     SOME s => s
244 :     | NONE => C.empty
245 :     fun fallsThruFrom(G.GRAPH cfg,b) =
246 :     let fun f [] = NONE
247 :     | f((i,_,EDGE{k=BRANCH false,...})::_) = SOME i
248 :     | f((i,_,EDGE{k=FALLSTHRU,...})::_) = SOME i
249 :     | f(_::es) = f es
250 :     in f(#in_edges cfg b)
251 :     end
252 :     fun fallsThruTo(G.GRAPH cfg,b) =
253 :     let fun f [] = NONE
254 :     | f((_,j,EDGE{k=BRANCH false,...})::_) = SOME j
255 :     | f((_,j,EDGE{k=FALLSTHRU,...})::_) = SOME j
256 :     | f(_::es) = f es
257 :     in f(#out_edges cfg b)
258 :     end
259 :     fun removeEdge CFG (i,j,EDGE{a,...}) =
260 :     Graph.remove_edge' CFG (i,j,fn EDGE{a=a',...} => a = a')
261 :    
262 :     fun setBranch (CFG as G.GRAPH cfg,b,cond) =
263 :     let fun loop((i,j,EDGE{k=BRANCH cond',w,a})::es,es',x,y) =
264 :     if cond' = cond then
265 :     loop(es, (i,j,EDGE{k=JUMP,w=w,a=a})::es',j,y)
266 :     else
267 :     loop(es, es', x, j)
268 :     | loop([],es',target,elim) = (es',target,elim)
269 :     | loop _ = error "setBranch"
270 :     val outEdges = #out_edges cfg b
271 :     val (outEdges',target,elim) = loop(outEdges,[],~1,~1)
272 :     val _ = if elim < 0 then error "setBranch: bad edges" else ();
273 :     val lab = defineLabel(#node_info cfg target)
274 :     val jmp = InsnProps.jump lab
275 :     val insns = insns(#node_info cfg b)
276 :     in #set_out_edges cfg (b,outEdges');
277 :     case !insns of
278 :     [] => error "setBranch: missing branch"
279 :     | branch::rest =>
280 :     case InsnProps.instrKind branch of
281 :     InsnProps.IK_JUMP => insns := jmp::rest
282 :     | _ => error "setBranch: bad branch instruction";
283 :     jmp
284 :     end
285 :    
286 : jhr 1162 local
287 :     fun getNode (G.GRAPH{node_info, ...}, id) = (id, node_info id)
288 :     in
289 :     fun entryId (G.GRAPH{entries, ...}) = (case entries()
290 :     of [id] => id
291 :     | _ => error "no unique entry block"
292 :     (* end case *))
293 :     fun entry cfg = getNode(cfg, entryId cfg)
294 :     fun exitId (G.GRAPH{exits, node_info, ...}) = (case exits()
295 :     of [id] => id
296 :     | _ => error "no unique exit block"
297 :     (* end case *))
298 :     fun exit cfg = getNode(cfg, exitId cfg)
299 :     end
300 : leunga 1156
301 : jhr 1162 exception Can'tMerge
302 :     exception NotFound
303 : leunga 1156
304 :     fun labelOf(G.GRAPH cfg) node = defineLabel(#node_info cfg node)
305 :    
306 :     fun copyEdge(EDGE{a,w,k}) = EDGE{a=ref(!a),w=ref(!w),k=k}
307 :    
308 :     (*=====================================================================
309 :     *
310 :     * Check whether block i must preceed block j in any linear layout.
311 :     * This may be true if i falls through to j (transitively)
312 :     *
313 :     *=====================================================================*)
314 :     fun mustPreceed (G.GRAPH cfg) (i,j) =
315 :     let val visited = H.mkTable(23,NotFound)
316 :     fun chase [] = false
317 :     | chase((u,v,EDGE{k=(FALLSTHRU|BRANCH false),...})::_) =
318 :     if H.inDomain visited u then false
319 :     else u = i orelse (H.insert visited (u,true); chase(#in_edges cfg u))
320 :     | chase(_::es) = chase es
321 :     in i = j orelse chase(#in_edges cfg j)
322 :     end
323 :    
324 :     (*=====================================================================
325 :     *
326 :     * Predicates on nodes and edges
327 :     *
328 :     *=====================================================================*)
329 :     fun isMerge (G.GRAPH cfg) node = length(#in_edges cfg node) > 1
330 :     fun isSplit (G.GRAPH cfg) node = length(#out_edges cfg node) > 1
331 :     (*
332 :     fun hasSideExits (G.GRAPH cfg) node =
333 :     List.exists (fn (_,_,EDGE{k=SIDEEXIT _,...}) => true
334 :     | _ => false) (#out_edges cfg node)
335 :     *)
336 :     fun hasSideExits _ _ = false
337 :     fun isCriticalEdge CFG (_,_,EDGE{k=ENTRY,...}) = false
338 :     | isCriticalEdge CFG (_,_,EDGE{k=EXIT,...}) = false
339 :     | isCriticalEdge CFG (i,j,_) = isSplit CFG i andalso isMerge CFG j
340 :    
341 :     (*=====================================================================
342 :     *
343 :     * Update the label of the branch instruction in a certain block
344 :     * to be consistent with the control flow edges. This doesn't work
345 :     * on hyperblocks!!!
346 :     *
347 :     *=====================================================================*)
348 :     fun updateJumpLabel(CFG as G.GRAPH cfg) =
349 :     let val labelOf = labelOf CFG
350 :     fun update node =
351 :     case #node_info cfg node of
352 :     BLOCK{insns=ref [],...} => ()
353 :     | BLOCK{kind=START,...} => ()
354 :     | BLOCK{kind=STOP,...} => ()
355 :     | BLOCK{insns=insns as ref(jmp::rest),...} =>
356 :     (case #out_edges cfg node of
357 :     [] => ()
358 :     | [(_,_,EDGE{k=(ENTRY | EXIT),...})] => ()
359 :     | [(i,j,_)] =>
360 :     if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
361 :     insns := InsnProps.setJumpTarget(jmp,labelOf j)::rest
362 :     else ()
363 :     | [(_,i,EDGE{k=BRANCH x,...}),
364 :     (_,j,EDGE{k=BRANCH y,...})] =>
365 :     let val (no,yes) = if x then (j,i) else (i,j)
366 :     in insns :=
367 :     InsnProps.setBranchTargets{i=jmp,
368 :     f=labelOf no,t=labelOf yes}::rest
369 :     end
370 :     | es =>
371 :     let fun gt ((_,_,EDGE{k=SWITCH i,...}),
372 :     (_,_,EDGE{k=SWITCH j,...})) = i > j
373 :     | gt _ = error "gt"
374 :     val es = ListMergeSort.sort gt es
375 :     val labels = map (fn (_,j,_) => labelOf j) es
376 :     in error "updateJumpLabel"
377 :     end
378 :     )
379 :     in update
380 :     end
381 :    
382 :     (*=====================================================================
383 :     *
384 :     * Merge a control flow edge i -> j.
385 :     * Raise Can't Merge if it is illegal.
386 :     * After merging blocks i and j will become block i.
387 :     *
388 :     *=====================================================================*)
389 :     fun mergeEdge (CFG as G.GRAPH cfg) (i,j,e as EDGE{w,k,...}) =
390 :     let val _ = case k of
391 :     (ENTRY | EXIT) => raise Can'tMerge
392 :     | _ => ()
393 :     val _ = case (#out_edges cfg i,#in_edges cfg j) of
394 :     ([(_,j',_)],[(i',_,_)]) =>
395 :     if j' <> j orelse i' <> i then raise Can'tMerge
396 :     else ()
397 :     | _ => raise Can'tMerge
398 :     val _ = if mustPreceed CFG (i,j) then raise Can'tMerge else ()
399 :     val BLOCK{align=d2,insns=i2,annotations=a2,...} = #node_info cfg j
400 :     val _ = case !d2 of SOME _ => () | _ => raise Can'tMerge
401 :     val BLOCK{align=d1,insns=i1,annotations=a1,...} = #node_info cfg i
402 :     (* If both blocks have annotations then don't merge them.
403 :     * But instead, just try to removed the jump instruction instead.
404 :     *)
405 :     val canMerge = case (!a1, !a2) of
406 :     (_::_, _::_) => false
407 :     | _ => true
408 :     val insns1 = case !i1 of
409 :     [] => []
410 :     | insns as jmp::rest =>
411 :     if InsnProps.instrKind jmp = InsnProps.IK_JUMP
412 :     then rest else insns
413 :     in if canMerge then
414 :     (i1 := !i2 @ insns1;
415 :     a1 := !a1 @ !a2;
416 :     #set_out_edges cfg
417 :     (i,map (fn (_,j',e) => (i,j',e)) (#out_edges cfg j));
418 :     #remove_node cfg j;
419 :     updateJumpLabel CFG i
420 :     )
421 :     else (* Just eliminate the jump instruction at the end *)
422 :     (i1 := insns1;
423 :     #set_out_edges cfg
424 :     (i,map (fn (i,j,EDGE{w,a,...}) =>
425 :     (i,j,EDGE{k=FALLSTHRU,w=w,a=a}))
426 :     (#out_edges cfg i))
427 :     );
428 :     true
429 :     end handle Can'tMerge => false
430 :    
431 :     (*=====================================================================
432 :     *
433 :     * Eliminate the jump at the end of a basic block if feasible
434 :     *
435 :     *=====================================================================*)
436 :     fun eliminateJump (CFG as G.GRAPH cfg) i =
437 :     (case #out_edges cfg i of
438 :     [e as (i,j,EDGE{k,w,a})] =>
439 :     (case fallsThruFrom(CFG,j) of
440 :     SOME _ => false
441 :     | NONE =>
442 :     if mustPreceed CFG (j,i) then false
443 :     else
444 :     let val BLOCK{insns,...} = #node_info cfg i
445 :     val BLOCK{align,...} = #node_info cfg j
446 :     in case (!align,!insns) of
447 :     (NONE,jmp::rest) =>
448 :     if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
449 :     (insns := rest;
450 :     removeEdge CFG e;
451 :     #add_edge cfg (i,j,EDGE{k=FALLSTHRU,w=w,a=a});
452 :     true
453 :     )
454 :     else false
455 :     | _ => false
456 :     end
457 :     )
458 :     | _ => false
459 :     )
460 :    
461 :     (*=====================================================================
462 :     *
463 :     * Insert a jump at the end of a basic block if feasible
464 :     *
465 :     *=====================================================================*)
466 :     fun insertJump (CFG as G.GRAPH cfg) i =
467 :     (case #out_edges cfg i of
468 :     [e as (i,j,EDGE{k=FALLSTHRU,w,a,...})] =>
469 :     let val BLOCK{insns,...} = #node_info cfg i
470 :     in insns := InsnProps.jump(labelOf CFG j) :: !insns;
471 :     removeEdge CFG e;
472 :     #add_edge cfg (i,j,EDGE{k=JUMP,w=w,a=a});
473 :     true
474 :     end
475 :     | _ => false
476 :     )
477 :    
478 :    
479 :     (*=====================================================================
480 :     *
481 :     * Split a group of control flow edge.
482 :     *
483 : leunga 1158 * Split n groups of control flow edges, all initially entering block j,
484 :     *
485 :     * i_11 -> j, i_12 -> j, ... group 1
486 :     * i_21 -> j, i_22 -> j, ... group 2
487 :     * ....
488 :     * i_n1 -> j, i_n2 -> j, ... group n
489 :     *
490 :     * into
491 :     *
492 :     * i_11 -> k_1
493 :     * i_12 -> k_1
494 :     * ...
495 :     * i_21 -> k_2
496 :     * i_22 -> k_2
497 :     * ...
498 :     * i_n1 -> k_n
499 :     * i_n2 -> k_n
500 :     * ...
501 :     *
502 :     * and k_1 -> k_2
503 :     * k_2 -> k_3
504 :     * ...
505 :     * k_n -> j
506 :     *
507 :     * Return the new edges
508 :     * k_1->j,...,k_n -> j
509 :     *
510 :     * and the new blocks
511 :     * k_1, ..., k_n.
512 :     *
513 :     * Each block k_1, ..., k_n can have instructions placed in them.
514 :     *
515 :     * If the jump flag is true, then a jump is always placed in the
516 :     * new block k_n; otherwise, we try to eliminate the jump when feasible.
517 :     *
518 : leunga 1156 *=====================================================================*)
519 :     fun splitEdges (CFG as G.GRAPH cfg) {groups=[], jump} = []
520 :     | splitEdges (CFG as G.GRAPH cfg) {groups as ((first,_)::_), jump} =
521 :     let (* target of all the edges *)
522 :     val j = let val (_,j,_) = hd first in j end
523 :    
524 : leunga 1158 (* Insert an edge i->j with frequency freq.
525 :     * It is a jump edge iff jump flag is true or
526 :     * some other block is already falling into j
527 :     *)
528 :     fun insertEdge(i,j,node_i,freq,jump) =
529 :     let val kind =
530 :     if jump orelse isSome(fallsThruFrom(CFG,j)) then
531 :     let val insns_i = insns node_i
532 :     in insns_i := InsnProps.jump(labelOf CFG j) :: !insns_i;
533 :     JUMP
534 :     end
535 :     else
536 :     FALLSTHRU
537 :     val edge_info = EDGE{k=kind, w=ref freq, a=ref []}
538 :     val edge = (i,j,edge_info)
539 :     in #add_edge cfg edge;
540 :     edge
541 :     end
542 :    
543 :     (* Redirect all edges *)
544 :     fun redirect([], freq, new) = new
545 :     | redirect((edges, insns)::groups, freq, new) =
546 : leunga 1156 let
547 :     val freq = sumEdgeFreqs edges + freq (* freq of new block *)
548 :    
549 : leunga 1158 (* Sanity check
550 :     *)
551 :     fun check [] = ()
552 :     | check((u,v,_)::es) =
553 : leunga 1156 (if v <> j then error "splitEdge: bad edge" else ();
554 : leunga 1158 check es
555 : leunga 1156 )
556 :    
557 : leunga 1158 val () = check edges
558 : leunga 1156
559 :     val k = #new_id cfg () (* new block id *)
560 :     val node_k =
561 :     BLOCK{id=k, kind=NORMAL,
562 :     freq= ref freq, align=ref NONE, labels = ref [],
563 : leunga 1158 insns=ref insns, annotations=ref []}
564 :    
565 : leunga 1156 in app (removeEdge CFG) edges;
566 :     app (fn (i,_,e) => #add_edge cfg (i,k,e)) edges;
567 :     #add_node cfg (k,node_k);
568 : leunga 1158 redirect(groups, freq, (k, node_k, edges, freq)::new)
569 : leunga 1156 end
570 :    
571 : leunga 1158 val new = redirect(groups, 0.0, [])
572 : leunga 1156
573 :     (* Add the edges on the chain *)
574 : leunga 1158 fun postprocess([], next, new) = new
575 :     | postprocess((k, node_k, edges, freq)::rest, next, new) =
576 :     let val jump = next = j andalso jump
577 :     val edge = insertEdge(k, next, node_k, freq, jump)
578 :     in postprocess(rest, k, ((k,node_k),edge)::new)
579 : leunga 1156 end
580 :    
581 :     val new = postprocess(new, j, [])
582 :    
583 :     in (* Update the labels on the groups *)
584 :     app (fn (es, _) => app (fn (i,_,_) => updateJumpLabel CFG i) es) groups;
585 :     new
586 :     end
587 :    
588 :     (*=====================================================================
589 :     *
590 :     * Split all critical edges in the CFG
591 :     *
592 :     *=====================================================================*)
593 :     fun splitAllCriticalEdges (CFG as G.GRAPH cfg) =
594 :     let val hasChanged = ref false
595 :     in #forall_edges cfg
596 :     (fn e => if isCriticalEdge CFG e then
597 :     (splitEdges CFG {groups=[([e],[])],jump=false};
598 :     hasChanged := true)
599 :     else ());
600 :     if !hasChanged then changed CFG else ()
601 :     end
602 :    
603 :     (*=====================================================================
604 :     *
605 :     * Tail duplicate a region until there are no side entry edges
606 :     * entering into the region. Return the set of new edges and nodes
607 :     *
608 :     *=====================================================================*)
609 :     fun tailDuplicate (CFG as G.GRAPH cfg : cfg)
610 :     {subgraph=G.GRAPH subgraph : cfg,root} =
611 :     let
612 :     val blockMap = H.mkTable(10,NotFound)
613 :     val _ = print("[root "^Int.toString root^"]\n")
614 :    
615 :     fun duplicate v =
616 :     H.lookup blockMap v handle NotFound =>
617 :     let val w = #new_id cfg ()
618 :     val w' = copyBlock(w,#node_info cfg v)
619 :     in #add_node cfg (w,w');
620 :     H.insert blockMap (v,(w,w'));
621 :     app (#add_edge cfg)
622 :     (map (fn (i,j,e) => (w,j,copyEdge e)) (#out_edges cfg v));
623 :     updateJumpLabel CFG w;
624 :     (w,w')
625 :     end
626 :    
627 :     fun process((n,_)::rest,ns,Ns,Es) =
628 :     process(rest,collect(#entry_edges subgraph n,ns),Ns,Es)
629 :     | process([],ns,Ns,Es) = dupl(ns,Ns,Es,false)
630 :    
631 :     and collect([],ns) = ns
632 :     | collect((i,_,_)::es,ns) = collect(es,if i = root then ns else i::ns)
633 :    
634 :     and dupl([],Ns,Es,changed) = (Ns,Es,changed)
635 :     | dupl(n::ns,Ns,Es,changed) =
636 :     redirect(#out_edges cfg n,ns,Ns,Es,changed)
637 :    
638 :     and redirect([],ns,Ns,Es,changed) = dupl(ns,Ns,Es,changed)
639 :     | redirect((u,v,e)::es,ns,Ns,Es,changed) =
640 :     if v <> root andalso
641 :     #has_edge cfg (u,v) andalso
642 :     #has_node subgraph v andalso
643 :     not(#has_edge subgraph (u,v)) then
644 :     (*
645 :     * u -> v is a side entry edge, duplicate v
646 :     *)
647 :     let val _ = print("[tail duplicating "^Int.toString u^" -> "^
648 :     Int.toString v^"]\n")
649 :     val (w,w') = duplicate v
650 :     in removeEdge CFG (u,v,e);
651 :     #add_edge cfg (u,w,e);
652 :     updateJumpLabel CFG u;
653 :     redirect(es,w::ns,(w,w')::Ns,(u,w,e)::Es,true)
654 :     end
655 :     else redirect(es,ns,Ns,Es,changed)
656 :    
657 :     fun iter(Ns,Es) =
658 :     let val (Ns,Es,hasChanged) = process(#nodes subgraph (),[],Ns,Es)
659 :     in if hasChanged then (changed CFG; iter(Ns,Es))
660 :     else {nodes=Ns,edges=Es}
661 :     end
662 :    
663 :     in iter([],[])
664 :     end
665 :    
666 :    
667 :     (*=====================================================================
668 :     *
669 :     * Remove unreachable code in the CFG
670 :     *
671 :     *=====================================================================*)
672 :     fun removeUnreachableCode(CFG as G.GRAPH cfg) =
673 :     let val N = #capacity cfg ()
674 :     val visited = A.array(N,false)
675 :     fun mark n = if A.sub(visited,n) then ()
676 :     else (A.update(visited,n,true); app mark (#succ cfg n))
677 :     val hasChanged = ref false
678 :     fun remove(b,BLOCK{align,insns,...}) =
679 :     if A.sub(visited,b) then ()
680 :     else
681 :     (hasChanged :=true;
682 :     case #in_edges cfg b of
683 :     [] => #remove_node cfg b
684 :     | _ => (insns := []; #set_out_edges cfg (b,[]))
685 :     )
686 :     in app mark (#entries cfg ());
687 :     #forall_nodes cfg remove;
688 :     if !hasChanged then changed CFG else ()
689 :     end
690 :    
691 :    
692 :     (*=====================================================================
693 :     *
694 :     * Merge all edges in the CFG.
695 :     * Merge higher frequency edges first
696 :     *
697 :     *=====================================================================*)
698 :     fun mergeAllEdges(CFG as G.GRAPH cfg) =
699 :     let val mergeEdge = mergeEdge CFG
700 :     fun higherFreq((_,_,EDGE{w=x,...}),(_,_,EDGE{w=y,...}))= !x < !y
701 :     fun mergeAll([],changed) = changed
702 :     | mergeAll(e::es,changed) = mergeAll(es,mergeEdge e orelse changed)
703 :     (* note: sort expects the gt operator and sorts in ascending order *)
704 :     val hasChanged = mergeAll(ListMergeSort.sort higherFreq (#edges cfg ()),
705 :     false)
706 :     in if hasChanged then changed CFG else ()
707 :     end
708 :    
709 : george 906 (*========================================================================
710 :     *
711 :     * Miscellaneous
712 :     *
713 :     *========================================================================*)
714 :     fun cdgEdge(EDGE{k, ...}) =
715 :     case k of
716 :     (JUMP | FALLSTHRU) => false
717 :     | _ => true
718 :    
719 :     (*========================================================================
720 :     *
721 :     * Pretty Printing and Viewing
722 :     *
723 :     *========================================================================*)
724 :    
725 : jhr 1104 structure F = Format
726 : george 906
727 : jhr 1104 fun show_edge (EDGE{k,w,a,...}) = let
728 :     val kind = (case k
729 :     of JUMP => "jump"
730 :     | FALLSTHRU => "fallsthru"
731 :     | BRANCH b => Bool.toString b
732 :     | SWITCH i => Int.toString i
733 :     | ENTRY => "entry"
734 :     | EXIT => "exit"
735 :     | FLOWSTO => "flowsto"
736 :     (* end case *))
737 :     in
738 : jhr 1135 F.format "%s[%f]" [F.STR kind, F.REAL(!w)]
739 : jhr 1104 end
740 :    
741 :     fun getString f x = let
742 :     val buffer = StringOutStream.mkStreamBuf()
743 :     val S = StringOutStream.openStringOut buffer
744 :     val _ = AsmStream.withStream S f x
745 :     in
746 :     StringOutStream.getString buffer
747 :     end
748 :    
749 :     fun show_block an block = let
750 :     val text = getString (emit an) block
751 :     in
752 :     foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
753 :     (String.tokens (fn #" " => true | _ => false) text)
754 :     end
755 :    
756 : jhr 1118 fun dumpBlock (outS, cfg as G.GRAPH g) = let
757 : jhr 1104 fun pr str = TextIO.output(outS, str)
758 :     fun prList [] = ()
759 :     | prList [i] = pr i
760 :     | prList (h::t) = (pr (h ^ ", "); prList t)
761 : jhr 1118 val Asm.S.STREAM{emit,defineLabel,annotation,...} =
762 :     AsmStream.withStream outS Asm.makeStream []
763 : jhr 1125 fun showFreq (ref w) = F.format "[%f]" [F.REAL w]
764 : jhr 1104 fun showEdge (blknum,e) =
765 :     F.format "%d:%s" [F.INT blknum, F.STR(show_edge e)]
766 :     fun showSucc (_, x, e) = showEdge(x,e)
767 :     fun showPred (x, _, e) = showEdge(x,e)
768 :     fun showSuccs b = (
769 :     pr "\tsucc: ";
770 :     prList (map showSucc (#out_edges g b));
771 :     pr "\n")
772 :     fun showPreds b = (
773 :     pr "\tpred: ";
774 :     prList (map showPred (#in_edges g b));
775 :     pr "\n")
776 :     fun printBlock (_, BLOCK{kind=START, id, freq, ...}) = (
777 :     pr (F.format "ENTRY %d %s\n" [F.INT id, F.STR(showFreq freq)]);
778 :     showSuccs id)
779 :     | printBlock (_, BLOCK{kind=STOP, id, freq, ...}) = (
780 :     pr (F.format "EXIT %d %s\n" [F.INT id, F.STR(showFreq freq)]);
781 :     showPreds id)
782 :     | printBlock (
783 :     _, BLOCK{id, align, freq, insns, annotations, labels, ...}
784 :     ) = (
785 :     pr (F.format "BLOCK %d %s\n" [F.INT id, F.STR(showFreq freq)]);
786 :     case !align of NONE => () | SOME p => (pr (P.toString p ^ "\n"));
787 : jhr 1118 List.app annotation (!annotations);
788 :     List.app defineLabel (!labels);
789 : jhr 1104 showSuccs id;
790 :     showPreds id;
791 :     List.app emit (List.rev (!insns)))
792 : jhr 1118 in
793 :     printBlock
794 :     end
795 :    
796 :     fun dump (outS, title, cfg as G.GRAPH g) = let
797 :     fun pr str = TextIO.output(outS, str)
798 :     val annotations = !(annotations cfg)
799 :     val Asm.S.STREAM{annotation, ...} =
800 :     AsmStream.withStream outS Asm.makeStream annotations
801 : jhr 1104 fun printData () = let
802 :     val INFO{data, ...} = #graph_info g
803 :     in
804 :     List.app (pr o P.toString) (rev(!data))
805 :     end
806 :     in
807 :     pr(F.format "[ %s ]\n" [F.STR title]);
808 :     List.app annotation annotations;
809 :     (* printBlock entry; *)
810 : jhr 1118 AsmStream.withStream outS (#forall_nodes g) (dumpBlock (outS, cfg));
811 : jhr 1104 (* printBlock exit; *)
812 :     AsmStream.withStream outS printData ();
813 :     TextIO.flushOut outS
814 :     end
815 :    
816 : george 906 end
817 :    

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