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 695 - (view) (download)
Original Path: sml/trunk/src/MLRISC/SSA/ssa.sml

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 :     sharing MLTreeComp.T.Basis = SSAProps.RTL.T.Basis
16 :     ) : 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 :     type rtl = SP.RTL.rtl (* RTL *)
65 :     type const = SP.OT.const (* constants *)
66 :     type cfg = CFG.cfg (* control flow graph *)
67 :     type dom = (CFG.block,CFG.edge_info,CFG.info) Dom.dominator_tree
68 :     type nameTbl = {oldName:C.cell, index:int} Intmap.intmap
69 :    
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 :     cellKindTbl : C.cellkind Intmap.intmap,
91 :     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 :     val rtlTbl = DA.array(13, RTL.COPY)
144 :     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 :     val cellKindTbl = Intmap.new(13, NoCellKind)
149 :     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 :     operandTbl = operandTbl,
167 :     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 :     fun immed SSA = OT.immed(#operandTbl(info SSA)) (* create a new operand *)
342 :     (*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 :     fun showVal SSA =
414 :     let val {nameTbl, cellKindTbl, gcmap, ...} = info SSA
415 :     val const = const SSA
416 :     val cellKind = Intmap.mapWithDefault(cellKindTbl, C.GP)
417 :    
418 :     (* Display gc type if a gc map is present *)
419 :     val showGC =
420 :     case gcmap of
421 :     NONE => (fn r => "")
422 :     | SOME gcmap =>
423 :     let val look = Intmap.map gcmap
424 :     in fn r => ":"^GCMap.GC.toString(look r) handle _ => ":?" end
425 :    
426 :     (* Display fancy name if a name table is present *)
427 :     val translate =
428 :     case nameTbl of
429 :     NONE => (fn (k,v) => C.toString k v)
430 :     | SOME tbl =>
431 :     let val look = Intmap.map tbl
432 :     in fn (k,v) =>
433 :     let val {oldName,index} = look v
434 :     in C.toString k oldName^"."^i2s index end
435 :     handle _ => (C.toString k v)
436 :     end
437 :    
438 :     (* Lookup name *)
439 :     fun lookupName v =
440 :     let val k = cellKind v
441 :     val gcTy = if k = C.MEM orelse k = C.CTRL then "" else showGC v
442 :     in translate(k,v) ^ gcTy end
443 :    
444 :     (* Show a value *)
445 :     fun show v =
446 :     if v >= 0 then lookupName v
447 :     else (case const v of
448 :     SP.OT.IMMED i => prInt i
449 :     | SP.OT.OPERAND opnd => "v"^i2s(~v)
450 :     (*| SP.OT.LABEL l => Label.nameOf l*)
451 :     ) handle SP.OT.NoConst => "?"^i2s(~v)
452 :     in show end
453 :    
454 :     (*------------------------------------------------------------------------
455 :     * Pretty printing an ssa op
456 :     *------------------------------------------------------------------------*)
457 :     fun showOp SSA =
458 :     let val {usesTbl, defsTbl, ssaOpTbl, rtlTbl, succTbl,
459 :     blockTbl, posTbl, cellKindTbl, ...} = info SSA
460 :     val K = !listLimit
461 :     val showVal = showVal SSA
462 :     val cfg = cfg SSA
463 :     val regmap = CFG.regmap cfg
464 :     val asm = FormatInsn.toString (!(CFG.annotations cfg))
465 :     (C.lookup regmap)
466 :     fun block b = "b"^i2s b
467 :     fun blockOf ssa_id = block(DA.sub(blockTbl,ssa_id))
468 :     val cellKindOf = Intmap.mapWithDefault(cellKindTbl, C.GP)
469 :    
470 :     fun listify(vs, rs) =
471 :     let fun h r = C.toString (cellKindOf r) r
472 :     fun g(v,r) = showVal v^"="^h r
473 :     fun f(_,[],[]) = ""
474 :     | f(0,vs,rs) = "\n "^f(K,vs,rs)
475 :     | f(n,[v],[r]) = g(v,r)
476 :     | f(n,v::vs,r::rs) = g(v,r)^","^f(n-1,vs,rs)
477 :     | f _ = error "showOp.listify"
478 :     in f(K,vs,rs) end
479 :    
480 :     fun listify2([b],[v]) = "["^block b^"]"^showVal v
481 :     | listify2(b::bs,v::vs) = "["^block b^"]"^showVal v^","^listify2(bs,vs)
482 :     | listify2 _ = ""
483 :    
484 :     fun show ssa_id =
485 :     let val ssa_op = DA.sub(ssaOpTbl, ssa_id)
486 :     val defs = DA.sub(defsTbl,ssa_id)
487 :     val uses = DA.sub(usesTbl,ssa_id)
488 :     val rtl = DA.sub(rtlTbl,ssa_id)
489 :     in case rtl of
490 :     T.PHI{preds, ...} =>
491 :     showVal(hd defs)^" := phi("^listify2(preds,uses)^")"
492 :     | T.SINK{block=b,liveOut,...} =>
493 :     "sink["^block b^"]("^listify(uses, liveOut)^")"
494 :     | T.SOURCE{block=b,liveIn,...} =>
495 :     (* Only pretty print the registers that are currently live *)
496 :     let val edges = DA.sub(succTbl,ssa_id)
497 :     fun isLive r = List.exists (fn (_,_,r') => r = r') edges
498 :     fun collect([], [], ds', rs') = (rev ds', rev rs')
499 :     | collect(d::ds, r::rs, ds', rs') =
500 :     if isLive d then collect(ds, rs, d::ds', r::rs')
501 :     else collect(ds, rs, ds', rs')
502 :     val (defs, liveIn) = collect(defs, liveIn, [], [])
503 :     in "source["^block b^"]("^listify(defs, liveIn)^")"
504 :     end
505 :     | _ =>
506 :     let fun def v = showVal(List.nth(defs, v))
507 :     fun use v = showVal(List.nth(uses, v))
508 :     val ssa = #stm (RTL.showRTL{def=def, use=use,
509 :     regionDef=def, regionUse=use}) rtl
510 :     val ssa = if !showPos then
511 :     ssa^" #"^prInt(DA.sub(posTbl, ssa_id))
512 :     else ssa
513 :     in if !showAsm then asm ssa_op^" ["^ssa^"]" else ssa end
514 :     end
515 :     in show
516 :     end
517 :    
518 :     (*------------------------------------------------------------------------
519 :     * Pretty printing the rtl
520 :     *------------------------------------------------------------------------*)
521 :     fun showRTL SSA = RTL.rtlToString
522 :    
523 :     (*------------------------------------------------------------------------
524 :     * Generate a renamed variable. Propagate cellkind and gc type information
525 :     *------------------------------------------------------------------------*)
526 :     fun newRenamedVar SSA =
527 :     let val {nameTbl, cellKindTbl, gcmap, ...} = info SSA
528 :     val lookupCellKind = Intmap.map cellKindTbl
529 :     val addCellKind = Intmap.add cellKindTbl
530 :     val updateGC =
531 :     case gcmap of
532 :     NONE => (fn (r, r') => r')
533 :     | SOME m =>
534 :     let val lookup = Intmap.map m
535 :     val add = Intmap.add m
536 :     in fn (r,r') => (add(r', lookup r) handle _ => (); r')
537 :     end
538 :     fun newVar r =
539 :     let val r' = C.newVar r
540 :     in addCellKind(r', lookupCellKind r) handle _ => () ;
541 :     updateGC(r, r')
542 :     end
543 :    
544 :     in case nameTbl of
545 :     NONE => newVar
546 :     | SOME nameTbl =>
547 :     let val enterName = Intmap.add nameTbl
548 :     exception NoIndex
549 :     val indexTbl = Intmap.new(31, NoIndex)
550 :     val addIndex = Intmap.add indexTbl
551 :     val findIndex = Intmap.mapWithDefault(indexTbl,0)
552 :     fun newVarKeepName r =
553 :     let val r' = newVar r
554 :     val i = findIndex r
555 :     in addIndex(r,i+1);
556 :     enterName(r', {oldName=r, index=i});
557 :     r'
558 :     end
559 :     in newVarKeepName
560 :     end
561 :     end
562 :    
563 :     (*------------------------------------------------------------------------
564 :     * Generate variable. Propagate gc type information only.
565 :     *------------------------------------------------------------------------*)
566 :     fun newVar SSA =
567 :     let val {gcmap, ...} = info SSA
568 :     in case gcmap of
569 :     NONE => C.newVar
570 :     | SOME m =>
571 :     let val lookup = Intmap.map m
572 :     val add = Intmap.add m
573 :     in fn r => let val r' = C.newVar r
574 :     in add(r', lookup r) handle _ => (); r' end
575 :     end
576 :     end
577 :    
578 :     (*------------------------------------------------------------------------
579 :     * Create a new SSA op. The node must not already exist.
580 :     *------------------------------------------------------------------------*)
581 :     fun newOp SSA =
582 :     let val {defSiteTbl, nodeCount, ...} = info SSA
583 :     val defsTbl = defsTbl SSA
584 :     val usesTbl = usesTbl SSA
585 :     val ssaOpTbl = ssaOpTbl SSA
586 :     val blockTbl = blockTbl SSA
587 :     val posTbl = posTbl SSA
588 :     val rtlTbl = rtlTbl SSA
589 :    
590 :     fun new{id, instr, rtl, defs, uses, block, pos} =
591 :     let fun addDefSite [] = ()
592 :     | addDefSite(r::rs) =
593 :     ((*print("defSite["^showVal SSA r^"]="^i2s id^"\n");*)
594 :     DA.update(defSiteTbl,r,id);
595 :     addDefSite rs
596 :     )
597 :     in nodeCount := !nodeCount + 1;
598 :     addDefSite defs;
599 :     A.update(rtlTbl, id, rtl);
600 :     A.update(defsTbl, id, defs);
601 :     A.update(usesTbl, id, uses);
602 :     A.update(ssaOpTbl, id, instr);
603 :     A.update(blockTbl, id, block);
604 :     A.update(posTbl, id, pos);
605 :     (*print("["^i2s id^"] = "^showOp SSA id^"\n"); *)
606 :     ()
607 :     end
608 :     in new end
609 :    
610 :     (*------------------------------------------------------------------------
611 :     * Iterators
612 :     *------------------------------------------------------------------------*)
613 :     fun forallNodes SSA f =
614 :     let val blockTbl = blockTbl SSA
615 :     val n = A.length blockTbl
616 :     fun loop(i) =
617 :     if i >= n then () else
618 :     (if A.sub(blockTbl,i) >= 0 then f i else (); loop(i+1))
619 :     in loop 0 end
620 :    
621 :     fun foldNodes SSA f x =
622 :     let val {blockTbl,...} = info SSA
623 :     val n = DA.length blockTbl
624 :     val blockTbl = DA.baseArray blockTbl
625 :     fun fold(i,x) =
626 :     if i < n then fold(i+1, if A.sub(blockTbl,i) >= 0 then f(i,x) else x)
627 :     else x
628 :     in fold(0,x) end
629 :    
630 :     (*------------------------------------------------------------------------
631 :     * Insert edges
632 :     *------------------------------------------------------------------------*)
633 :     fun computeDefUseChains SSA =
634 :     let val usesTbl = usesTbl SSA
635 :     val succTbl = succTbl SSA
636 :     val defSiteTbl = defSiteTbl SSA
637 :     val blockTbl = blockTbl SSA
638 :     val n = A.length succTbl
639 :     fun iter(i, size) =
640 :     if i < n then
641 :     let fun addEdges([], size) = size
642 :     | addEdges(v::vs, size) =
643 :     if v < 0 then addEdges(vs, size)
644 :     else let val j = A.sub(defSiteTbl, v)
645 :     in (* print(i2s i^" -> "^i2s j^"\n"^
646 :     showOp SSA i^"->"^showOp SSA j^" ("^
647 :     showVal SSA v^" "^i2s v^")\n"); *)
648 :     A.update(succTbl, j, (j,i,v)::A.sub(succTbl, j));
649 :     addEdges(vs, size+1)
650 :     end
651 :     val uses = A.sub(usesTbl, i)
652 :     in iter(i+1, addEdges(uses, size))
653 :     end
654 :     else size
655 :    
656 :     val numberOfEdges = iter(0, 0)
657 :     val {edgeCount, defsTbl, ... } = info SSA
658 :     in edgeCount := numberOfEdges
659 :     end
660 :    
661 :     (*------------------------------------------------------------------
662 :     * Function to remove useless phi-node from the graph
663 :     *------------------------------------------------------------------*)
664 :     fun removeUselessPhiFunctions(SSA as G.GRAPH ssa) =
665 :     let val usesTbl = usesTbl SSA
666 :     val defsTbl = defsTbl SSA
667 :     val rtlTbl = rtlTbl SSA
668 :     val succTbl = succTbl SSA
669 :     val blockTbl = blockTbl SSA
670 :     val defSiteTbl = defSiteTbl SSA
671 :     val onWorklist = W8A.array(#capacity ssa (), 0w0)
672 :     val {nodeCount, edgeCount, ...} = info SSA
673 :     val showVal = showVal SSA
674 :     val showOp = showOp SSA
675 :    
676 :     (* Replace all uses of t defined by phi-node i to t' *)
677 :     fun removeUselessNode(i, t, t', WL) =
678 :     let (* val _ = print("Useless ["^i2s i^"] "^showOp i^" "^
679 :     showVal t^" -> "^showVal t'^"\n"); *)
680 :     val i' = A.sub(defSiteTbl, t')
681 :     fun processEdges([], es_i', size, WL) = (es_i', size, WL)
682 :     | processEdges((i,j,t)::es_i, es_i', size, WL) =
683 :     (* remove self loops; *)
684 :     if i = j
685 :     then processEdges(es_i, es_i', size-1, WL)
686 :     else
687 :     let fun renameUses [] = []
688 :     | renameUses (v::vs) =
689 :     (if v = t then t' else v)::renameUses vs
690 :     val WL = case A.sub(rtlTbl,j) of
691 :     T.PHI _ =>
692 :     if W8A.sub(onWorklist, j) = 0w0 then
693 :     (W8A.update(onWorklist, j, 0w1); j::WL)
694 :     else WL
695 :     | _ => WL
696 :     val uses_j = A.sub(usesTbl, j)
697 :     in (* print("\t"^showOp j^" =>\n\t"); *)
698 :     A.update(usesTbl, j, renameUses uses_j);
699 :     (* print(showOp j^"\n"); *)
700 :     processEdges(es_i, (i',j,t')::es_i', size, WL)
701 :     end
702 :    
703 :     (* Filter i from the use sites of i' *)
704 :     fun filterI([], es_i', size) = (es_i', size)
705 :     | filterI((e as (i',k,_))::es, es_i', size) =
706 :     if k = i then filterI(es, es_i', size-1)
707 :     else filterI(es, e::es_i', size)
708 :    
709 :     val es_i = A.sub(succTbl, i)
710 :     val es_i' = A.sub(succTbl, i')
711 :     val (es_i', size) = filterI(es_i', [], !edgeCount)
712 :     val (es_i', size, WL) = processEdges(es_i, es_i', size, WL)
713 :     in edgeCount := size;
714 :     nodeCount := !nodeCount - 1;
715 :     A.update(succTbl, i', es_i');
716 :     (* Remove node i *)
717 :     A.update(succTbl, i, []);
718 :     A.update(defsTbl, i, []);
719 :     A.update(usesTbl, i, []);
720 :     A.update(blockTbl, i, ~1);
721 :     WL
722 :     end
723 :    
724 :     fun processWorkList [] = ()
725 :     | processWorkList(i::WL) =
726 :     let val _ = W8A.update(onWorklist,i,0w0)
727 :     (* val _ = print("Processing "^i2s i^"\n") *)
728 :     val _ = if A.sub(blockTbl,i) < 0 then error(i2s i)
729 :     else ()
730 :     val [t] = A.sub(defsTbl,i)
731 :     val s = A.sub(usesTbl,i)
732 :     (* Check if i is useless *)
733 :     fun loop([],t') = removeUselessNode(i,t,t',WL)
734 :     | loop(v::vs,t') =
735 :     if v = t then loop(vs,t')
736 :     else if t' = ~1 then loop(vs,v)
737 :     else WL (* not useless *)
738 :     val WL = loop(s, ~1)
739 :     in processWorkList WL end
740 :    
741 :     fun collectPhis(i,WL) =
742 :     (case A.sub(rtlTbl,i) of
743 :     T.PHI _ => (W8A.update(onWorklist, i, 0w1); i::WL)
744 :     | _ => WL
745 :     )
746 :    
747 :     val WL = foldNodes SSA collectPhis []
748 :    
749 :     in processWorkList(WL)
750 :     end
751 :    
752 :     (*------------------------------------------------------------------------
753 :     * Remove all nodes.
754 :     * Note: no duplicates allowed.
755 :     *------------------------------------------------------------------------*)
756 :     fun removeAllNodes SSA nodes =
757 :     let val succTbl = succTbl SSA
758 :     val defsTbl = defsTbl SSA
759 :     val usesTbl = usesTbl SSA
760 :     val blockTbl = blockTbl SSA
761 :     val {edgeCount, nodeCount, garbageNodes, ...} = info SSA
762 :     fun removeAll([], nodes, edges, garbage) =
763 :     (nodeCount := nodes; edgeCount := edges; garbageNodes := garbage)
764 :     | removeAll(n::ns, nodes, edges, garbage) =
765 :     if A.sub(blockTbl, n) < 0
766 :     then removeAll(ns, nodes, edges, garbage)
767 :     else
768 :     let val outEdges = A.sub(succTbl, n)
769 :     in nodeCount := !nodeCount - 1;
770 :     A.update(blockTbl, n, ~1);
771 :     A.update(usesTbl, n, []);
772 :     A.update(defsTbl, n, []);
773 :     A.update(succTbl, n, []);
774 :     removeAll(ns, nodes-1, edges - length outEdges, n::garbage)
775 :     end
776 :     in removeAll(nodes,!nodeCount,!edgeCount,!garbageNodes)
777 :     end
778 :    
779 :     (*------------------------------------------------------------------------
780 :     * Replace all use of one value with another. Return true iff
781 :     * all uses of "from" has been replaced by "to".
782 :     * Note: The definition of "from" must dominate all uses of "to", as
783 :     * required by the SSA form.
784 :     *------------------------------------------------------------------------*)
785 :     fun replaceAllUses(SSA as G.GRAPH ssa) =
786 :     let val defSiteTbl = defSiteTbl SSA
787 :     val usesTbl = usesTbl SSA
788 :     val succTbl = succTbl SSA
789 :     val posTbl = posTbl SSA
790 :     val rtlTbl = rtlTbl SSA
791 :     val {edgeCount, ...} = info SSA
792 :    
793 :     val cellKind = Intmap.mapWithDefault(cellKindTbl SSA,C.GP)
794 :    
795 :     fun isReplaceable k = k = C.GP orelse k = C.FP
796 :    
797 :     fun replace{from, to, vn} =
798 :     isReplaceable(cellKind from) andalso
799 :     let
800 :     val old = A.sub(defSiteTbl, from)
801 :     val new = A.sub(defSiteTbl, to)
802 :    
803 :     (* val _ = print("REPLACING "^showOp SSA old^
804 :     "("^showVal SSA from^") by "^
805 :     showOp SSA new^"( "^showVal SSA to^") vn="^
806 :     i2s vn^"\n") *)
807 :     (*
808 :     * We directly manipulate the graph structure here.
809 :     * Since the number of edges does not change, there is
810 :     * no need to update the edge count.
811 :     *)
812 :     fun renameUses([], to) = []
813 :     | renameUses(r::rs, to) =
814 :     (if r = from then to else r)::renameUses(rs, to)
815 :    
816 :     fun removeUse([], es') = es'
817 :     | removeUse((e as (_,j,r))::es,es') =
818 :     if r = from then
819 :     (* Rename an argument of j *)
820 :     (replacements := !replacements + 1;
821 :     if vn < 0 (* is a constant that we are replacing *)
822 :     andalso
823 :     (case A.sub(rtlTbl, j) of
824 :     (T.PHI _ | T.SINK _ ) => true
825 :     | _ => false
826 :     ) then
827 :     (* phi or sink node *)
828 :     (A.update(usesTbl, j, renameUses(A.sub(usesTbl,j), vn));
829 :     (* print("Replacing constant: "^showOp SSA j^"\n"); *)
830 :     edgeCount := !edgeCount - 1
831 :     )
832 :     else (* normal node *)
833 :     (A.update(usesTbl, j, renameUses(A.sub(usesTbl, j), to));
834 :     A.update(succTbl, new, (new,j,to)::A.sub(succTbl, new))
835 :     );
836 :     removeUse(es,es')
837 :     )
838 :     else
839 :     removeUse(es, e::es')
840 :    
841 :     val edges = removeUse(A.sub(succTbl, old), [])
842 :     in A.update(succTbl, old, edges);
843 :     true
844 :     end
845 :    
846 :     in replace
847 :     end
848 :    
849 :     (*------------------------------------------------------------------------
850 :     * Replace the definition of value by const. This will change the
851 :     * instruction that defines value to a constant computation instruction.
852 :     * Return true iff this operation is successful.
853 :     *------------------------------------------------------------------------*)
854 :     fun foldConstant SSA =
855 :     let val constOf = const SSA
856 :     val showOp = showOp SSA
857 :     val {edgeCount, posTbl, defsTbl, usesTbl, succTbl, rtlTbl, ssaOpTbl,
858 :     defSiteTbl, minPos, blockTbl, ...} = info SSA
859 :     fun fold{value, const} =
860 :     let val i = DA.sub(defSiteTbl, value)
861 :     val defs = DA.sub(defsTbl, i)
862 :     in case (defs, constOf const) of
863 :     ([_], SP.OT.IMMED imm) => (* only one value defined; okay *)
864 :     if (case DA.sub(usesTbl, i) of
865 :     [v] => v < 0 (* already a constant! don't fold *)
866 :     | _ => false) then false
867 :     else
868 :     let (* Remove existing incoming edges *)
869 :     fun removeUses [] = ()
870 :     | removeUses(v::vs) =
871 :     if v < 0 then removeUses vs else
872 :     let val j = DA.sub(defSiteTbl, v)
873 :     fun rmv([], es') = es'
874 :     | rmv((e as (j,k,_))::es, es') =
875 :     if k = i then rmv(es, es')
876 :     else (edgeCount := !edgeCount - 1;
877 :     rmv(es, e::es'))
878 :     val succ_j = DA.sub(succTbl, j)
879 :     in DA.update(succTbl, j, rmv(succ_j, []));
880 :     removeUses vs
881 :     end
882 :    
883 :     (* val _ = print("REPLACING "^showOp i^" -> "); *)
884 :     val instr = InsnProps.loadImmed{t=value, immed=imm}
885 :     val oldRtl = DA.sub(rtlTbl, i)
886 :     val _ = DA.update(ssaOpTbl, i, instr)
887 :     val newRtl = SP.RTLProps.rtl instr
888 :     val _ = DA.update(rtlTbl, i, newRtl)
889 :     val oldUses = DA.sub(usesTbl, i)
890 :     in removeUses(oldUses);
891 :     (* now has only one input! *)
892 :     DA.update(usesTbl, i, [const]);
893 :    
894 :     (* If the instruction used to be a phi-node or
895 :     * a source node, find an appropriate place for
896 :     * this new instruction.
897 :     *)
898 :     case oldRtl of
899 :     (T.PHI _ | T.SOURCE _) =>
900 :     let val newPos = !minPos
901 :     in minPos := !minPos - 128;
902 :     DA.update(posTbl, i, newPos)
903 :     end
904 :     | _ => () (* keep the same position *)
905 :     ;
906 :     (* print(showOp i^"\n");
907 :     app (fn (_,j,_) => print ("\t"^showOp j^"\n"))
908 :     (DA.sub(succTbl, i)); *)
909 :     true
910 :     end
911 :     | _ => false (* can't fold *)
912 :     end
913 :     in fold
914 :     end
915 :    
916 :     (*------------------------------------------------------------------------
917 :     * Move an instruction from one block to another
918 :     *------------------------------------------------------------------------*)
919 :     fun moveOp SSA =
920 :     let val posTbl = posTbl SSA
921 :     val blockTbl = blockTbl SSA
922 :     val defSiteTbl = defSiteTbl SSA
923 :     val usesTbl = usesTbl SSA
924 :     val succTbl = succTbl SSA
925 :     val rtlTbl = rtlTbl SSA
926 :     val showOp = showOp SSA
927 :     val showVal = showVal SSA
928 :    
929 :     val {maxPos, minPos, ...} = info SSA
930 :    
931 :     fun mv{id, block} =
932 :     let val _ = moved := !moved + 1
933 :     fun earliest([], pos) = pos
934 :     | earliest(v::vs, pos) =
935 :     if v < 0 then earliest(vs, pos)
936 :     else let val j = A.sub(defSiteTbl,v)
937 :     val b_j = A.sub(blockTbl, j)
938 :     in if block = b_j then
939 :     (case A.sub(rtlTbl, j) of
940 :     T.PHI _ => earliest(vs, pos)
941 :     | _ => earliest(vs, Int.max(pos, A.sub(posTbl, j)))
942 :     )
943 :     else
944 :     earliest(vs, pos)
945 :     end
946 :     fun latest([], pos) = pos
947 :     | latest((_,j,_)::es, pos) =
948 :     let val b_j = A.sub(blockTbl,j)
949 :     in if block = b_j then
950 :     (case A.sub(rtlTbl, j) of
951 :     T.PHI _ => latest(es, pos)
952 :     | _ => latest(es, Int.min(pos, A.sub(posTbl, j)))
953 :     )
954 :     else
955 :     latest(es, pos)
956 :     end
957 :    
958 :     fun sanityCheck(lo, hi) =
959 :     if lo > hi then
960 :     let fun prOp j =
961 :     let val b_j = A.sub(blockTbl, j)
962 :     val pos_j = A.sub(posTbl, j)
963 :     in print("\t"^showOp j^" in block "^
964 :     i2s b_j^":"^i2s pos_j^"\n")
965 :     end
966 :     fun prUse v =
967 :     if v < 0 then print("\t"^showVal v^"\n")
968 :     else let val j = A.sub(defSiteTbl, v)
969 :     in prOp j
970 :     end
971 :     fun prDef(_,j,_) = prOp j
972 :     in print "Uses=\n"; app prUse (A.sub(usesTbl, id));
973 :     print "Defs=\n"; app prDef (A.sub(succTbl, id));
974 :     error("move "^showOp id^" lo="^i2s lo^
975 :     " hi="^i2s hi^" block="^i2s block)
976 :     end
977 :     else ()
978 :    
979 :    
980 :     val uses = A.sub(usesTbl, id)
981 :     val lo = earliest(uses, !minPos)
982 :     val hi = latest(A.sub(succTbl, id), !maxPos)
983 :     val pos = if !minPos = lo then (maxPos := !maxPos + 128; hi-1)
984 :     else if !maxPos = hi then (minPos := !minPos - 128; lo+1)
985 :     else (minPos := !minPos - 128;
986 :     maxPos := !maxPos + 128;
987 :     sanityCheck(lo, hi);
988 :     (lo + hi) div 2
989 :     )
990 :     in A.update(blockTbl, id, block);
991 :     A.update(posTbl, id, pos)
992 :     end
993 :     in mv
994 :     end
995 :    
996 :     (*------------------------------------------------------------------------
997 :     * Set the target of a conditional branch as true or false.
998 :     * This removes the branch and eliminates all unreachable code.
999 :     *------------------------------------------------------------------------*)
1000 :     fun setBranch(SSA as G.GRAPH ssa) =
1001 :     let val {cfg, ssaOpTbl, blockTbl, nodeCount, ...} = info SSA
1002 :     fun set{id, cond} =
1003 :     let val b = DA.sub(blockTbl,id)
1004 :     val jmp = CFG.setBranch(cfg, b, cond)
1005 :     in #remove_node ssa id;
1006 :     DA.update(ssaOpTbl, id, jmp);
1007 :     DA.update(blockTbl, id, b);
1008 :     nodeCount := !nodeCount + 1;
1009 :     branchesFolded := !branchesFolded + 1
1010 :     end
1011 :     in set
1012 :     end
1013 :    
1014 :     (*------------------------------------------------------------------------
1015 :     * Make sure that none of the tables have been resized
1016 :     *------------------------------------------------------------------------*)
1017 :     fun noResize SSA f x =
1018 :     let val b = blockTbl SSA
1019 :     val d = defSiteTbl SSA
1020 :     fun check() =
1021 :     (if b <> blockTbl SSA then error "node tables have changed" else ();
1022 :     if d <> defSiteTbl SSA then error "variable table has changed" else ()
1023 :     )
1024 :     in let val y = f x in check(); y end
1025 :     handle e => (check(); raise e)
1026 :     end
1027 :    
1028 :    
1029 :     (*------------------------------------------------------------------------
1030 :     * Signal that an SSA has been changed
1031 :     *------------------------------------------------------------------------*)
1032 :     fun changed SSA =
1033 :     let val {nodes, ...} = info SSA
1034 :     in nodes := NONE end
1035 :    
1036 :     (*------------------------------------------------------------------------
1037 :     * Linearize the representation
1038 :     *------------------------------------------------------------------------*)
1039 :     fun nodes SSA =
1040 :     let val {nodes, ...} = info SSA
1041 :     in case !nodes of
1042 :     SOME nodes => nodes
1043 :     | NONE => let val n = linearizeNodes SSA
1044 :     in nodes := SOME n; n end
1045 :     end
1046 :    
1047 :     and linearizeNodes SSA =
1048 :     let val G.GRAPH cfg = cfg SSA
1049 :     val N = #capacity cfg ()
1050 :    
1051 :     val blockTbl = blockTbl SSA
1052 :     val posTbl = posTbl SSA
1053 :     val rtlTbl = rtlTbl SSA
1054 :    
1055 :     val sinks = A.array(N,[])
1056 :     val sources = A.array(N,[])
1057 :     val phis = A.array(N,[])
1058 :     val ops = A.array(N,[])
1059 :    
1060 :     fun ins(n) =
1061 :     let val b = A.sub(blockTbl,n)
1062 :     in if b >= 0 then
1063 :     let val tbl =
1064 :     case A.sub(rtlTbl, n) of
1065 :     T.PHI _ => phis
1066 :     | T.SINK _ => sinks
1067 :     | T.SOURCE _ => sources
1068 :     | _ => ops
1069 :     in A.update(tbl, b, n::A.sub(tbl, b))
1070 :     end
1071 :     else ();
1072 :     ins(n-1)
1073 :     end
1074 :     fun byPos(a,b) = A.sub(posTbl,a) > A.sub(posTbl,b)
1075 :     in ins(A.length blockTbl - 1) handle Subscript => ();
1076 :     A.modify (ListMergeSort.sort byPos) ops;
1077 :     {sinks=sinks, sources=sources, phis=phis, ops=ops}
1078 :     end
1079 :    
1080 :    
1081 :     (*------------------------------------------------------------------------
1082 :     * Graphical Viewing
1083 :     *------------------------------------------------------------------------*)
1084 :     fun viewAsCFG SSA =
1085 :     let val cfg = cfg SSA
1086 :     val {graph, node, edge} = CFG.viewStyle cfg
1087 :     val showOp = showOp SSA
1088 :     val {sinks, sources, phis, ops} = nodes SSA
1089 :     fun node(b,b') =
1090 :     let val instrs = A.sub(sources, b) @
1091 :     A.sub(phis, b) @
1092 :     A.sub(ops, b) @
1093 :     A.sub(sinks, b)
1094 :     val text = String.concat (map (fn i => showOp i^"\n") instrs)
1095 :     in [L.LABEL(CFG.headerText b' ^ text)]
1096 :     end
1097 :     in L.makeLayout
1098 :     { graph = graph,
1099 :     node = node,
1100 :     edge = edge
1101 :     } cfg
1102 :     end
1103 :    
1104 :     fun viewAsSSA SSA =
1105 :     let val showOp = showOp SSA
1106 :     val showVal = showVal SSA
1107 :     fun graph _ = []
1108 :     fun node(i,_) = [L.LABEL(showOp i)]
1109 :     fun edge(_,_,v) = [L.COLOR "red",L.LABEL(showVal v)]
1110 :     in L.makeLayout
1111 :     { graph = graph,
1112 :     node = node,
1113 :     edge = edge
1114 :     } SSA
1115 :     end
1116 :    
1117 :     (*------------------------------------------------------------------------
1118 :     * Consistency checking
1119 :     *------------------------------------------------------------------------*)
1120 :     fun consistencyCheck(SSA as G.GRAPH ssa) =
1121 :     let val defSiteTbl = defSiteTbl SSA
1122 :     val usesTbl = usesTbl SSA
1123 :     val defsTbl = defsTbl SSA
1124 :     val rtlTbl = rtlTbl SSA
1125 :     val blockTbl = blockTbl SSA
1126 :     val succTbl = succTbl SSA
1127 :     val posTbl = posTbl SSA
1128 :     val Dom = dom SSA
1129 :     val showOp = showOp SSA
1130 :     val showVal = showVal SSA
1131 :     val dominates = Dom.dominates Dom
1132 :    
1133 :     val hasError = ref false
1134 :    
1135 :     fun posOf i =
1136 :     case A.sub(rtlTbl,i) of
1137 :     T.PHI _ => ~10000000
1138 :     | _ => A.sub(posTbl,i)
1139 :    
1140 :     fun bug(i,msg) =
1141 :     (print("ERROR [b"^i2s(A.sub(blockTbl,i))^":p"^i2s(posOf i)^
1142 :     ":"^i2s i^"] "^showOp i^": "^msg^"\n");
1143 :     hasError := true
1144 :     )
1145 :    
1146 :     fun checkDefs i =
1147 :     let val defs = A.sub(defsTbl, i)
1148 :     in app (fn r =>
1149 :     let val i' = A.sub(defSiteTbl,r)
1150 :     in if i <> i' then
1151 :     bug(i,"wrong def site "^i2s i'^" for "^
1152 :     showVal r)
1153 :     else ()
1154 :     end)
1155 :     defs
1156 :     end
1157 :    
1158 :     fun checkBlock(i, block) =
1159 :     if A.sub(blockTbl,i) <> block then bug(i,"wrong block") else ()
1160 :    
1161 :     fun printEdge (i,j,r) =
1162 :     print("\t"^i2s i^" -> "^i2s j^" "^showVal r^"\n")
1163 :    
1164 :     fun domTest(i,j,r) =
1165 :     let val b_i = A.sub(blockTbl, i)
1166 :     val b_j = A.sub(blockTbl, j)
1167 :    
1168 :     val ok =
1169 :     case A.sub(rtlTbl,j) of
1170 :     T.PHI{preds, ...} =>
1171 :     let fun scan(p::preds, v::vs) =
1172 :     r = v andalso dominates(b_i,p) orelse scan(preds, vs)
1173 :     | scan _ = false
1174 :     in scan(preds, A.sub(usesTbl,j)) end
1175 :     | _ => if b_i = b_j then posOf i < posOf j
1176 :     else dominates(b_i, b_j)
1177 :     in if ok then ()
1178 :     else bug(i,showVal r^
1179 :     " does not dominate "^showOp j^
1180 :     " b"^i2s(A.sub(blockTbl,j))^" p"^i2s(posOf j))
1181 :     end
1182 :    
1183 :     fun checkEdges i =
1184 :     let val defs = A.sub(defsTbl, i)
1185 :     val edges = A.sub(succTbl, i)
1186 :     fun checkEdge(i',j',r) =
1187 :     (if i' <> i then bug(i, "bad edge source") else ();
1188 :     if A.sub(blockTbl,j') < 0 then
1189 :     bug(i, "use in node "^i2s j'^" is dead") else ();
1190 :     if not(List.exists (fn r' => r = r') defs) then
1191 :     bug(i, showVal r^" is not a definition") else ();
1192 :     if not(List.exists (fn r' => r = r')
1193 :     (A.sub(usesTbl,j'))) then
1194 :     bug(i, showOp j'^" has no use of "^showVal r) else ();
1195 :     domTest(i',j',r)
1196 :     )
1197 :     in app checkEdge edges
1198 :     end
1199 :    
1200 :     fun showVals(title,rs) =
1201 :     print(title^"="^foldr (fn (r,"") => showVal r
1202 :     | (r,s) => showVal r^","^s) "" rs^
1203 :     " ("^i2s(length rs)^")\n")
1204 :    
1205 :     fun checkLiveIn(i, liveIn) =
1206 :     let val defs = A.sub(defsTbl, i)
1207 :     val n = length defs
1208 :     val m = length liveIn
1209 :     in if n <> m then
1210 :     (bug(i, "|liveIn| <> |defs|");
1211 :     showVals("liveIn", liveIn);
1212 :     showVals("defs", defs)
1213 :     )
1214 :     else ()
1215 :     end
1216 :    
1217 :     fun checkLiveOut(i, liveOut) =
1218 :     let val uses = A.sub(usesTbl, i)
1219 :     val n = length uses
1220 :     val m = length liveOut
1221 :     in if n <> m then
1222 :     (bug(i, "|liveOut| <> |uses|");
1223 :     showVals("liveOut", liveOut);
1224 :     showVals("uses", uses)
1225 :     )
1226 :     else ()
1227 :     end
1228 :    
1229 :     fun checkNode(i, _) =
1230 :     case A.sub(rtlTbl, i) of
1231 :     T.PHI{preds, block} => checkPhi(i, preds, block)
1232 :     | T.SOURCE{liveIn, block} => checkSource(i, liveIn, block)
1233 :     | T.SINK{liveOut, block} => checkSink(i, liveOut, block)
1234 :     | _ => checkOp i
1235 :    
1236 :     and checkPhi(i, preds, block) =
1237 :     (checkBlock(i,block);
1238 :     checkDefs i;
1239 :     checkEdges i;
1240 :     let val n = length preds
1241 :     val m = length(A.sub(usesTbl, i))
1242 :     in if m <> n then
1243 :     bug(i, "|preds|="^i2s n^" |uses|="^i2s m)
1244 :     else ()
1245 :     end
1246 :     )
1247 :    
1248 :     and checkSource(i, liveIn, block) =
1249 :     (checkBlock(i, block);
1250 :     checkLiveIn(i, liveIn);
1251 :     if length(A.sub(usesTbl,i)) <> 0 then
1252 :     bug(i,"|uses| <> 0")
1253 :     else ();
1254 :     checkDefs i;
1255 :     checkEdges i
1256 :     )
1257 :    
1258 :     and checkSink(i, liveOut, block) =
1259 :     (checkBlock(i, block);
1260 :     checkLiveOut(i, liveOut);
1261 :     if length(A.sub(defsTbl,i)) <> 0 then
1262 :     bug(i,"|defs| <> 0")
1263 :     else ();
1264 :     if length(A.sub(succTbl,i)) <> 0 then
1265 :     (bug(i,"|succs| <> 0" );
1266 :     app printEdge (A.sub(succTbl,i))
1267 :     )
1268 :     else ();
1269 :     checkDefs i;
1270 :     checkEdges i
1271 :     )
1272 :    
1273 :     and checkOp(i) =
1274 :     (checkDefs i;
1275 :     checkEdges i
1276 :     )
1277 :    
1278 :     in #forall_nodes ssa checkNode;
1279 :     if !hasError then error "SSA graph is corrupted" else ()
1280 :     end
1281 :     end

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