Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/IR/mlrisc-cfg.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 744 - (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 :    
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 : leunga 744 let val regs = String.tokens Char.isSpace(C.CellSet.toString 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 : leunga 744 fun emitStuff outline annotations
165 : monnier 429 (block as BLOCK{insns,data,labels,...}) =
166 :     let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
167 :     Asm.makeStream annotations
168 : monnier 411 in emitHeader S block;
169 :     app (fn PSEUDO p => pseudoOp p
170 :     | LABEL l => defineLabel l) (!data);
171 :     app defineLabel (!labels);
172 :     if outline then () else app emit (rev (!insns));
173 :     emitFooter S block
174 :     end
175 :    
176 : monnier 429 val emit = emitStuff false
177 :     val emitOutline = emitStuff true []
178 : monnier 245
179 :     (*========================================================================
180 :     *
181 :     * Methods for manipulating CFG
182 :     *
183 :     *========================================================================*)
184 :     fun cfg info = GraphImpl.graph("CFG",info,10)
185 : leunga 744 fun new() =
186 :     let val info = INFO{ annotations = ref [],
187 : monnier 245 firstBlock = ref 0,
188 :     reorder = ref false
189 :     }
190 :     in cfg info end
191 :    
192 :     fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
193 : leunga 744 let val info = INFO{ annotations = ref [],
194 : monnier 245 firstBlock = #firstBlock graph_info,
195 :     reorder = #reorder graph_info
196 :     }
197 :     in UpdateGraphInfo.update CFG info end
198 :    
199 :     fun init(G.GRAPH cfg) =
200 : monnier 429 (case #entries cfg () of
201 :     [] =>
202 : monnier 245 let val i = #new_id cfg ()
203 : monnier 411 val start = newStart(i,ref 0)
204 : monnier 245 val _ = #add_node cfg (i,start)
205 :     val j = #new_id cfg ()
206 : monnier 411 val stop = newStop(i,ref 0)
207 : monnier 245 val _ = #add_node cfg (j,stop)
208 : monnier 411 in #add_edge cfg (i,j,EDGE{k=ENTRY,w=ref 0,a=ref []});
209 : monnier 245 #set_entries cfg [i];
210 :     #set_exits cfg [j]
211 :     end
212 : monnier 429 | _ => ()
213 :     )
214 : monnier 245
215 :     fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =
216 : leunga 624 let fun signal [] = ()
217 :     | signal(Changed(_,f)::an) = (f (); signal an)
218 :     | signal(_::an) = signal an
219 :     in signal(!annotations);
220 :     reorder := true
221 :     end
222 : monnier 245
223 : leunga 624 fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a
224 : monnier 429
225 : monnier 469 fun liveOut (BLOCK{annotations, ...}) =
226 :     case #get LIVEOUT (!annotations) of
227 : monnier 245 SOME s => s
228 :     | NONE => C.empty
229 :     fun fallsThruFrom(G.GRAPH cfg,b) =
230 :     let fun f [] = NONE
231 :     | f((i,_,EDGE{k=BRANCH false,...})::_) = SOME i
232 :     | f((i,_,EDGE{k=FALLSTHRU,...})::_) = SOME i
233 :     | f(_::es) = f es
234 :     in f(#in_edges cfg b)
235 :     end
236 :     fun fallsThruTo(G.GRAPH cfg,b) =
237 :     let fun f [] = NONE
238 :     | f((_,j,EDGE{k=BRANCH false,...})::_) = SOME j
239 :     | f((_,j,EDGE{k=FALLSTHRU,...})::_) = SOME j
240 :     | f(_::es) = f es
241 :     in f(#out_edges cfg b)
242 :     end
243 :     fun removeEdge CFG (i,j,EDGE{a,...}) =
244 :     Graph.remove_edge' CFG (i,j,fn EDGE{a=a',...} => a = a')
245 :    
246 : leunga 624 fun setBranch (CFG as G.GRAPH cfg,b,cond) =
247 :     let fun loop((i,j,EDGE{k=BRANCH cond',w,a})::es,es',x,y) =
248 :     if cond' = cond then
249 :     loop(es, (i,j,EDGE{k=JUMP,w=w,a=a})::es',j,y)
250 :     else
251 :     loop(es, es', x, j)
252 :     | loop([],es',target,elim) = (es',target,elim)
253 :     | loop _ = error "setBranch"
254 :     val outEdges = #out_edges cfg b
255 :     val (outEdges',target,elim) = loop(outEdges,[],~1,~1)
256 :     val _ = if elim < 0 then error "setBranch: bad edges" else ();
257 :     val lab = defineLabel(#node_info cfg target)
258 :     val jmp = InsnProps.jump lab
259 :     val insns = insns(#node_info cfg b)
260 :     in #set_out_edges cfg (b,outEdges');
261 :     case !insns of
262 :     [] => error "setBranch: missing branch"
263 :     | branch::rest =>
264 :     case InsnProps.instrKind branch of
265 :     InsnProps.IK_JUMP => insns := jmp::rest
266 :     | _ => error "setBranch: bad branch instruction";
267 :     jmp
268 :     end
269 :    
270 : monnier 245 (*========================================================================
271 :     *
272 :     * Miscellaneous
273 :     *
274 :     *========================================================================*)
275 :     fun cdgEdge(EDGE{k, ...}) =
276 :     case k of
277 :     (JUMP | FALLSTHRU) => false
278 :     | _ => true
279 :    
280 :     (*========================================================================
281 :     *
282 :     * Pretty Printing and Viewing
283 :     *
284 :     *========================================================================*)
285 :     fun show_edge(EDGE{k,w,a,...}) =
286 :     let val kind = case k of
287 :     JUMP => ""
288 :     | FALLSTHRU => "fallsthru"
289 :     | BRANCH b => Bool.toString b
290 :     | SWITCH i => Int.toString i
291 :     | ENTRY => "entry"
292 :     | EXIT => "exit"
293 :     | SIDEEXIT i => "sideexit("^Int.toString i^")"
294 :     val weight = "(" ^ W.toString (!w) ^ ")"
295 :     in kind ^ weight
296 :     end
297 :    
298 :     fun getString f x =
299 : monnier 498 let val buffer = StringOutStream.mkStreamBuf()
300 :     val S = StringOutStream.openStringOut buffer
301 : monnier 245 val _ = AsmStream.withStream S f x
302 : monnier 498 in StringOutStream.getString buffer end
303 : monnier 245
304 : leunga 744 fun show_block an block =
305 :     let val text = getString (emit an) block
306 : monnier 245 in foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
307 :     (String.tokens (fn #" " => true | _ => false) text)
308 :     end
309 :    
310 : monnier 411 fun headerText block = getString
311 : monnier 429 (fn b => emitHeader (Asm.makeStream []) b) block
312 : monnier 411 fun footerText block = getString
313 : monnier 429 (fn b => emitFooter (Asm.makeStream []) b) block
314 : monnier 245
315 : monnier 469 fun getStyle a = (case #get L.STYLE (!a) of SOME l => l | NONE => [])
316 :    
317 : leunga 624 val green = L.COLOR "green"
318 :     val red = L.COLOR "red"
319 :     val yellow = L.COLOR "yellow"
320 :    
321 : monnier 245 fun edgeStyle(i,j,e as EDGE{k,a,...}) =
322 : monnier 469 let val a = L.LABEL(show_edge e) :: getStyle a
323 : monnier 245 in case k of
324 : leunga 624 (ENTRY | EXIT) => green :: a
325 :     | (FALLSTHRU | BRANCH false) => yellow :: a
326 :     | _ => red :: a
327 : monnier 245 end
328 :    
329 : monnier 429 val outline = MLRiscControl.getFlag "view-outline"
330 : monnier 411
331 : monnier 245 fun viewStyle cfg =
332 : leunga 744 let val an = !(annotations cfg)
333 : monnier 411 fun node (n,b as BLOCK{annotations,...}) =
334 :     if !outline then
335 : leunga 744 L.LABEL(getString emitOutline b) :: getStyle annotations
336 : monnier 411 else
337 : leunga 744 L.LABEL(show_block an b) :: getStyle annotations
338 : monnier 245 in { graph = fn _ => [],
339 :     edge = edgeStyle,
340 :     node = node
341 :     }
342 :     end
343 :    
344 :     fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg
345 :    
346 :     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
347 : leunga 744 let val an = !(annotations cfg)
348 : monnier 245 fun node(n,b as BLOCK{annotations,...}) =
349 :     if #has_node subgraph n then
350 : leunga 744 L.LABEL(show_block an b) :: getStyle annotations
351 : monnier 245 else
352 : monnier 469 L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations
353 : monnier 245 fun edge(i,j,e) =
354 :     if #has_edge subgraph (i,j) then edgeStyle(i,j,e)
355 :     else [L.EDGEPATTERN "dotted"]
356 :     in L.makeLayout {graph = fn _ => [],
357 :     edge = edge,
358 :     node = node} cfg
359 :     end
360 :    
361 :     end
362 :    

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