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

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

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