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/releases/release-110.62/SSA/ssa.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.62/SSA/ssa.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2308 - (view) (download)

1 : leunga 695 (*---------------------------------------------------------------------------
2 :     * Machine SSA representation.
3 :     *
4 :     * -- Allen (leunga@cs.nyu.edu)
5 :     *---------------------------------------------------------------------------*)
6 :     functor SSA
7 :     (structure SSAProps : SSA_PROPERTIES
8 :     structure InsnProps : INSN_PROPERTIES
9 :     structure FormatInsn : FORMAT_INSTRUCTION
10 :     structure MLTreeComp : MLTREECOMP
11 :     structure CFG : SSA_FLOWGRAPH
12 :     structure DJ : DJ_GRAPH
13 :     structure GCMap : GC_MAP
14 :     sharing SSAProps.I = InsnProps.I = CFG.I = FormatInsn.I = MLTreeComp.I
15 : leunga 744 sharing MLTreeComp.T = SSAProps.RTL.T
16 : leunga 695 ) : SSA =
17 :     struct
18 :     structure CFG = CFG
19 :     structure Dom = DJ.Dom
20 :     structure DJ = DJ
21 :     structure SP = SSAProps
22 :     structure GCMap = GCMap
23 :     structure MLTreeComp = MLTreeComp
24 :     structure W = CFG.W
25 :     structure I = SP.I
26 :     structure C = I.C
27 :     structure RTL = SP.RTL
28 :     structure T = RTL.T
29 :     structure OT = SP.OT
30 :     structure G = Graph
31 :     structure A = Array
32 :     structure W8A = Word8Array
33 :     structure DA = DynArray
34 :     structure HA = HashArray
35 :     structure L = GraphLayout
36 :     structure SL = SortedList
37 :    
38 :     fun error msg = MLRiscErrorMsg.error("SSA",msg)
39 :    
40 :     (*------------------------------------------------------------------------
41 :     * Flags
42 :     *------------------------------------------------------------------------*)
43 :     val showAsm = MLRiscControl.getFlag "ssa-show-asm"
44 :     val showPos = MLRiscControl.getFlag "ssa-show-pos"
45 :     val debug = MLRiscControl.getFlag "ssa-debug"
46 :     val listLimit = MLRiscControl.getInt "ssa-list-limit"
47 :     val _ = listLimit := 5
48 :    
49 :     (*------------------------------------------------------------------------
50 :     * Counters (for statistics)
51 :     *------------------------------------------------------------------------*)
52 :     val replacements = MLRiscControl.getCounter "ssa-replacements"
53 :     val constantsFolded = MLRiscControl.getCounter "ssa-constants-folded"
54 :     val branchesFolded = MLRiscControl.getCounter "ssa-branches-folded"
55 :     val moved = MLRiscControl.getCounter "ssa-instructions-moved"
56 :    
57 :     (*------------------------------------------------------------------------
58 :     * Basic type definitions used in the SSA form
59 :     *------------------------------------------------------------------------*)
60 :     type value = int (* value id *)
61 :     type pos = int (* position within a block *)
62 :     type block = Graph.node_id (* block id *)
63 :     type ssa_id = Graph.node_id (* ssa id *)
64 : leunga 744 type rtl = RTL.rtl (* RTL *)
65 :     type const = OT.const (* constants *)
66 : leunga 695 type cfg = CFG.cfg (* control flow graph *)
67 :     type dom = (CFG.block,CFG.edge_info,CFG.info) Dom.dominator_tree
68 : leunga 744 type nameTbl = {oldName:C.cell, index:int} IntHashTable.hash_table
69 : leunga 695
70 :     (*------------------------------------------------------------------------
71 :     * An SSA op is an instruction
72 :     *------------------------------------------------------------------------*)
73 :     type ssa_op = I.instruction
74 :    
75 :     (*------------------------------------------------------------------------
76 :     * Information about the SSA graph
77 :     *------------------------------------------------------------------------*)
78 :     datatype ssa_info =
79 :     INFO of
80 :     {cfg : cfg,
81 :     dom : cfg -> dom,
82 :     defSiteTbl : ssa_id DA.array,
83 :     blockTbl : block DA.array,
84 :     posTbl : pos DA.array,
85 :     rtlTbl : rtl DA.array,
86 :     usesTbl : value list DA.array,
87 :     defsTbl : value list DA.array,
88 :     succTbl : value Graph.edge list DA.array,
89 :     ssaOpTbl : ssa_op DA.array,
90 : leunga 744 cellKindTbl : C.cellkind IntHashTable.hash_table,
91 : leunga 695 operandTbl : OT.operandTable,
92 :     nameTbl : nameTbl option,
93 :     gcmap : GCMap.gcmap option,
94 :     nextImmed : int ref,
95 :     edgeCount : int ref,
96 :     nodeCount : int ref,
97 :     garbageNodes : ssa_id list ref,
98 :     hasDefUseChains : bool ref,
99 :     nodes : { sources: ssa_id list A.array,
100 :     phis: ssa_id list A.array,
101 :     ops: ssa_id list A.array,
102 :     sinks: ssa_id list A.array
103 :     } option ref,
104 :     maxPos : int ref,
105 :     minPos : int ref,
106 :     freqTbl : W.freq A.array option ref
107 :     }
108 :    
109 :     type ssa = (ssa_op,value,ssa_info) Graph.graph
110 :    
111 :     exception NoDefSite
112 :     exception NoCellKind
113 :    
114 :     val i2s = Int.toString
115 :    
116 :     (*------------------------------------------------------------------
117 :     * Hacks to deal with zero registers in the architecture
118 :     *------------------------------------------------------------------*)
119 :     val R = C.firstPseudo
120 :     val zeroRegs = W8A.array(R, 0w0)
121 :     val _ = app (fn k =>
122 :     case C.zeroReg k of
123 :     NONE => ()
124 :     | SOME r => W8A.update(zeroRegs, r, 0w1))
125 :     C.cellkinds
126 :    
127 :     (*------------------------------------------------------------------
128 :     * Deal with pinned resources
129 :     *------------------------------------------------------------------*)
130 :     val pinnedUseTbl = W8A.array(R,0w0)
131 :     val pinnedDefTbl = W8A.array(R,0w0)
132 :     val _ = app (fn r => W8A.update(pinnedUseTbl,r,0w1)) SP.pinnedUse
133 :     val _ = app (fn r => W8A.update(pinnedDefTbl,r,0w1)) SP.pinnedDef
134 :    
135 :     (*------------------------------------------------------------------------
136 :     * How to create a new SSA graph
137 :     *------------------------------------------------------------------------*)
138 :     fun newSSA{cfg, dom, gcmap, nameTbl} =
139 :     let val nextImmed = ref ~1
140 :     val defSiteTbl = DA.array(13, ~1)
141 :     val blockTbl = DA.array(13, ~1)
142 :     val posTbl = DA.array(13, ~1)
143 : leunga 744 val rtlTbl = DA.array(13, T.SEQ [])
144 : leunga 695 val usesTbl = DA.array(13, [])
145 :     val defsTbl = DA.array(13, [])
146 :     val succTbl = DA.array(13, [])
147 :     val ssaOpTbl = DA.array(13, InsnProps.nop())
148 : leunga 744 val cellKindTbl = IntHashTable.mkTable(13, NoCellKind)
149 : leunga 695 val operandTbl = OT.create nextImmed
150 :     val nodeCount = ref 0
151 :     val edgeCount = ref 0
152 :     val garbageNodes = ref []
153 :     val hasDefUseChains = ref false
154 :     val info =
155 :     INFO{ cfg = cfg,
156 :     dom = dom,
157 :     defSiteTbl = defSiteTbl,
158 :     blockTbl = blockTbl,
159 :     posTbl = posTbl,
160 :     rtlTbl = rtlTbl,
161 :     usesTbl = usesTbl,
162 :     defsTbl = defsTbl,
163 :     succTbl = succTbl,
164 :     ssaOpTbl = ssaOpTbl,
165 :     cellKindTbl = cellKindTbl,
166 : leunga 744 operandTbl = operandTbl,
167 : leunga 695 nameTbl = nameTbl,
168 :     gcmap = gcmap,
169 :     nextImmed = nextImmed,
170 :     edgeCount = edgeCount,
171 :     nodeCount = nodeCount,
172 :     garbageNodes = garbageNodes,
173 :     hasDefUseChains = hasDefUseChains,
174 :     nodes = ref NONE,
175 :     maxPos = ref 0,
176 :     minPos = ref 0,
177 :     freqTbl = ref NONE
178 :     }
179 :     (*--------------------------------------------------------------------
180 :     * Graph methods
181 :     *--------------------------------------------------------------------*)
182 :     fun nop _ = ()
183 :     fun unimplemented title = error("unimplemented: "^title)
184 :     val entries = ref []
185 :     val exits = ref []
186 :     val newNodes = ref []
187 :     fun order() = !nodeCount
188 :     fun size() = !edgeCount
189 :     fun capacity() = DA.length ssaOpTbl
190 :     fun new_id() =
191 :     case !newNodes of
192 :     [] => DA.length ssaOpTbl
193 :     | h::t => (newNodes := t; h)
194 :     fun garbage_collect () =
195 :     (newNodes := (!newNodes) @ (!garbageNodes); garbageNodes := [])
196 :     fun add_edge(e as (i,j,r)) =
197 :     (edgeCount := !edgeCount + 1;
198 :     DA.update(succTbl, i, (i,j,r)::DA.sub(succTbl, i))
199 :     )
200 :     fun set_out_edges(n,es) = unimplemented "set_out_edges"
201 :     fun set_in_edges(n,es) = unimplemented "set_in_edges"
202 :     fun add_node n = unimplemented "add_node"
203 :    
204 :     (* Invariant: all uses of these nodes must have already been removed! *)
205 :     and remove_node n =
206 :     if DA.sub(blockTbl, n) < 0 then () (* already removed *)
207 :     else let fun removeUses([], c) = c
208 :     | removeUses(v::vs, c) =
209 :     if v < 0 then removeUses(vs, c)
210 :     else
211 :     let val i = DA.sub(defSiteTbl, v)
212 :     in if i = n then removeUses(vs, c)
213 :     else
214 :     let fun filterEdges([], es', c) = (es', c)
215 :     | filterEdges((e as (i,j,_))::es, es', c) =
216 :     if j = n then filterEdges(es, es', c-1)
217 :     else filterEdges(es, e::es', c)
218 :     val es = DA.sub(succTbl, i)
219 :     val (es, c) = filterEdges(es, [], c)
220 :     in DA.update(succTbl, i, es);
221 :     removeUses(vs, c)
222 :     end
223 :     end
224 :     val uses = DA.sub(usesTbl, n)
225 :     val size = removeUses(uses, !edgeCount)
226 :     in edgeCount := size - length (DA.sub(succTbl, n));
227 :     nodeCount := !nodeCount - 1;
228 :     garbageNodes := n :: !garbageNodes;
229 :     DA.update(blockTbl, n, ~1);
230 :     DA.update(usesTbl, n, []);
231 :     DA.update(defsTbl, n, []);
232 :     DA.update(succTbl, n, [])
233 :     end
234 :    
235 :     fun set_entries ns = entries := ns
236 :     fun set_exits ns = exits := ns
237 :     fun get_entries() = !entries
238 :     fun get_exits() = !exits
239 :     fun get_succ n = map #2 (DA.sub(succTbl, n))
240 :     fun get_pred n =
241 :     let val defSite = DA.baseArray defSiteTbl
242 :     fun collect([], preds) = preds
243 :     | collect(v::vs, preds) =
244 :     if v < 0 then collect(vs, preds)
245 :     else let val n = A.sub(defSite, v)
246 :     in collect(vs, n::preds) end
247 :     in collect(DA.sub(usesTbl,n), []) end
248 :     fun get_nodes() =
249 :     let val block = DA.baseArray blockTbl
250 :     val ssaOps = DA.baseArray ssaOpTbl
251 :     val n = DA.length blockTbl
252 :     fun collect(i, nodes) =
253 :     if i >= 0 then
254 :     collect(i-1,
255 :     if A.sub(block, i) >= 0 then
256 :     (i,A.sub(ssaOps,i))::nodes else nodes)
257 :     else nodes
258 :     in collect(n-1, []) end
259 :    
260 :     fun get_edges() =
261 :     let val succ = DA.baseArray succTbl
262 :     val n = DA.length succTbl
263 :     fun collect(i, edges) =
264 :     if i >= 0 then
265 :     collect(i-1, List.revAppend(A.sub(succ, i), edges))
266 :     else edges
267 :     in collect(n-1, []) end
268 :    
269 :     fun out_edges n = DA.sub(succTbl, n)
270 :     fun in_edges n =
271 :     let val defSite = DA.baseArray defSiteTbl
272 :     fun collect([], edges) = edges
273 :     | collect(v::vs, edges) =
274 :     if v < 0 then collect(vs, edges)
275 :     else let val n' = A.sub(defSite, v)
276 :     in collect(vs, (n',n,v)::edges) end
277 :     in collect(DA.sub(usesTbl,n), []) end
278 :     fun has_edge(i,j) = List.exists(fn (_,k,_) => j = k) (DA.sub(succTbl, i))
279 :     fun has_node n = DA.sub(blockTbl,n) >= 0
280 :     fun node_info n = DA.sub(ssaOpTbl, n)
281 :    
282 :     fun forall_nodes f =
283 :     let val block = DA.baseArray blockTbl
284 :     val ssaOps = DA.baseArray ssaOpTbl
285 :     val n = A.length block
286 :     fun app i =
287 :     if i >= n then () else
288 :     (if A.sub(block, i) >= 0 then f(i, A.sub(ssaOps,i)) else ();
289 :     app(i+1))
290 :     in app 0 end
291 :    
292 :     fun forall_edges f =
293 :     let val succ = DA.baseArray succTbl
294 :     val n = A.length succ
295 :     fun loop i = if i >= n then () else (iter(A.sub(succ, i)); loop(i+1))
296 :     and iter [] = ()
297 :     | iter (e::es) = (f e; iter es)
298 :     in loop 0 end
299 :    
300 :     in G.GRAPH
301 :     {name = "SSA",
302 :     graph_info = info,
303 :     new_id = new_id,
304 :     add_node = add_node,
305 :     add_edge = add_edge,
306 :     remove_node = remove_node,
307 :     set_in_edges = set_in_edges,
308 :     set_out_edges = set_out_edges,
309 :     set_entries = set_entries,
310 :     set_exits = set_exits,
311 :     garbage_collect = garbage_collect,
312 :     nodes = get_nodes,
313 :     edges = get_edges,
314 :     order = order,
315 :     size = size,
316 :     capacity = capacity,
317 :     out_edges = out_edges,
318 :     in_edges = in_edges,
319 :     succ = get_succ,
320 :     pred = get_pred,
321 :     has_edge = has_edge,
322 :     has_node = has_node,
323 :     node_info = node_info,
324 :     entries = get_entries,
325 :     exits = get_exits,
326 :     entry_edges = fn _ => [],
327 :     exit_edges = fn _ => [],
328 :     forall_nodes = forall_nodes,
329 :     forall_edges = forall_edges
330 :     }
331 :     end
332 :    
333 :     (*------------------------------------------------------------------------
334 :     * Extract info from the SSA graph
335 :     *------------------------------------------------------------------------*)
336 :     fun info(G.GRAPH ssa) = let val INFO info = #graph_info ssa in info end
337 :     fun dom SSA =
338 :     let val {cfg, dom, ...} = info SSA (* extracts the dominator *)
339 :     in dom cfg end
340 :     fun cfg SSA = #cfg(info SSA) (* extracts the CFG *)
341 : leunga 744 fun immed SSA = OT.int(#operandTbl(info SSA)) (* create a new operand *)
342 : leunga 695 (*fun label SSA = OT.label(#operandTbl(info SSA))*) (* create a new label *)
343 :     fun const SSA = OT.const(#operandTbl(info SSA)) (* lookup const values *)
344 :     fun operand SSA = OT.operand(#operandTbl(info SSA))
345 :    
346 :     fun maxVar SSA = C.maxCell() (* maximum number of ssa names *)
347 :     fun numberOfOperands SSA = (* number of operands *)
348 :     let val {nextImmed, ...} = info SSA
349 :     in ~(!nextImmed) - 1 end
350 :    
351 :     (*------------------------------------------------------------------------
352 :     * Reserve n nodes of storage in all the dynamic tables.
353 :     *------------------------------------------------------------------------*)
354 :     fun reserve SSA n =
355 :     let val {defsTbl, usesTbl, ssaOpTbl, rtlTbl,
356 :     blockTbl, posTbl, succTbl, ...} = info SSA
357 :     in (* if !debug then
358 :     print("[SSA: reserving "^i2s n^" nodes]\n")
359 :     else (); *)
360 :     DA.expandTo(defsTbl, n);
361 :     DA.expandTo(usesTbl, n);
362 :     DA.expandTo(ssaOpTbl, n);
363 :     DA.expandTo(rtlTbl, n);
364 :     DA.expandTo(blockTbl, n);
365 :     DA.expandTo(posTbl, n);
366 :     DA.expandTo(succTbl, n)
367 :     end
368 :    
369 :     (*------------------------------------------------------------------------
370 :     * Extract the raw tables.
371 :     * These should only be used when the optimization guarantees that
372 :     * no new ssa ops are added to the graph, since that may involve resizing
373 :     * these tables, rendering them obsolete.
374 :     *------------------------------------------------------------------------*)
375 :     fun defSiteTbl SSA = DA.baseArray(#defSiteTbl(info SSA))
376 :     fun blockTbl SSA = DA.baseArray(#blockTbl(info SSA))
377 :     fun posTbl SSA = DA.baseArray(#posTbl(info SSA))
378 :     fun rtlTbl SSA = DA.baseArray(#rtlTbl(info SSA))
379 :     fun usesTbl SSA = DA.baseArray(#usesTbl(info SSA))
380 :     fun defsTbl SSA = DA.baseArray(#defsTbl(info SSA))
381 :     fun succTbl SSA = DA.baseArray(#succTbl(info SSA))
382 :     fun ssaOpTbl SSA = DA.baseArray(#ssaOpTbl(info SSA))
383 :     fun cellKindTbl SSA = #cellKindTbl(info SSA)
384 :     fun operandTbl SSA = #operandTbl(info SSA)
385 :     fun maxPos SSA = #maxPos(info SSA)
386 :     fun minPos SSA = #minPos(info SSA)
387 :    
388 :     (*------------------------------------------------------------------------
389 :     * Lookup information (the safe way)
390 :     *------------------------------------------------------------------------*)
391 :     fun defSite G = let val t = #defSiteTbl(info G) in fn v => DA.sub(t, v) end
392 :     fun block G = let val t = #blockTbl(info G) in fn n => DA.sub(t, n) end
393 :     fun rtl G = let val t = #rtlTbl(info G) in fn n => DA.sub(t, n) end
394 :     fun uses G = let val t = #usesTbl(info G) in fn n => DA.sub(t, n) end
395 :     fun defs G = let val t = #defsTbl(info G) in fn n => DA.sub(t, n) end
396 :     fun freqTbl G =
397 :     case #freqTbl(info G) of
398 :     ref(SOME t) => t
399 :     | t as ref NONE =>
400 :     let val G.GRAPH cfg = cfg G
401 :     val N = #capacity cfg ()
402 :     val freqTbl = A.array(N, 0)
403 :     in #forall_nodes cfg (fn (n,n') =>
404 :     A.update(freqTbl, n, !(CFG.freq n')));
405 :     t := SOME freqTbl;
406 :     freqTbl
407 :     end
408 :    
409 :     (*------------------------------------------------------------------------
410 :     * Pretty printing a value
411 :     *------------------------------------------------------------------------*)
412 :     fun prInt i = if i < 0 then "-"^i2s(~i) else i2s i
413 : leunga 744 fun prIntInf i = if IntInf.sign i < 0 then
414 :     "-"^IntInf.toString(IntInf.~ i)
415 :     else IntInf.toString i
416 : leunga 695 fun showVal SSA =
417 :     let val {nameTbl, cellKindTbl, gcmap, ...} = info SSA
418 :     val const = const SSA
419 : leunga 744 val cellKind = IntHashTable.find cellKindTbl
420 :     val cellKind = fn r => case cellKind r of SOME k => k | NONE => C.GP
421 : leunga 695
422 :     (* Display gc type if a gc map is present *)
423 :     val showGC =
424 :     case gcmap of
425 :     NONE => (fn r => "")
426 :     | SOME gcmap =>
427 : leunga 744 let val look = IntHashTable.lookup gcmap
428 : leunga 695 in fn r => ":"^GCMap.GC.toString(look r) handle _ => ":?" end
429 :    
430 :     (* Display fancy name if a name table is present *)
431 :     val translate =
432 :     case nameTbl of
433 :     NONE => (fn (k,v) => C.toString k v)
434 :     | SOME tbl =>
435 : leunga 744 let val look = IntHashTable.lookup tbl
436 : leunga 695 in fn (k,v) =>
437 :     let val {oldName,index} = look v
438 :     in C.toString k oldName^"."^i2s index end
439 :     handle _ => (C.toString k v)
440 :     end
441 :    
442 :     (* Lookup name *)
443 :     fun lookupName v =
444 :     let val k = cellKind v
445 :     val gcTy = if k = C.MEM orelse k = C.CTRL then "" else showGC v
446 :     in translate(k,v) ^ gcTy end
447 :    
448 :     (* Show a value *)
449 :     fun show v =
450 :     if v >= 0 then lookupName v
451 :     else (case const v of
452 : leunga 744 SP.OT.INT i => prInt i
453 :     | SP.OT.INTINF i => prIntInf i
454 : leunga 695 | SP.OT.OPERAND opnd => "v"^i2s(~v)
455 :     (*| SP.OT.LABEL l => Label.nameOf l*)
456 :     ) handle SP.OT.NoConst => "?"^i2s(~v)
457 :     in show end
458 :    
459 :     (*------------------------------------------------------------------------
460 :     * Pretty printing an ssa op
461 :     *------------------------------------------------------------------------*)
462 :     fun showOp SSA =
463 :     let val {usesTbl, defsTbl, ssaOpTbl, rtlTbl, succTbl,
464 :     blockTbl, posTbl, cellKindTbl, ...} = info SSA
465 :     val K = !listLimit
466 :     val showVal = showVal SSA
467 :     val cfg = cfg SSA
468 :     val regmap = CFG.regmap cfg
469 :     val asm = FormatInsn.toString (!(CFG.annotations cfg))
470 :     (C.lookup regmap)
471 :     fun block b = "b"^i2s b
472 :     fun blockOf ssa_id = block(DA.sub(blockTbl,ssa_id))
473 : leunga 744 val cellKindOf = IntHashTable.find cellKindTbl
474 :     val cellKindOf =
475 :     fn r => case cellKindOf r of SOME k => k | NONE => C.GP
476 : leunga 695
477 :     fun listify(vs, rs) =
478 :     let fun h r = C.toString (cellKindOf r) r
479 :     fun g(v,r) = showVal v^"="^h r
480 :     fun f(_,[],[]) = ""
481 :     | f(0,vs,rs) = "\n "^f(K,vs,rs)
482 :     | f(n,[v],[r]) = g(v,r)
483 :     | f(n,v::vs,r::rs) = g(v,r)^","^f(n-1,vs,rs)
484 :     | f _ = error "showOp.listify"
485 :     in f(K,vs,rs) end
486 :    
487 :     fun listify2([b],[v]) = "["^block b^"]"^showVal v
488 :     | listify2(b::bs,v::vs) = "["^block b^"]"^showVal v^","^listify2(bs,vs)
489 :     | listify2 _ = ""
490 :    
491 :     fun show ssa_id =
492 :     let val ssa_op = DA.sub(ssaOpTbl, ssa_id)
493 :     val defs = DA.sub(defsTbl,ssa_id)
494 :     val uses = DA.sub(usesTbl,ssa_id)
495 :     val rtl = DA.sub(rtlTbl,ssa_id)
496 :     in case rtl of
497 :     T.PHI{preds, ...} =>
498 :     showVal(hd defs)^" := phi("^listify2(preds,uses)^")"
499 :     | T.SINK{block=b,liveOut,...} =>
500 :     "sink["^block b^"]("^listify(uses, liveOut)^")"
501 :     | T.SOURCE{block=b,liveIn,...} =>
502 :     (* Only pretty print the registers that are currently live *)
503 :     let val edges = DA.sub(succTbl,ssa_id)
504 :     fun isLive r = List.exists (fn (_,_,r') => r = r') edges
505 :     fun collect([], [], ds', rs') = (rev ds', rev rs')
506 :     | collect(d::ds, r::rs, ds', rs') =
507 :     if isLive d then collect(ds, rs, d::ds', r::rs')
508 :     else collect(ds, rs, ds', rs')
509 :     val (defs, liveIn) = collect(defs, liveIn, [], [])
510 :     in "source["^block b^"]("^listify(defs, liveIn)^")"
511 :     end
512 :     | _ =>
513 :     let fun def v = showVal(List.nth(defs, v))
514 :     fun use v = showVal(List.nth(uses, v))
515 : leunga 744 val ssa = RTL.rtlToString rtl
516 :     (* val ssa = #stm
517 :     (RTL.showRTL{def=def, use=use,
518 :     regionDef=def, regionUse=use}) rtl
519 :     *)
520 :    
521 : leunga 695 val ssa = if !showPos then
522 :     ssa^" #"^prInt(DA.sub(posTbl, ssa_id))
523 :     else ssa
524 :     in if !showAsm then asm ssa_op^" ["^ssa^"]" else ssa end
525 :     end
526 :     in show
527 :     end
528 :    
529 :     (*------------------------------------------------------------------------
530 :     * Pretty printing the rtl
531 :     *------------------------------------------------------------------------*)
532 :     fun showRTL SSA = RTL.rtlToString
533 :    
534 :     (*------------------------------------------------------------------------
535 :     * Generate a renamed variable. Propagate cellkind and gc type information
536 :     *------------------------------------------------------------------------*)
537 :     fun newRenamedVar SSA =
538 :     let val {nameTbl, cellKindTbl, gcmap, ...} = info SSA
539 : leunga 744 val lookupCellKind = IntHashTable.lookup cellKindTbl
540 :     val addCellKind = IntHashTable.insert cellKindTbl
541 : leunga 695 val updateGC =
542 :     case gcmap of
543 :     NONE => (fn (r, r') => r')
544 :     | SOME m =>
545 : leunga 744 let val lookup = IntHashTable.lookup m
546 :     val add = IntHashTable.insert m
547 : leunga 695 in fn (r,r') => (add(r', lookup r) handle _ => (); r')
548 :     end
549 :     fun newVar r =
550 :     let val r' = C.newVar r
551 :     in addCellKind(r', lookupCellKind r) handle _ => () ;
552 :     updateGC(r, r')
553 :     end
554 :    
555 :     in case nameTbl of
556 :     NONE => newVar
557 :     | SOME nameTbl =>
558 : leunga 744 let val enterName = IntHashTable.insert nameTbl
559 : leunga 695 exception NoIndex
560 : leunga 744 val indexTbl = IntHashTable.mkTable(31, NoIndex)
561 :     val addIndex = IntHashTable.insert indexTbl
562 :     val findIndex = IntHashTable.find indexTbl
563 :     val findIndex =
564 :     fn r => case findIndex r of SOME i => i | NONE => 0
565 : leunga 695 fun newVarKeepName r =
566 :     let val r' = newVar r
567 :     val i = findIndex r
568 :     in addIndex(r,i+1);
569 :     enterName(r', {oldName=r, index=i});
570 :     r'
571 :     end
572 :     in newVarKeepName
573 :     end
574 :     end
575 :    
576 :     (*------------------------------------------------------------------------
577 :     * Generate variable. Propagate gc type information only.
578 :     *------------------------------------------------------------------------*)
579 :     fun newVar SSA =
580 :     let val {gcmap, ...} = info SSA
581 :     in case gcmap of
582 :     NONE => C.newVar
583 :     | SOME m =>
584 : leunga 744 let val lookup = IntHashTable.lookup m
585 :     val add = IntHashTable.insert m
586 : leunga 695 in fn r => let val r' = C.newVar r
587 :     in add(r', lookup r) handle _ => (); r' end
588 :     end
589 :     end
590 :    
591 :     (*------------------------------------------------------------------------
592 :     * Create a new SSA op. The node must not already exist.
593 :     *------------------------------------------------------------------------*)
594 :     fun newOp SSA =
595 :     let val {defSiteTbl, nodeCount, ...} = info SSA
596 :     val defsTbl = defsTbl SSA
597 :     val usesTbl = usesTbl SSA
598 :     val ssaOpTbl = ssaOpTbl SSA
599 :     val blockTbl = blockTbl SSA
600 :     val posTbl = posTbl SSA
601 :     val rtlTbl = rtlTbl SSA
602 :    
603 :     fun new{id, instr, rtl, defs, uses, block, pos} =
604 :     let fun addDefSite [] = ()
605 :     | addDefSite(r::rs) =
606 :     ((*print("defSite["^showVal SSA r^"]="^i2s id^"\n");*)
607 :     DA.update(defSiteTbl,r,id);
608 :     addDefSite rs
609 :     )
610 :     in nodeCount := !nodeCount + 1;
611 :     addDefSite defs;
612 :     A.update(rtlTbl, id, rtl);
613 :     A.update(defsTbl, id, defs);
614 :     A.update(usesTbl, id, uses);
615 :     A.update(ssaOpTbl, id, instr);
616 :     A.update(blockTbl, id, block);
617 :     A.update(posTbl, id, pos);
618 :     (*print("["^i2s id^"] = "^showOp SSA id^"\n"); *)
619 :     ()
620 :     end
621 :     in new end
622 :    
623 :     (*------------------------------------------------------------------------
624 :     * Iterators
625 :     *------------------------------------------------------------------------*)
626 :     fun forallNodes SSA f =
627 :     let val blockTbl = blockTbl SSA
628 :     val n = A.length blockTbl
629 :     fun loop(i) =
630 :     if i >= n then () else
631 :     (if A.sub(blockTbl,i) >= 0 then f i else (); loop(i+1))
632 :     in loop 0 end
633 :    
634 :     fun foldNodes SSA f x =
635 :     let val {blockTbl,...} = info SSA
636 :     val n = DA.length blockTbl
637 :     val blockTbl = DA.baseArray blockTbl
638 :     fun fold(i,x) =
639 :     if i < n then fold(i+1, if A.sub(blockTbl,i) >= 0 then f(i,x) else x)
640 :     else x
641 :     in fold(0,x) end
642 :    
643 :     (*------------------------------------------------------------------------
644 :     * Insert edges
645 :     *------------------------------------------------------------------------*)
646 :     fun computeDefUseChains SSA =
647 :     let val usesTbl = usesTbl SSA
648 :     val succTbl = succTbl SSA
649 :     val defSiteTbl = defSiteTbl SSA
650 :     val blockTbl = blockTbl SSA
651 :     val n = A.length succTbl
652 :     fun iter(i, size) =
653 :     if i < n then
654 :     let fun addEdges([], size) = size
655 :     | addEdges(v::vs, size) =
656 :     if v < 0 then addEdges(vs, size)
657 :     else let val j = A.sub(defSiteTbl, v)
658 :     in (* print(i2s i^" -> "^i2s j^"\n"^
659 :     showOp SSA i^"->"^showOp SSA j^" ("^
660 :     showVal SSA v^" "^i2s v^")\n"); *)
661 :     A.update(succTbl, j, (j,i,v)::A.sub(succTbl, j));
662 :     addEdges(vs, size+1)
663 :     end
664 :     val uses = A.sub(usesTbl, i)
665 :     in iter(i+1, addEdges(uses, size))
666 :     end
667 :     else size
668 :    
669 :     val numberOfEdges = iter(0, 0)
670 :     val {edgeCount, defsTbl, ... } = info SSA
671 :     in edgeCount := numberOfEdges
672 :     end
673 :    
674 :     (*------------------------------------------------------------------
675 :     * Function to remove useless phi-node from the graph
676 :     *------------------------------------------------------------------*)
677 :     fun removeUselessPhiFunctions(SSA as G.GRAPH ssa) =
678 :     let val usesTbl = usesTbl SSA
679 :     val defsTbl = defsTbl SSA
680 :     val rtlTbl = rtlTbl SSA
681 :     val succTbl = succTbl SSA
682 :     val blockTbl = blockTbl SSA
683 :     val defSiteTbl = defSiteTbl SSA
684 :     val onWorklist = W8A.array(#capacity ssa (), 0w0)
685 :     val {nodeCount, edgeCount, ...} = info SSA
686 :     val showVal = showVal SSA
687 :     val showOp = showOp SSA
688 :    
689 :     (* Replace all uses of t defined by phi-node i to t' *)
690 :     fun removeUselessNode(i, t, t', WL) =
691 :     let (* val _ = print("Useless ["^i2s i^"] "^showOp i^" "^
692 :     showVal t^" -> "^showVal t'^"\n"); *)
693 :     val i' = A.sub(defSiteTbl, t')
694 :     fun processEdges([], es_i', size, WL) = (es_i', size, WL)
695 :     | processEdges((i,j,t)::es_i, es_i', size, WL) =
696 :     (* remove self loops; *)
697 :     if i = j
698 :     then processEdges(es_i, es_i', size-1, WL)
699 :     else
700 :     let fun renameUses [] = []
701 :     | renameUses (v::vs) =
702 :     (if v = t then t' else v)::renameUses vs
703 :     val WL = case A.sub(rtlTbl,j) of
704 :     T.PHI _ =>
705 :     if W8A.sub(onWorklist, j) = 0w0 then
706 :     (W8A.update(onWorklist, j, 0w1); j::WL)
707 :     else WL
708 :     | _ => WL
709 :     val uses_j = A.sub(usesTbl, j)
710 :     in (* print("\t"^showOp j^" =>\n\t"); *)
711 :     A.update(usesTbl, j, renameUses uses_j);
712 :     (* print(showOp j^"\n"); *)
713 :     processEdges(es_i, (i',j,t')::es_i', size, WL)
714 :     end
715 :    
716 :     (* Filter i from the use sites of i' *)
717 :     fun filterI([], es_i', size) = (es_i', size)
718 :     | filterI((e as (i',k,_))::es, es_i', size) =
719 :     if k = i then filterI(es, es_i', size-1)
720 :     else filterI(es, e::es_i', size)
721 :    
722 :     val es_i = A.sub(succTbl, i)
723 :     val es_i' = A.sub(succTbl, i')
724 :     val (es_i', size) = filterI(es_i', [], !edgeCount)
725 :     val (es_i', size, WL) = processEdges(es_i, es_i', size, WL)
726 :     in edgeCount := size;
727 :     nodeCount := !nodeCount - 1;
728 :     A.update(succTbl, i', es_i');
729 :     (* Remove node i *)
730 :     A.update(succTbl, i, []);
731 :     A.update(defsTbl, i, []);
732 :     A.update(usesTbl, i, []);
733 :     A.update(blockTbl, i, ~1);
734 :     WL
735 :     end
736 :    
737 :     fun processWorkList [] = ()
738 :     | processWorkList(i::WL) =
739 :     let val _ = W8A.update(onWorklist,i,0w0)
740 :     (* val _ = print("Processing "^i2s i^"\n") *)
741 :     val _ = if A.sub(blockTbl,i) < 0 then error(i2s i)
742 :     else ()
743 :     val [t] = A.sub(defsTbl,i)
744 :     val s = A.sub(usesTbl,i)
745 :     (* Check if i is useless *)
746 :     fun loop([],t') = removeUselessNode(i,t,t',WL)
747 :     | loop(v::vs,t') =
748 :     if v = t then loop(vs,t')
749 :     else if t' = ~1 then loop(vs,v)
750 :     else WL (* not useless *)
751 :     val WL = loop(s, ~1)
752 :     in processWorkList WL end
753 :    
754 :     fun collectPhis(i,WL) =
755 :     (case A.sub(rtlTbl,i) of
756 :     T.PHI _ => (W8A.update(onWorklist, i, 0w1); i::WL)
757 :     | _ => WL
758 :     )
759 :    
760 :     val WL = foldNodes SSA collectPhis []
761 :    
762 :     in processWorkList(WL)
763 :     end
764 :    
765 :     (*------------------------------------------------------------------------
766 :     * Remove all nodes.
767 :     * Note: no duplicates allowed.
768 :     *------------------------------------------------------------------------*)
769 :     fun removeAllNodes SSA nodes =
770 :     let val succTbl = succTbl SSA
771 :     val defsTbl = defsTbl SSA
772 :     val usesTbl = usesTbl SSA
773 :     val blockTbl = blockTbl SSA
774 :     val {edgeCount, nodeCount, garbageNodes, ...} = info SSA
775 :     fun removeAll([], nodes, edges, garbage) =
776 :     (nodeCount := nodes; edgeCount := edges; garbageNodes := garbage)
777 :     | removeAll(n::ns, nodes, edges, garbage) =
778 :     if A.sub(blockTbl, n) < 0
779 :     then removeAll(ns, nodes, edges, garbage)
780 :     else
781 :     let val outEdges = A.sub(succTbl, n)
782 :     in nodeCount := !nodeCount - 1;
783 :     A.update(blockTbl, n, ~1);
784 :     A.update(usesTbl, n, []);
785 :     A.update(defsTbl, n, []);
786 :     A.update(succTbl, n, []);
787 :     removeAll(ns, nodes-1, edges - length outEdges, n::garbage)
788 :     end
789 :     in removeAll(nodes,!nodeCount,!edgeCount,!garbageNodes)
790 :     end
791 :    
792 :     (*------------------------------------------------------------------------
793 :     * Replace all use of one value with another. Return true iff
794 :     * all uses of "from" has been replaced by "to".
795 :     * Note: The definition of "from" must dominate all uses of "to", as
796 :     * required by the SSA form.
797 :     *------------------------------------------------------------------------*)
798 :     fun replaceAllUses(SSA as G.GRAPH ssa) =
799 :     let val defSiteTbl = defSiteTbl SSA
800 :     val usesTbl = usesTbl SSA
801 :     val succTbl = succTbl SSA
802 :     val posTbl = posTbl SSA
803 :     val rtlTbl = rtlTbl SSA
804 :     val {edgeCount, ...} = info SSA
805 :    
806 : leunga 744 val cellKind = IntHashTable.find(cellKindTbl SSA)
807 :     val cellKind = fn r => case cellKind r of SOME k => k | NONE => C.GP
808 : leunga 695
809 :     fun isReplaceable k = k = C.GP orelse k = C.FP
810 :    
811 :     fun replace{from, to, vn} =
812 :     isReplaceable(cellKind from) andalso
813 :     let
814 :     val old = A.sub(defSiteTbl, from)
815 :     val new = A.sub(defSiteTbl, to)
816 :    
817 :     (* val _ = print("REPLACING "^showOp SSA old^
818 :     "("^showVal SSA from^") by "^
819 :     showOp SSA new^"( "^showVal SSA to^") vn="^
820 :     i2s vn^"\n") *)
821 :     (*
822 :     * We directly manipulate the graph structure here.
823 :     * Since the number of edges does not change, there is
824 :     * no need to update the edge count.
825 :     *)
826 :     fun renameUses([], to) = []
827 :     | renameUses(r::rs, to) =
828 :     (if r = from then to else r)::renameUses(rs, to)
829 :    
830 :     fun removeUse([], es') = es'
831 :     | removeUse((e as (_,j,r))::es,es') =
832 :     if r = from then
833 :     (* Rename an argument of j *)
834 :     (replacements := !replacements + 1;
835 :     if vn < 0 (* is a constant that we are replacing *)
836 :     andalso
837 :     (case A.sub(rtlTbl, j) of
838 :     (T.PHI _ | T.SINK _ ) => true
839 :     | _ => false
840 :     ) then
841 :     (* phi or sink node *)
842 :     (A.update(usesTbl, j, renameUses(A.sub(usesTbl,j), vn));
843 :     (* print("Replacing constant: "^showOp SSA j^"\n"); *)
844 :     edgeCount := !edgeCount - 1
845 :     )
846 :     else (* normal node *)
847 :     (A.update(usesTbl, j, renameUses(A.sub(usesTbl, j), to));
848 :     A.update(succTbl, new, (new,j,to)::A.sub(succTbl, new))
849 :     );
850 :     removeUse(es,es')
851 :     )
852 :     else
853 :     removeUse(es, e::es')
854 :    
855 :     val edges = removeUse(A.sub(succTbl, old), [])
856 :     in A.update(succTbl, old, edges);
857 :     true
858 :     end
859 :    
860 :     in replace
861 :     end
862 :    
863 :     (*------------------------------------------------------------------------
864 :     * Replace the definition of value by const. This will change the
865 :     * instruction that defines value to a constant computation instruction.
866 :     * Return true iff this operation is successful.
867 :     *------------------------------------------------------------------------*)
868 :     fun foldConstant SSA =
869 :     let val constOf = const SSA
870 :     val showOp = showOp SSA
871 :     val {edgeCount, posTbl, defsTbl, usesTbl, succTbl, rtlTbl, ssaOpTbl,
872 :     defSiteTbl, minPos, blockTbl, ...} = info SSA
873 :     fun fold{value, const} =
874 :     let val i = DA.sub(defSiteTbl, value)
875 :     val defs = DA.sub(defsTbl, i)
876 :     in case (defs, constOf const) of
877 : leunga 744 ([_], SP.OT.INT imm) => (* only one value defined; okay *)
878 : leunga 695 if (case DA.sub(usesTbl, i) of
879 :     [v] => v < 0 (* already a constant! don't fold *)
880 :     | _ => false) then false
881 :     else
882 :     let (* Remove existing incoming edges *)
883 :     fun removeUses [] = ()
884 :     | removeUses(v::vs) =
885 :     if v < 0 then removeUses vs else
886 :     let val j = DA.sub(defSiteTbl, v)
887 :     fun rmv([], es') = es'
888 :     | rmv((e as (j,k,_))::es, es') =
889 :     if k = i then rmv(es, es')
890 :     else (edgeCount := !edgeCount - 1;
891 :     rmv(es, e::es'))
892 :     val succ_j = DA.sub(succTbl, j)
893 :     in DA.update(succTbl, j, rmv(succ_j, []));
894 :     removeUses vs
895 :     end
896 :    
897 :     (* val _ = print("REPLACING "^showOp i^" -> "); *)
898 :     val instr = InsnProps.loadImmed{t=value, immed=imm}
899 :     val oldRtl = DA.sub(rtlTbl, i)
900 :     val _ = DA.update(ssaOpTbl, i, instr)
901 :     val newRtl = SP.RTLProps.rtl instr
902 :     val _ = DA.update(rtlTbl, i, newRtl)
903 :     val oldUses = DA.sub(usesTbl, i)
904 :     in removeUses(oldUses);
905 :     (* now has only one input! *)
906 :     DA.update(usesTbl, i, [const]);
907 :    
908 :     (* If the instruction used to be a phi-node or
909 :     * a source node, find an appropriate place for
910 :     * this new instruction.
911 :     *)
912 :     case oldRtl of
913 :     (T.PHI _ | T.SOURCE _) =>
914 :     let val newPos = !minPos
915 :     in minPos := !minPos - 128;
916 :     DA.update(posTbl, i, newPos)
917 :     end
918 :     | _ => () (* keep the same position *)
919 :     ;
920 :     (* print(showOp i^"\n");
921 :     app (fn (_,j,_) => print ("\t"^showOp j^"\n"))
922 :     (DA.sub(succTbl, i)); *)
923 :     true
924 :     end
925 :     | _ => false (* can't fold *)
926 :     end
927 :     in fold
928 :     end
929 :    
930 :     (*------------------------------------------------------------------------
931 :     * Move an instruction from one block to another
932 :     *------------------------------------------------------------------------*)
933 :     fun moveOp SSA =
934 :     let val posTbl = posTbl SSA
935 :     val blockTbl = blockTbl SSA
936 :     val defSiteTbl = defSiteTbl SSA
937 :     val usesTbl = usesTbl SSA
938 :     val succTbl = succTbl SSA
939 :     val rtlTbl = rtlTbl SSA
940 :     val showOp = showOp SSA
941 :     val showVal = showVal SSA
942 :    
943 :     val {maxPos, minPos, ...} = info SSA
944 :    
945 :     fun mv{id, block} =
946 :     let val _ = moved := !moved + 1
947 :     fun earliest([], pos) = pos
948 :     | earliest(v::vs, pos) =
949 :     if v < 0 then earliest(vs, pos)
950 :     else let val j = A.sub(defSiteTbl,v)
951 :     val b_j = A.sub(blockTbl, j)
952 :     in if block = b_j then
953 :     (case A.sub(rtlTbl, j) of
954 :     T.PHI _ => earliest(vs, pos)
955 :     | _ => earliest(vs, Int.max(pos, A.sub(posTbl, j)))
956 :     )
957 :     else
958 :     earliest(vs, pos)
959 :     end
960 :     fun latest([], pos) = pos
961 :     | latest((_,j,_)::es, pos) =
962 :     let val b_j = A.sub(blockTbl,j)
963 :     in if block = b_j then
964 :     (case A.sub(rtlTbl, j) of
965 :     T.PHI _ => latest(es, pos)
966 :     | _ => latest(es, Int.min(pos, A.sub(posTbl, j)))
967 :     )
968 :     else
969 :     latest(es, pos)
970 :     end
971 :    
972 :     fun sanityCheck(lo, hi) =
973 :     if lo > hi then
974 :     let fun prOp j =
975 :     let val b_j = A.sub(blockTbl, j)
976 :     val pos_j = A.sub(posTbl, j)
977 :     in print("\t"^showOp j^" in block "^
978 :     i2s b_j^":"^i2s pos_j^"\n")
979 :     end
980 :     fun prUse v =
981 :     if v < 0 then print("\t"^showVal v^"\n")
982 :     else let val j = A.sub(defSiteTbl, v)
983 :     in prOp j
984 :     end
985 :     fun prDef(_,j,_) = prOp j
986 :     in print "Uses=\n"; app prUse (A.sub(usesTbl, id));
987 :     print "Defs=\n"; app prDef (A.sub(succTbl, id));
988 :     error("move "^showOp id^" lo="^i2s lo^
989 :     " hi="^i2s hi^" block="^i2s block)
990 :     end
991 :     else ()
992 :    
993 :    
994 :     val uses = A.sub(usesTbl, id)
995 :     val lo = earliest(uses, !minPos)
996 :     val hi = latest(A.sub(succTbl, id), !maxPos)
997 :     val pos = if !minPos = lo then (maxPos := !maxPos + 128; hi-1)
998 :     else if !maxPos = hi then (minPos := !minPos - 128; lo+1)
999 :     else (minPos := !minPos - 128;
1000 :     maxPos := !maxPos + 128;
1001 :     sanityCheck(lo, hi);
1002 :     (lo + hi) div 2
1003 :     )
1004 :     in A.update(blockTbl, id, block);
1005 :     A.update(posTbl, id, pos)
1006 :     end
1007 :     in mv
1008 :     end
1009 :    
1010 :     (*------------------------------------------------------------------------
1011 :     * Set the target of a conditional branch as true or false.
1012 :     * This removes the branch and eliminates all unreachable code.
1013 :     *------------------------------------------------------------------------*)
1014 :     fun setBranch(SSA as G.GRAPH ssa) =
1015 :     let val {cfg, ssaOpTbl, blockTbl, nodeCount, ...} = info SSA
1016 :     fun set{id, cond} =
1017 :     let val b = DA.sub(blockTbl,id)
1018 :     val jmp = CFG.setBranch(cfg, b, cond)
1019 :     in #remove_node ssa id;
1020 :     DA.update(ssaOpTbl, id, jmp);
1021 :     DA.update(blockTbl, id, b);
1022 :     nodeCount := !nodeCount + 1;
1023 :     branchesFolded := !branchesFolded + 1
1024 :     end
1025 :     in set
1026 :     end
1027 :    
1028 :     (*------------------------------------------------------------------------
1029 :     * Make sure that none of the tables have been resized
1030 :     *------------------------------------------------------------------------*)
1031 :     fun noResize SSA f x =
1032 :     let val b = blockTbl SSA
1033 :     val d = defSiteTbl SSA
1034 :     fun check() =
1035 :     (if b <> blockTbl SSA then error "node tables have changed" else ();
1036 :     if d <> defSiteTbl SSA then error "variable table has changed" else ()
1037 :     )
1038 :     in let val y = f x in check(); y end
1039 :     handle e => (check(); raise e)
1040 :     end
1041 :    
1042 :    
1043 :     (*------------------------------------------------------------------------
1044 :     * Signal that an SSA has been changed
1045 :     *------------------------------------------------------------------------*)
1046 :     fun changed SSA =
1047 :     let val {nodes, ...} = info SSA
1048 :     in nodes := NONE end
1049 :    
1050 :     (*------------------------------------------------------------------------
1051 :     * Linearize the representation
1052 :     *------------------------------------------------------------------------*)
1053 :     fun nodes SSA =
1054 :     let val {nodes, ...} = info SSA
1055 :     in case !nodes of
1056 :     SOME nodes => nodes
1057 :     | NONE => let val n = linearizeNodes SSA
1058 :     in nodes := SOME n; n end
1059 :     end
1060 :    
1061 :     and linearizeNodes SSA =
1062 :     let val G.GRAPH cfg = cfg SSA
1063 :     val N = #capacity cfg ()
1064 :    
1065 :     val blockTbl = blockTbl SSA
1066 :     val posTbl = posTbl SSA
1067 :     val rtlTbl = rtlTbl SSA
1068 :    
1069 :     val sinks = A.array(N,[])
1070 :     val sources = A.array(N,[])
1071 :     val phis = A.array(N,[])
1072 :     val ops = A.array(N,[])
1073 :    
1074 :     fun ins(n) =
1075 :     let val b = A.sub(blockTbl,n)
1076 :     in if b >= 0 then
1077 :     let val tbl =
1078 :     case A.sub(rtlTbl, n) of
1079 :     T.PHI _ => phis
1080 :     | T.SINK _ => sinks
1081 :     | T.SOURCE _ => sources
1082 :     | _ => ops
1083 :     in A.update(tbl, b, n::A.sub(tbl, b))
1084 :     end
1085 :     else ();
1086 :     ins(n-1)
1087 :     end
1088 :     fun byPos(a,b) = A.sub(posTbl,a) > A.sub(posTbl,b)
1089 :     in ins(A.length blockTbl - 1) handle Subscript => ();
1090 :     A.modify (ListMergeSort.sort byPos) ops;
1091 :     {sinks=sinks, sources=sources, phis=phis, ops=ops}
1092 :     end
1093 :    
1094 :    
1095 :     (*------------------------------------------------------------------------
1096 :     * Graphical Viewing
1097 :     *------------------------------------------------------------------------*)
1098 :     fun viewAsCFG SSA =
1099 :     let val cfg = cfg SSA
1100 :     val {graph, node, edge} = CFG.viewStyle cfg
1101 :     val showOp = showOp SSA
1102 :     val {sinks, sources, phis, ops} = nodes SSA
1103 :     fun node(b,b') =
1104 :     let val instrs = A.sub(sources, b) @
1105 :     A.sub(phis, b) @
1106 :     A.sub(ops, b) @
1107 :     A.sub(sinks, b)
1108 :     val text = String.concat (map (fn i => showOp i^"\n") instrs)
1109 :     in [L.LABEL(CFG.headerText b' ^ text)]
1110 :     end
1111 :     in L.makeLayout
1112 :     { graph = graph,
1113 :     node = node,
1114 :     edge = edge
1115 :     } cfg
1116 :     end
1117 :    
1118 :     fun viewAsSSA SSA =
1119 :     let val showOp = showOp SSA
1120 :     val showVal = showVal SSA
1121 :     fun graph _ = []
1122 :     fun node(i,_) = [L.LABEL(showOp i)]
1123 :     fun edge(_,_,v) = [L.COLOR "red",L.LABEL(showVal v)]
1124 :     in L.makeLayout
1125 :     { graph = graph,
1126 :     node = node,
1127 :     edge = edge
1128 :     } SSA
1129 :     end
1130 :    
1131 :     (*------------------------------------------------------------------------
1132 :     * Consistency checking
1133 :     *------------------------------------------------------------------------*)
1134 :     fun consistencyCheck(SSA as G.GRAPH ssa) =
1135 :     let val defSiteTbl = defSiteTbl SSA
1136 :     val usesTbl = usesTbl SSA
1137 :     val defsTbl = defsTbl SSA
1138 :     val rtlTbl = rtlTbl SSA
1139 :     val blockTbl = blockTbl SSA
1140 :     val succTbl = succTbl SSA
1141 :     val posTbl = posTbl SSA
1142 :     val Dom = dom SSA
1143 :     val showOp = showOp SSA
1144 :     val showVal = showVal SSA
1145 :     val dominates = Dom.dominates Dom
1146 :    
1147 :     val hasError = ref false
1148 :    
1149 :     fun posOf i =
1150 :     case A.sub(rtlTbl,i) of
1151 :     T.PHI _ => ~10000000
1152 :     | _ => A.sub(posTbl,i)
1153 :    
1154 :     fun bug(i,msg) =
1155 :     (print("ERROR [b"^i2s(A.sub(blockTbl,i))^":p"^i2s(posOf i)^
1156 :     ":"^i2s i^"] "^showOp i^": "^msg^"\n");
1157 :     hasError := true
1158 :     )
1159 :    
1160 :     fun checkDefs i =
1161 :     let val defs = A.sub(defsTbl, i)
1162 :     in app (fn r =>
1163 :     let val i' = A.sub(defSiteTbl,r)
1164 :     in if i <> i' then
1165 :     bug(i,"wrong def site "^i2s i'^" for "^
1166 :     showVal r)
1167 :     else ()
1168 :     end)
1169 :     defs
1170 :     end
1171 :    
1172 :     fun checkBlock(i, block) =
1173 :     if A.sub(blockTbl,i) <> block then bug(i,"wrong block") else ()
1174 :    
1175 :     fun printEdge (i,j,r) =
1176 :     print("\t"^i2s i^" -> "^i2s j^" "^showVal r^"\n")
1177 :    
1178 :     fun domTest(i,j,r) =
1179 :     let val b_i = A.sub(blockTbl, i)
1180 :     val b_j = A.sub(blockTbl, j)
1181 :    
1182 :     val ok =
1183 :     case A.sub(rtlTbl,j) of
1184 :     T.PHI{preds, ...} =>
1185 :     let fun scan(p::preds, v::vs) =
1186 :     r = v andalso dominates(b_i,p) orelse scan(preds, vs)
1187 :     | scan _ = false
1188 :     in scan(preds, A.sub(usesTbl,j)) end
1189 :     | _ => if b_i = b_j then posOf i < posOf j
1190 :     else dominates(b_i, b_j)
1191 :     in if ok then ()
1192 :     else bug(i,showVal r^
1193 :     " does not dominate "^showOp j^
1194 :     " b"^i2s(A.sub(blockTbl,j))^" p"^i2s(posOf j))
1195 :     end
1196 :    
1197 :     fun checkEdges i =
1198 :     let val defs = A.sub(defsTbl, i)
1199 :     val edges = A.sub(succTbl, i)
1200 :     fun checkEdge(i',j',r) =
1201 :     (if i' <> i then bug(i, "bad edge source") else ();
1202 :     if A.sub(blockTbl,j') < 0 then
1203 :     bug(i, "use in node "^i2s j'^" is dead") else ();
1204 :     if not(List.exists (fn r' => r = r') defs) then
1205 :     bug(i, showVal r^" is not a definition") else ();
1206 :     if not(List.exists (fn r' => r = r')
1207 :     (A.sub(usesTbl,j'))) then
1208 :     bug(i, showOp j'^" has no use of "^showVal r) else ();
1209 :     domTest(i',j',r)
1210 :     )
1211 :     in app checkEdge edges
1212 :     end
1213 :    
1214 :     fun showVals(title,rs) =
1215 :     print(title^"="^foldr (fn (r,"") => showVal r
1216 :     | (r,s) => showVal r^","^s) "" rs^
1217 :     " ("^i2s(length rs)^")\n")
1218 :    
1219 :     fun checkLiveIn(i, liveIn) =
1220 :     let val defs = A.sub(defsTbl, i)
1221 :     val n = length defs
1222 :     val m = length liveIn
1223 :     in if n <> m then
1224 :     (bug(i, "|liveIn| <> |defs|");
1225 :     showVals("liveIn", liveIn);
1226 :     showVals("defs", defs)
1227 :     )
1228 :     else ()
1229 :     end
1230 :    
1231 :     fun checkLiveOut(i, liveOut) =
1232 :     let val uses = A.sub(usesTbl, i)
1233 :     val n = length uses
1234 :     val m = length liveOut
1235 :     in if n <> m then
1236 :     (bug(i, "|liveOut| <> |uses|");
1237 :     showVals("liveOut", liveOut);
1238 :     showVals("uses", uses)
1239 :     )
1240 :     else ()
1241 :     end
1242 :    
1243 :     fun checkNode(i, _) =
1244 :     case A.sub(rtlTbl, i) of
1245 :     T.PHI{preds, block} => checkPhi(i, preds, block)
1246 :     | T.SOURCE{liveIn, block} => checkSource(i, liveIn, block)
1247 :     | T.SINK{liveOut, block} => checkSink(i, liveOut, block)
1248 :     | _ => checkOp i
1249 :    
1250 :     and checkPhi(i, preds, block) =
1251 :     (checkBlock(i,block);
1252 :     checkDefs i;
1253 :     checkEdges i;
1254 :     let val n = length preds
1255 :     val m = length(A.sub(usesTbl, i))
1256 :     in if m <> n then
1257 :     bug(i, "|preds|="^i2s n^" |uses|="^i2s m)
1258 :     else ()
1259 :     end
1260 :     )
1261 :    
1262 :     and checkSource(i, liveIn, block) =
1263 :     (checkBlock(i, block);
1264 :     checkLiveIn(i, liveIn);
1265 :     if length(A.sub(usesTbl,i)) <> 0 then
1266 :     bug(i,"|uses| <> 0")
1267 :     else ();
1268 :     checkDefs i;
1269 :     checkEdges i
1270 :     )
1271 :    
1272 :     and checkSink(i, liveOut, block) =
1273 :     (checkBlock(i, block);
1274 :     checkLiveOut(i, liveOut);
1275 :     if length(A.sub(defsTbl,i)) <> 0 then
1276 :     bug(i,"|defs| <> 0")
1277 :     else ();
1278 :     if length(A.sub(succTbl,i)) <> 0 then
1279 :     (bug(i,"|succs| <> 0" );
1280 :     app printEdge (A.sub(succTbl,i))
1281 :     )
1282 :     else ();
1283 :     checkDefs i;
1284 :     checkEdges i
1285 :     )
1286 :    
1287 :     and checkOp(i) =
1288 :     (checkDefs i;
1289 :     checkEdges i
1290 :     )
1291 :    
1292 :     in #forall_nodes ssa checkNode;
1293 :     if !hasError then error "SSA graph is corrupted" else ()
1294 :     end
1295 :     end

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