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 959 - (view) (download)

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

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