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 906 - (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 :     structure Asm : INSTRUCTION_EMITTER
12 :     sharing I.T.PseudoOp = Asm.P = PseudoOps
13 :     sharing InsnProps.I = Asm.I = I
14 :     ) : CONTROL_FLOW_GRAPH =
15 :     struct
16 :    
17 :     structure I = I
18 :     structure P = PseudoOps
19 :     structure C = I.C
20 :     structure W = Freq
21 :     structure G = Graph
22 :     (*****
23 :     structure L = GraphLayout
24 :     *****)
25 :     structure A = Annotations
26 :     structure S = Asm.S
27 :    
28 :     type weight = W.freq
29 :    
30 :     datatype block_kind =
31 :     START (* entry node *)
32 :     | STOP (* exit node *)
33 :     | NORMAL (* normal node *)
34 :     | HYPERBLOCK (* hyperblock *)
35 :    
36 :     and data = LABEL of Label.label
37 :     | PSEUDO of P.pseudo_op
38 :    
39 :     and block =
40 :     BLOCK of
41 :     { id : int, (* block id *)
42 :     kind : block_kind, (* block kind *)
43 :     freq : weight ref, (* execution frequency *)
44 :     data : data list ref, (* data preceeding block *)
45 :     labels : Label.label list ref, (* labels on blocks *)
46 :     insns : I.instruction list ref, (* in rev order *)
47 :     annotations : Annotations.annotations ref (* annotations *)
48 :     }
49 :    
50 :     and edge_kind = ENTRY (* entry edge *)
51 :     | EXIT (* exit edge *)
52 :     | JUMP (* unconditional jump *)
53 :     | FALLSTHRU (* falls through to next block *)
54 :     | BRANCH of bool (* branch *)
55 :     | SWITCH of int (* computed goto *)
56 :     | SIDEEXIT of int (* side exit *)
57 :    
58 :     and edge_info = EDGE of { k : edge_kind, (* edge kind *)
59 :     w : weight ref, (* edge freq *)
60 :     a : Annotations.annotations ref (* annotations *)
61 :     }
62 :    
63 :     type edge = edge_info Graph.edge
64 :     type node = block Graph.node
65 :    
66 :     datatype info =
67 :     INFO of { annotations : Annotations.annotations ref,
68 :     firstBlock : int ref,
69 :     reorder : bool ref
70 :     }
71 :    
72 :     type cfg = (block,edge_info,info) Graph.graph
73 :    
74 :     fun error msg = MLRiscErrorMsg.error("ControlFlowGraph",msg)
75 :    
76 :     (*========================================================================
77 :     *
78 :     * Various kinds of annotations
79 :     *
80 :     *========================================================================*)
81 :     (* escaping live out information *)
82 :     val LIVEOUT = Annotations.new
83 :     (SOME(fn c => "Liveout: "^
84 :     (LineBreak.lineBreak 75
85 :     (CellsBasis.CellSet.toString c))))
86 :     exception Changed of string * (unit -> unit)
87 :     val CHANGED = Annotations.new'
88 :     {create=Changed,
89 :     get=fn Changed x => x | e => raise e,
90 :     toString=fn (name,_) => "CHANGED:"^name
91 :     }
92 :    
93 :     (*========================================================================
94 :     *
95 :     * Methods for manipulating basic blocks
96 :     *
97 :     *========================================================================*)
98 :     fun defineLabel(BLOCK{labels=ref(l::_),...}) = l
99 :     | defineLabel(BLOCK{labels, data, ...}) = let
100 :     val l = Label.anon ()
101 :     in
102 :     labels := [l];
103 :     data := !data @ [LABEL l]; (* JHR *)
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 :     (* app defineLabel (!labels); *) (* JHR *)
180 :     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