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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : monnier 411 (*
2 :     * The control flow graph representation used for optimizations.
3 :     *
4 :     * -- Allen
5 :     *)
6 : george 545 functor ControlFlowGraph
7 : monnier 245 (structure I : INSTRUCTIONS
8 : george 545 structure PseudoOps : PSEUDO_OPS
9 : monnier 245 structure GraphImpl : GRAPH_IMPLEMENTATION
10 : leunga 624 structure InsnProps : INSN_PROPERTIES
11 : monnier 411 structure Asm : INSTRUCTION_EMITTER
12 : leunga 624 sharing Asm.I = InsnProps.I = I
13 : george 545 sharing Asm.P = PseudoOps
14 : monnier 245 ) : CONTROL_FLOW_GRAPH =
15 :     struct
16 :    
17 :     structure I = I
18 : george 545 structure P = PseudoOps
19 : monnier 245 structure C = I.C
20 : monnier 411 structure W = Freq
21 : monnier 245 structure G = Graph
22 :     structure L = GraphLayout
23 :     structure A = Annotations
24 : monnier 411 structure S = Asm.S
25 : monnier 245
26 : monnier 411 type weight = W.freq
27 : monnier 245
28 :     datatype block_kind =
29 :     START (* entry node *)
30 :     | STOP (* exit node *)
31 :     | NORMAL (* normal node *)
32 :     | HYPERBLOCK (* hyperblock *)
33 :    
34 :     and data = LABEL of Label.label
35 :     | PSEUDO of P.pseudo_op
36 :    
37 :     and block =
38 :     BLOCK of
39 :     { id : int, (* block id *)
40 :     kind : block_kind, (* block kind *)
41 :     freq : weight ref, (* execution frequency *)
42 :     data : data list ref, (* data preceeding block *)
43 :     labels : Label.label list ref, (* labels on blocks *)
44 :     insns : I.instruction list ref, (* in rev order *)
45 :     annotations : Annotations.annotations ref (* annotations *)
46 :     }
47 :    
48 :     and edge_kind = ENTRY (* entry edge *)
49 :     | EXIT (* exit edge *)
50 :     | JUMP (* unconditional jump *)
51 :     | FALLSTHRU (* falls through to next block *)
52 :     | BRANCH of bool (* branch *)
53 :     | SWITCH of int (* computed goto *)
54 :     | SIDEEXIT of int (* side exit *)
55 :    
56 :     and edge_info = EDGE of { k : edge_kind, (* edge kind *)
57 :     w : weight ref, (* edge freq *)
58 :     a : Annotations.annotations ref (* annotations *)
59 :     }
60 :    
61 :     type edge = edge_info Graph.edge
62 :     type node = block Graph.node
63 :    
64 :     datatype info =
65 : leunga 744 INFO of { annotations : Annotations.annotations ref,
66 : monnier 245 firstBlock : int ref,
67 :     reorder : bool ref
68 :     }
69 :    
70 :     type cfg = (block,edge_info,info) Graph.graph
71 :    
72 : leunga 624 fun error msg = MLRiscErrorMsg.error("ControlFlowGraph",msg)
73 :    
74 : monnier 245 (*========================================================================
75 :     *
76 :     * Various kinds of annotations
77 :     *
78 :     *========================================================================*)
79 : monnier 469 (* escaping live out information *)
80 :     val LIVEOUT = Annotations.new
81 : george 545 (SOME(fn c => "Liveout: "^
82 : leunga 744 (LineBreak.lineBreak 75
83 :     (C.CellSet.toString c))))
84 : leunga 624 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 : monnier 245
91 :     (*========================================================================
92 :     *
93 :     * Methods for manipulating basic blocks
94 :     *
95 :     *========================================================================*)
96 :     fun defineLabel(BLOCK{labels=ref(l::_),...}) = l
97 :     | defineLabel(BLOCK{labels,...}) = let val l = Label.newLabel ""
98 :     in labels := [l]; l end
99 : leunga 624 fun insns(BLOCK{insns, ...}) = insns
100 :     fun freq(BLOCK{freq, ...}) = freq
101 : monnier 245
102 : monnier 469 fun newBlock'(id,kind,insns,freq) =
103 : monnier 245 BLOCK{ id = id,
104 :     kind = kind,
105 : monnier 411 freq = freq,
106 : monnier 245 data = ref [],
107 :     labels = ref [],
108 :     insns = ref insns,
109 :     annotations = ref []
110 :     }
111 :    
112 : monnier 469 fun copyBlock(id,BLOCK{kind,freq,data,labels,insns,annotations,...}) =
113 : monnier 245 BLOCK{ id = id,
114 :     kind = kind,
115 : monnier 411 freq = ref (!freq),
116 : monnier 245 data = ref (!data),
117 :     labels = ref [],
118 :     insns = ref (!insns),
119 :     annotations = ref (!annotations)
120 :     }
121 :    
122 : monnier 469 fun newBlock(id,freq) = newBlock'(id,NORMAL,[],freq)
123 :     fun newStart(id,freq) = newBlock'(id,START,[],freq)
124 :     fun newStop(id,freq) = newBlock'(id,STOP,[],freq)
125 : monnier 245
126 : leunga 624 fun branchOf(EDGE{k=BRANCH b,...}) = SOME b
127 :     | branchOf _ = NONE
128 : leunga 775 fun edgeDir(_,_,e) = branchOf e
129 : leunga 624
130 : monnier 245 (*========================================================================
131 :     *
132 :     * Emit a basic block
133 :     *
134 :     *========================================================================*)
135 :     fun kindName START = "START"
136 :     | kindName STOP = "STOP"
137 :     | kindName HYPERBLOCK = "Hyperblock"
138 :     | kindName NORMAL = "Block"
139 :    
140 :     fun nl() = TextIO.output(!AsmStream.asmOutStream,"\n")
141 :    
142 : monnier 411 fun emitHeader (S.STREAM{comment,annotation,...})
143 :     (BLOCK{id,kind,freq,annotations,...}) =
144 : monnier 245 (comment(kindName kind ^"["^Int.toString id^
145 :     "] ("^W.toString (!freq)^")");
146 : monnier 411 nl();
147 :     app annotation (!annotations)
148 : monnier 245 )
149 :    
150 : monnier 411 fun emitFooter (S.STREAM{comment,...}) (BLOCK{annotations,...}) =
151 : monnier 469 (case #get LIVEOUT (!annotations) of
152 : monnier 245 SOME s =>
153 : leunga 744 let val regs = String.tokens Char.isSpace(C.CellSet.toString s)
154 : monnier 245 val K = 7
155 :     fun f(_,[],s,l) = s::l
156 :     | f(0,vs,s,l) = f(K,vs," ",s::l)
157 :     | f(n,[v],s,l) = v^s::l
158 :     | f(n,v::vs,s,l) = f(n-1,vs,s^" "^v,l)
159 :     val text = rev(f(K,regs,"",[]))
160 : monnier 411 in app (fn c => (comment c; nl())) text
161 : monnier 245 end
162 :     | NONE => ()
163 :     ) handle Overflow => print("Bad footer\n")
164 :    
165 : leunga 744 fun emitStuff outline annotations
166 : monnier 429 (block as BLOCK{insns,data,labels,...}) =
167 :     let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
168 :     Asm.makeStream annotations
169 : monnier 411 in emitHeader S block;
170 :     app (fn PSEUDO p => pseudoOp p
171 :     | LABEL l => defineLabel l) (!data);
172 :     app defineLabel (!labels);
173 :     if outline then () else app emit (rev (!insns));
174 :     emitFooter S block
175 :     end
176 :    
177 : monnier 429 val emit = emitStuff false
178 :     val emitOutline = emitStuff true []
179 : monnier 245
180 :     (*========================================================================
181 :     *
182 :     * Methods for manipulating CFG
183 :     *
184 :     *========================================================================*)
185 :     fun cfg info = GraphImpl.graph("CFG",info,10)
186 : leunga 744 fun new() =
187 :     let val info = INFO{ annotations = ref [],
188 : monnier 245 firstBlock = ref 0,
189 :     reorder = ref false
190 :     }
191 :     in cfg info end
192 :    
193 :     fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
194 : leunga 744 let val info = INFO{ annotations = ref [],
195 : monnier 245 firstBlock = #firstBlock graph_info,
196 :     reorder = #reorder graph_info
197 :     }
198 :     in UpdateGraphInfo.update CFG info end
199 :    
200 :     fun init(G.GRAPH cfg) =
201 : monnier 429 (case #entries cfg () of
202 :     [] =>
203 : monnier 245 let val i = #new_id cfg ()
204 : monnier 411 val start = newStart(i,ref 0)
205 : monnier 245 val _ = #add_node cfg (i,start)
206 :     val j = #new_id cfg ()
207 : george 909 val stop = newStop(j,ref 0)
208 : monnier 245 val _ = #add_node cfg (j,stop)
209 : monnier 411 in #add_edge cfg (i,j,EDGE{k=ENTRY,w=ref 0,a=ref []});
210 : monnier 245 #set_entries cfg [i];
211 :     #set_exits cfg [j]
212 :     end
213 : monnier 429 | _ => ()
214 :     )
215 : monnier 245
216 :     fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =
217 : leunga 624 let fun signal [] = ()
218 :     | signal(Changed(_,f)::an) = (f (); signal an)
219 :     | signal(_::an) = signal an
220 :     in signal(!annotations);
221 :     reorder := true
222 :     end
223 : monnier 245
224 : leunga 624 fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a
225 : monnier 429
226 : monnier 469 fun liveOut (BLOCK{annotations, ...}) =
227 :     case #get LIVEOUT (!annotations) of
228 : monnier 245 SOME s => s
229 :     | NONE => C.empty
230 :     fun fallsThruFrom(G.GRAPH cfg,b) =
231 :     let fun f [] = NONE
232 :     | f((i,_,EDGE{k=BRANCH false,...})::_) = SOME i
233 :     | f((i,_,EDGE{k=FALLSTHRU,...})::_) = SOME i
234 :     | f(_::es) = f es
235 :     in f(#in_edges cfg b)
236 :     end
237 :     fun fallsThruTo(G.GRAPH cfg,b) =
238 :     let fun f [] = NONE
239 :     | f((_,j,EDGE{k=BRANCH false,...})::_) = SOME j
240 :     | f((_,j,EDGE{k=FALLSTHRU,...})::_) = SOME j
241 :     | f(_::es) = f es
242 :     in f(#out_edges cfg b)
243 :     end
244 :     fun removeEdge CFG (i,j,EDGE{a,...}) =
245 :     Graph.remove_edge' CFG (i,j,fn EDGE{a=a',...} => a = a')
246 :    
247 : leunga 624 fun setBranch (CFG as G.GRAPH cfg,b,cond) =
248 :     let fun loop((i,j,EDGE{k=BRANCH cond',w,a})::es,es',x,y) =
249 :     if cond' = cond then
250 :     loop(es, (i,j,EDGE{k=JUMP,w=w,a=a})::es',j,y)
251 :     else
252 :     loop(es, es', x, j)
253 :     | loop([],es',target,elim) = (es',target,elim)
254 :     | loop _ = error "setBranch"
255 :     val outEdges = #out_edges cfg b
256 :     val (outEdges',target,elim) = loop(outEdges,[],~1,~1)
257 :     val _ = if elim < 0 then error "setBranch: bad edges" else ();
258 :     val lab = defineLabel(#node_info cfg target)
259 :     val jmp = InsnProps.jump lab
260 :     val insns = insns(#node_info cfg b)
261 :     in #set_out_edges cfg (b,outEdges');
262 :     case !insns of
263 :     [] => error "setBranch: missing branch"
264 :     | branch::rest =>
265 :     case InsnProps.instrKind branch of
266 :     InsnProps.IK_JUMP => insns := jmp::rest
267 :     | _ => error "setBranch: bad branch instruction";
268 :     jmp
269 :     end
270 :    
271 : monnier 245 (*========================================================================
272 :     *
273 :     * Miscellaneous
274 :     *
275 :     *========================================================================*)
276 :     fun cdgEdge(EDGE{k, ...}) =
277 :     case k of
278 :     (JUMP | FALLSTHRU) => false
279 :     | _ => true
280 :    
281 :     (*========================================================================
282 :     *
283 :     * Pretty Printing and Viewing
284 :     *
285 :     *========================================================================*)
286 :     fun show_edge(EDGE{k,w,a,...}) =
287 :     let val kind = case k of
288 :     JUMP => ""
289 :     | FALLSTHRU => "fallsthru"
290 :     | BRANCH b => Bool.toString b
291 :     | SWITCH i => Int.toString i
292 :     | ENTRY => "entry"
293 :     | EXIT => "exit"
294 :     | SIDEEXIT i => "sideexit("^Int.toString i^")"
295 :     val weight = "(" ^ W.toString (!w) ^ ")"
296 :     in kind ^ weight
297 :     end
298 :    
299 :     fun getString f x =
300 : monnier 498 let val buffer = StringOutStream.mkStreamBuf()
301 :     val S = StringOutStream.openStringOut buffer
302 : monnier 245 val _ = AsmStream.withStream S f x
303 : monnier 498 in StringOutStream.getString buffer end
304 : monnier 245
305 : leunga 744 fun show_block an block =
306 :     let val text = getString (emit an) block
307 : monnier 245 in foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
308 :     (String.tokens (fn #" " => true | _ => false) text)
309 :     end
310 :    
311 : monnier 411 fun headerText block = getString
312 : monnier 429 (fn b => emitHeader (Asm.makeStream []) b) block
313 : monnier 411 fun footerText block = getString
314 : monnier 429 (fn b => emitFooter (Asm.makeStream []) b) block
315 : monnier 245
316 : monnier 469 fun getStyle a = (case #get L.STYLE (!a) of SOME l => l | NONE => [])
317 :    
318 : leunga 624 val green = L.COLOR "green"
319 :     val red = L.COLOR "red"
320 :     val yellow = L.COLOR "yellow"
321 :    
322 : monnier 245 fun edgeStyle(i,j,e as EDGE{k,a,...}) =
323 : monnier 469 let val a = L.LABEL(show_edge e) :: getStyle a
324 : monnier 245 in case k of
325 : leunga 624 (ENTRY | EXIT) => green :: a
326 :     | (FALLSTHRU | BRANCH false) => yellow :: a
327 :     | _ => red :: a
328 : monnier 245 end
329 :    
330 : monnier 429 val outline = MLRiscControl.getFlag "view-outline"
331 : monnier 411
332 : monnier 245 fun viewStyle cfg =
333 : leunga 744 let val an = !(annotations cfg)
334 : monnier 411 fun node (n,b as BLOCK{annotations,...}) =
335 :     if !outline then
336 : leunga 744 L.LABEL(getString emitOutline b) :: getStyle annotations
337 : monnier 411 else
338 : leunga 744 L.LABEL(show_block an b) :: getStyle annotations
339 : monnier 245 in { graph = fn _ => [],
340 :     edge = edgeStyle,
341 :     node = node
342 :     }
343 :     end
344 :    
345 :     fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg
346 :    
347 :     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
348 : leunga 744 let val an = !(annotations cfg)
349 : monnier 245 fun node(n,b as BLOCK{annotations,...}) =
350 :     if #has_node subgraph n then
351 : leunga 744 L.LABEL(show_block an b) :: getStyle annotations
352 : monnier 245 else
353 : monnier 469 L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations
354 : monnier 245 fun edge(i,j,e) =
355 :     if #has_edge subgraph (i,j) then edgeStyle(i,j,e)
356 :     else [L.EDGEPATTERN "dotted"]
357 :     in L.makeLayout {graph = fn _ => [],
358 :     edge = edge,
359 :     node = node} cfg
360 :     end
361 :    
362 :     end
363 :    

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