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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
> module Main where
> import PreludeGlaST
> import LibSystem
> import Parse
Program to do continuous heap profile.
Bad News:
The ghc runtime system writes its heap profile information to a
named file (<progname>.hp). The program merrily reads its input
from a named file but has no way of synchronising with the program
generating the file.
Good News 0:
You can save the heap profile to a file:
<progname> <parameters> +RTS -h -i0.1 -RTS
and then run:
hpView2 <progname>.hp Main:<functionname>
This is very like using hp2ps but much more exciting because you
never know what's going to happen next :-)
Good News 1:
The prophet Stallman has blessed us with the shell command @mkfifo@
(is there a standard Unix version?) which creates a named pipe. If we
instead run:
mkfifo <progname>.hp
hpView2 <progname>.hp Main:<functionname> &
<progname> <parameters> +RTS -h -i0.1 -RTS
rm <progname>.hp
Good Things happen.
NB If you don't delete the pipe, Bad Things happen: the program
writes profiling info to the pipe until the pipe fills up then it
blocks...
Right, on with the program:
Here's an example heap profile
JOB "a.out -p"
DATE "Fri Apr 17 11:43:45 1992"
SAMPLE_UNIT "seconds"
VALUE_UNIT "bytes"
BEGIN_SAMPLE 0.00
SYSTEM 24
END_SAMPLE 0.00
BEGIN_SAMPLE 1.00
elim 180
insert 24
intersect 12
disin 60
main 12
reduce 20
SYSTEM 12
END_SAMPLE 1.00
MARK 1.50
MARK 1.75
MARK 1.80
BEGIN_SAMPLE 2.00
elim 192
insert 24
intersect 12
disin 84
main 12
SYSTEM 24
END_SAMPLE 2.00
BEGIN_SAMPLE 2.82
END_SAMPLE 2.82
In HpView.lhs, I had a fancy parser to handle all this - but it was
immensely inefficient. We can produce something a lot more efficient
and robust very easily by noting that the only lines we care about
have precisely two entries on them.
> type Line = String
> type Word = String
> type Sample = (Float, [(String, Int)])
> parseProfile :: [[Word]] -> [Sample]
> parseProfile [] = []
> parseProfile ([keyword, time]:lines) | keyword == "BEGIN_SAMPLE" =
> let (sample,rest) = parseSample lines
> in
> (read time, sample) : parseProfile rest
> parseProfile (_:xs) = parseProfile xs
> parseSample :: [[Word]] -> ([(String,Int)],[[Word]])
> parseSample ([word, count]:lines) =
> if word == "END_SAMPLE"
> then ([], lines)
> else let (samples, rest) = parseSample lines
> in ( (word, read count):samples, rest )
> parseSample duff_lines = ([],duff_lines)
> screen_size = 200
> main :: IO ()
> main =
> getArgs >>= \ r ->
> case r of
> [filename, ident] ->
> xInitialise [] screen_size screen_size >>
> readFile filename >>= \ hp ->
> let samples = parseProfile (map words (lines hp))
> totals = [ sum [ s | (_,s) <- ss ] | (t,ss) <- samples ]
>
> ts = map scale totals
> is = map scale (slice samples ident)
> in
> graphloop2 (is, []) (ts, [])
> _ -> error "usage: hpView2 file identifier\n"
For the example I'm running this on, the following scale does nicely.
> scale :: Int -> Float
> scale n = (fromInt n) / 10000.0
Slice drawing stuff... shows profile for each identifier (Ignores time
info in this version...)
> slice :: [Sample] -> String -> [Int]
> slice samples ident =
> [ c | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
> lookupPairs ((a', b') : hs) a b =
> if a == a' then b' else lookupPairs hs a b
> lookupPairs [] a b = b
Number of samples to display on screen
> n :: Int
> n = 40
Graph-drawing loop. Get's the data for the particular identifier and
the total usage, scales to get total to fit screen and draws them.
> graphloop2 :: ([Float], [Float]) -> ([Float], [Float]) -> IO ()
> graphloop2 (i:is,is') (t:ts, ts') =
> let is'' = take n (i:is')
> ts'' = take n (t:ts')
>
> -- scaling information:
> m = maximum ts''
> y_scale = (floor m) + 1
> y_scale' = fromInt y_scale
> in
> xCls >>
> drawScales y_scale >>
> draw x_coords [ x / y_scale' | x <- is'' ] >>
> draw x_coords [ x / y_scale' | x <- ts'' ] >>
> xHandleEvent >>
> graphloop2 (is,is'') (ts, ts'')
> graphloop2 _ _ =
> return ()
> x_coords :: [Float]
> x_coords = [ 0.0, 1 / (fromInt n) .. ]
Note: unpleasant as it is, the code cannot be simplified to something
like the following (which has scope for changing draw to take a list
of pairs). The problem is that the graph won't start to be drawn
until the first @n@ values are available. (Is there also a danger of
clearing the screen while waiting for the next input value?) A
possible alternative solution is to keep count of how many values have
actually been received.
< graphloop2 :: [Float] -> [Float] -> IO ()
< graphloop2 [] =
< return ()
< graphloop2 ys =
< let ys' = take n ys
< m = maximum ys'
< y_scale = (floor m) + 1
< y_scale' = fromInt y_scale
< in
< xCls >>
< drawScales y_scale >>
< draw x_coords [ x / y_scale' | x <- ys' ] >>
< xHandleEvent >>
< graphloop2 (tail ys)
Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
> draw :: [Float] -> [Float] -> IO ()
> draw xs ys = drawPoly (zip xs' (reverse ys'))
> where
> xs' = [ floor (x * sz) | x <- xs ]
> ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
> sz = fromInt screen_size
> drawPoly :: [(Int, Int)] -> IO ()
> drawPoly ((x1,y1):(x2,y2):poly) =
> xDrawLine x1 y1 x2 y2 >>
> drawPoly ((x2,y2):poly)
> drawPoly _ = return ()
Draw horizontal line at major points on y-axis.
> drawScales :: Int -> IO ()
> drawScales y_scale =
> sequence (map drawScale ys) >>
> return ()
> where
> ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
> drawScale :: Float -> IO ()
> drawScale y =
> let y' = floor ((1.0 - y) * (fromInt screen_size))
> in
> xDrawLine 0 y' screen_size y'
>#include "common-bits"
|
