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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(* cfgView.sml -- graphical viewing utilities for cfg
*
* Copyright (c) 2001 Bell Laboratories.
*)
functor CFGView
(structure Asm : INSTRUCTION_EMITTER
structure CFG : CONTROL_FLOW_GRAPH
where I = Asm.I
and P = Asm.S.P
) : CFG_VIEW =
struct
structure L = GraphLayout
structure CFG = CFG
structure G = Graph
structure W = Freq
structure S = Asm.S
fun nl() = TextIO.output(!AsmStream.asmOutStream,"\n")
fun kindName CFG.START = "START"
| kindName CFG.STOP = "STOP"
| kindName CFG.NORMAL = "Block"
fun emitHeader (S.STREAM{comment,annotation,...})
(CFG.BLOCK{id,kind,freq,annotations,...}) =
(comment(kindName kind ^"["^Int.toString id^
"] ("^W.toString (!freq)^")");
nl();
app annotation (!annotations)
)
fun emitFooter (S.STREAM{comment,...}) (CFG.BLOCK{annotations,...}) =
(case #get CFG.LIVEOUT (!annotations) of
SOME s =>
let val regs = String.tokens Char.isSpace(CellsBasis.CellSet.toString s)
val K = 7
fun f(_,[],s,l) = s::l
| f(0,vs,s,l) = f(K,vs," ",s::l)
| f(n,[v],s,l) = v^s::l
| f(n,v::vs,s,l) = f(n-1,vs,s^" "^v,l)
val text = rev(f(K,regs,"",[]))
in app (fn c => (comment c; nl())) text
end
| NONE => ()
) handle Overflow => print("Bad footer\n")
fun emitStuff outline annotations (block as CFG.BLOCK{insns,labels,...}) =
let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
Asm.makeStream annotations
in emitHeader S block;
app defineLabel (!labels);
if outline then () else app emit (rev (!insns));
emitFooter S block
end
val emit = emitStuff false
val emitOutline = emitStuff true []
fun getString f x =
let val buffer = StringOutStream.mkStreamBuf()
val S = StringOutStream.openStringOut buffer
val _ = AsmStream.withStream S f x
in StringOutStream.getString buffer end
fun show_block an block =
let val text = getString (emit an) block
in foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
(String.tokens (fn #" " => true | _ => false) text)
end
fun headerText block = getString
(fn b => emitHeader (Asm.makeStream []) b) block
fun footerText block = getString
(fn b => emitFooter (Asm.makeStream []) b) block
fun getStyle a = (case #get L.STYLE (!a) of SOME l => l | NONE => [])
val green = L.COLOR "green"
val red = L.COLOR "red"
val yellow = L.COLOR "yellow"
val show_edge = CFG.show_edge
fun edgeStyle(i,j,e as CFG.EDGE{k,a,...}) =
let val a = L.LABEL(show_edge e) :: getStyle a
in case k of
(CFG.ENTRY | CFG.EXIT) => green :: a
| (CFG.FALLSTHRU | CFG.BRANCH false) => yellow :: a
| _ => red :: a
end
val outline = MLRiscControl.getFlag "view-outline"
fun annotations(G.GRAPH{graph_info=CFG.INFO{annotations=a,...},...}) = a
fun viewStyle cfg =
let val an = !(annotations cfg)
fun node (n,b as CFG.BLOCK{annotations,...}) =
if !outline then
L.LABEL(getString emitOutline b) :: getStyle annotations
else
L.LABEL(show_block an b) :: getStyle annotations
in { graph = fn _ => [],
edge = edgeStyle,
node = node
}
end
fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg
fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
let val an = !(annotations cfg)
fun node(n,b as CFG.BLOCK{annotations,...}) =
if #has_node subgraph n then
L.LABEL(show_block an b) :: getStyle annotations
else
L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations
fun edge(i,j,e) =
if #has_edge subgraph (i,j) then edgeStyle(i,j,e)
else [L.EDGEPATTERN "dotted"]
in L.makeLayout {graph = fn _ => [],
edge = edge,
node = node} cfg
end
end
|
