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 624 - (view) (download)
Original Path: sml/trunk/src/MLRISC/IR/mlrisc-cfg.sml

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 : monnier 429 INFO of { regmap : C.regmap,
66 : monnier 245 annotations : Annotations.annotations ref,
67 :     firstBlock : int ref,
68 :     reorder : bool ref
69 :     }
70 :    
71 :     type cfg = (block,edge_info,info) Graph.graph
72 :    
73 : leunga 624 fun error msg = MLRiscErrorMsg.error("ControlFlowGraph",msg)
74 :    
75 : monnier 245 (*========================================================================
76 :     *
77 :     * Various kinds of annotations
78 :     *
79 :     *========================================================================*)
80 : monnier 469 (* escaping live out information *)
81 :     val LIVEOUT = Annotations.new
82 : george 545 (SOME(fn c => "Liveout: "^
83 :     (LineBreak.lineBreak 75 (C.cellsetToString 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 :    
129 : monnier 245 (*========================================================================
130 :     *
131 :     * Emit a basic block
132 :     *
133 :     *========================================================================*)
134 :     fun kindName START = "START"
135 :     | kindName STOP = "STOP"
136 :     | kindName HYPERBLOCK = "Hyperblock"
137 :     | kindName NORMAL = "Block"
138 :    
139 :     fun nl() = TextIO.output(!AsmStream.asmOutStream,"\n")
140 :    
141 : monnier 411 fun emitHeader (S.STREAM{comment,annotation,...})
142 :     (BLOCK{id,kind,freq,annotations,...}) =
143 : monnier 245 (comment(kindName kind ^"["^Int.toString id^
144 :     "] ("^W.toString (!freq)^")");
145 : monnier 411 nl();
146 :     app annotation (!annotations)
147 : monnier 245 )
148 :    
149 : monnier 411 fun emitFooter (S.STREAM{comment,...}) (BLOCK{annotations,...}) =
150 : monnier 469 (case #get LIVEOUT (!annotations) of
151 : monnier 245 SOME s =>
152 : monnier 411 let val regs = String.tokens Char.isSpace(C.cellsetToString s)
153 : monnier 245 val K = 7
154 :     fun f(_,[],s,l) = s::l
155 :     | f(0,vs,s,l) = f(K,vs," ",s::l)
156 :     | f(n,[v],s,l) = v^s::l
157 :     | f(n,v::vs,s,l) = f(n-1,vs,s^" "^v,l)
158 :     val text = rev(f(K,regs,"",[]))
159 : monnier 411 in app (fn c => (comment c; nl())) text
160 : monnier 245 end
161 :     | NONE => ()
162 :     ) handle Overflow => print("Bad footer\n")
163 :    
164 : monnier 429 fun emitStuff outline annotations regmap
165 :     (block as BLOCK{insns,data,labels,...}) =
166 :     let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
167 :     Asm.makeStream annotations
168 : monnier 411 val emit = emit (I.C.lookup regmap)
169 :     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 : monnier 411 fun new(regmap) =
187 : monnier 429 let val info = INFO{ regmap = regmap,
188 : monnier 245 annotations = ref [],
189 :     firstBlock = ref 0,
190 :     reorder = ref false
191 :     }
192 :     in cfg info end
193 :    
194 :     fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
195 : monnier 429 let val info = INFO{ regmap = #regmap graph_info,
196 : monnier 245 annotations = ref [],
197 :     firstBlock = #firstBlock graph_info,
198 :     reorder = #reorder graph_info
199 :     }
200 :     in UpdateGraphInfo.update CFG info end
201 :    
202 :     fun init(G.GRAPH cfg) =
203 : monnier 429 (case #entries cfg () of
204 :     [] =>
205 : monnier 245 let val i = #new_id cfg ()
206 : monnier 411 val start = newStart(i,ref 0)
207 : monnier 245 val _ = #add_node cfg (i,start)
208 :     val j = #new_id cfg ()
209 : monnier 411 val stop = newStop(i,ref 0)
210 : monnier 245 val _ = #add_node cfg (j,stop)
211 : monnier 411 in #add_edge cfg (i,j,EDGE{k=ENTRY,w=ref 0,a=ref []});
212 : monnier 245 #set_entries cfg [i];
213 :     #set_exits cfg [j]
214 :     end
215 : monnier 429 | _ => ()
216 :     )
217 : monnier 245
218 :     fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =
219 : leunga 624 let fun signal [] = ()
220 :     | signal(Changed(_,f)::an) = (f (); signal an)
221 :     | signal(_::an) = signal an
222 :     in signal(!annotations);
223 :     reorder := true
224 :     end
225 : monnier 245
226 : monnier 429 fun regmap(G.GRAPH{graph_info=INFO{regmap,...},...}) = regmap
227 :    
228 : leunga 624 fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a
229 : monnier 429
230 : monnier 469 fun liveOut (BLOCK{annotations, ...}) =
231 :     case #get LIVEOUT (!annotations) of
232 : monnier 245 SOME s => s
233 :     | NONE => C.empty
234 :     fun fallsThruFrom(G.GRAPH cfg,b) =
235 :     let fun f [] = NONE
236 :     | f((i,_,EDGE{k=BRANCH false,...})::_) = SOME i
237 :     | f((i,_,EDGE{k=FALLSTHRU,...})::_) = SOME i
238 :     | f(_::es) = f es
239 :     in f(#in_edges cfg b)
240 :     end
241 :     fun fallsThruTo(G.GRAPH cfg,b) =
242 :     let fun f [] = NONE
243 :     | f((_,j,EDGE{k=BRANCH false,...})::_) = SOME j
244 :     | f((_,j,EDGE{k=FALLSTHRU,...})::_) = SOME j
245 :     | f(_::es) = f es
246 :     in f(#out_edges cfg b)
247 :     end
248 :     fun removeEdge CFG (i,j,EDGE{a,...}) =
249 :     Graph.remove_edge' CFG (i,j,fn EDGE{a=a',...} => a = a')
250 :    
251 : leunga 624 fun setBranch (CFG as G.GRAPH cfg,b,cond) =
252 :     let fun loop((i,j,EDGE{k=BRANCH cond',w,a})::es,es',x,y) =
253 :     if cond' = cond then
254 :     loop(es, (i,j,EDGE{k=JUMP,w=w,a=a})::es',j,y)
255 :     else
256 :     loop(es, es', x, j)
257 :     | loop([],es',target,elim) = (es',target,elim)
258 :     | loop _ = error "setBranch"
259 :     val outEdges = #out_edges cfg b
260 :     val (outEdges',target,elim) = loop(outEdges,[],~1,~1)
261 :     val _ = if elim < 0 then error "setBranch: bad edges" else ();
262 :     val lab = defineLabel(#node_info cfg target)
263 :     val jmp = InsnProps.jump lab
264 :     val insns = insns(#node_info cfg b)
265 :     in #set_out_edges cfg (b,outEdges');
266 :     case !insns of
267 :     [] => error "setBranch: missing branch"
268 :     | branch::rest =>
269 :     case InsnProps.instrKind branch of
270 :     InsnProps.IK_JUMP => insns := jmp::rest
271 :     | _ => error "setBranch: bad branch instruction";
272 :     jmp
273 :     end
274 :    
275 : monnier 245 (*========================================================================
276 :     *
277 :     * Miscellaneous
278 :     *
279 :     *========================================================================*)
280 :     fun cdgEdge(EDGE{k, ...}) =
281 :     case k of
282 :     (JUMP | FALLSTHRU) => false
283 :     | _ => true
284 :    
285 :     (*========================================================================
286 :     *
287 :     * Pretty Printing and Viewing
288 :     *
289 :     *========================================================================*)
290 :     fun show_edge(EDGE{k,w,a,...}) =
291 :     let val kind = case k of
292 :     JUMP => ""
293 :     | FALLSTHRU => "fallsthru"
294 :     | BRANCH b => Bool.toString b
295 :     | SWITCH i => Int.toString i
296 :     | ENTRY => "entry"
297 :     | EXIT => "exit"
298 :     | SIDEEXIT i => "sideexit("^Int.toString i^")"
299 :     val weight = "(" ^ W.toString (!w) ^ ")"
300 :     in kind ^ weight
301 :     end
302 :    
303 :     fun getString f x =
304 : monnier 498 let val buffer = StringOutStream.mkStreamBuf()
305 :     val S = StringOutStream.openStringOut buffer
306 : monnier 245 val _ = AsmStream.withStream S f x
307 : monnier 498 in StringOutStream.getString buffer end
308 : monnier 245
309 : monnier 429 fun show_block an regmap block =
310 :     let val text = getString (emit an regmap) block
311 : monnier 245 in foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
312 :     (String.tokens (fn #" " => true | _ => false) text)
313 :     end
314 :    
315 : monnier 411 fun headerText block = getString
316 : monnier 429 (fn b => emitHeader (Asm.makeStream []) b) block
317 : monnier 411 fun footerText block = getString
318 : monnier 429 (fn b => emitFooter (Asm.makeStream []) b) block
319 : monnier 245
320 : monnier 469 fun getStyle a = (case #get L.STYLE (!a) of SOME l => l | NONE => [])
321 :    
322 : leunga 624 val green = L.COLOR "green"
323 :     val red = L.COLOR "red"
324 :     val yellow = L.COLOR "yellow"
325 :    
326 : monnier 245 fun edgeStyle(i,j,e as EDGE{k,a,...}) =
327 : monnier 469 let val a = L.LABEL(show_edge e) :: getStyle a
328 : monnier 245 in case k of
329 : leunga 624 (ENTRY | EXIT) => green :: a
330 :     | (FALLSTHRU | BRANCH false) => yellow :: a
331 :     | _ => red :: a
332 : monnier 245 end
333 :    
334 : monnier 429 val outline = MLRiscControl.getFlag "view-outline"
335 : monnier 411
336 : monnier 245 fun viewStyle cfg =
337 :     let val regmap = regmap cfg
338 : leunga 624 val an = !(annotations cfg)
339 : monnier 411 fun node (n,b as BLOCK{annotations,...}) =
340 :     if !outline then
341 : monnier 469 L.LABEL(getString (emitOutline regmap) b) :: getStyle annotations
342 : monnier 411 else
343 : monnier 469 L.LABEL(show_block an regmap b) :: getStyle annotations
344 : monnier 245 in { graph = fn _ => [],
345 :     edge = edgeStyle,
346 :     node = node
347 :     }
348 :     end
349 :    
350 :     fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg
351 :    
352 :     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
353 :     let val regmap = regmap cfg
354 : leunga 624 val an = !(annotations cfg)
355 : monnier 245 fun node(n,b as BLOCK{annotations,...}) =
356 :     if #has_node subgraph n then
357 : monnier 469 L.LABEL(show_block an regmap b) :: getStyle annotations
358 : monnier 245 else
359 : monnier 469 L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations
360 : monnier 245 fun edge(i,j,e) =
361 :     if #has_edge subgraph (i,j) then edgeStyle(i,j,e)
362 :     else [L.EDGEPATTERN "dotted"]
363 :     in L.makeLayout {graph = fn _ => [],
364 :     edge = edge,
365 :     node = node} cfg
366 :     end
367 :    
368 :     end
369 :    

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