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

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