1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(*
* This is a simple module for viewing a cluster graph graphically.
* This is meant to be used only by those of you who don't want to
* migrate to the CFG data structure.
*
* -- Allen
*)
functor ClusterViewer
(structure ClusterGraph : CLUSTER_GRAPH
structure GraphViewer : GRAPH_VIEWER
structure Asm : INSTRUCTION_EMITTER
sharing ClusterGraph.F.I = Asm.I
) : CLUSTER_VIEWER =
struct
structure ClusterGraph = ClusterGraph
structure F = ClusterGraph.F
structure W = ClusterGraph.W
structure L = GraphLayout
structure FMT = FormatInstruction(Asm)
structure G = Graph
val outline = MLRiscControl.getFlag "view-outline"
fun view(clusterGraph as G.GRAPH cfg) =
let val F.CLUSTER{annotations,...} = ClusterGraph.cluster clusterGraph
val toString = FMT.toString (!annotations)
fun graph _ = []
val red = L.COLOR "red"
val yellow = L.COLOR "yellow"
val green = L.COLOR "green"
val ENTRY = hd(#entries cfg ())
val EXIT = hd(#exits cfg ())
fun edge(i,j,ref w) =
let val label = L.LABEL(W.toString w)
val color =
if i = ENTRY orelse j = EXIT then green (* special edge *)
else if i+1 = j then yellow (* fallsthru *)
else red
in [label, color] end
fun title(blknum,ref freq) =
" "^Int.toString blknum^" ("^W.toString freq^")"
fun ann(annotations) =
List.foldl(fn (a,l) => "/* "^Annotations.toString a^" */\n"^l) ""
(!annotations)
fun node(_,F.ENTRY{blknum,freq,...}) =
[L.LABEL("entry"^title(blknum,freq)^"\n"^ann(annotations))]
| node(_,F.EXIT{blknum,freq,...}) =
[L.LABEL("exit"^title(blknum,freq))]
| node(_,F.BBLOCK{annotations,blknum,freq,insns,...}) =
[L.LABEL(title(blknum,freq)^"\n"^
ann(annotations)^
(if !outline then "" else
List.foldl (fn (i,t) =>
let val text = toString i
in if text = "" then t else text^"\n"^t end
) "" (!insns)))]
| node (_,_) = [L.LABEL "???"]
in GraphViewer.view
(L.makeLayout{graph=graph, edge=edge, node=node} clusterGraph)
end
end
|
