utils/heap-view/HpView2.lhs

   1 > module Main where
   2 > import PreludeGlaST
   3 > import LibSystem
   4
   5 > import Parse
   6
   7 Program to do continuous heap profile.
   8
   9 Bad News:
  10
  11     The ghc runtime system writes its heap profile information to a
  12     named file (<progname>.hp).  The program merrily reads its input
  13     from a named file but has no way of synchronising with the program
  14     generating the file.
  15
  16 Good News 0:
  17
  18     You can save the heap profile to a file:
  19
  20             <progname> <parameters> +RTS -h -i0.1 -RTS
  21
  22     and then run:
  23
  24             hpView2 <progname>.hp Main:<functionname>
  25
  26     This is very like using hp2ps but much more exciting because you
  27     never know what's going to happen next :-)
  28
  29
  30 Good News 1:
  31
  32     The prophet Stallman has blessed us with the shell command @mkfifo@
  33     (is there a standard Unix version?) which creates a named pipe.  If we
  34     instead run:
  35
  36             mkfifo <progname>.hp
  37             hpView2 <progname>.hp Main:<functionname> &
  38             <progname> <parameters> +RTS -h -i0.1 -RTS
  39             rm <progname>.hp
  40
  41     Good Things happen.
  42
  43     NB If you don't delete the pipe, Bad Things happen: the program
  44     writes profiling info to the pipe until the pipe fills up then it
  45     blocks...
  46
  47
  48 Right, on with the program:
  49
  50 Here's an example heap profile
  51
  52           JOB "a.out -p"
  53           DATE "Fri Apr 17 11:43:45 1992"
  54           SAMPLE_UNIT "seconds"
  55           VALUE_UNIT "bytes"
  56           BEGIN_SAMPLE 0.00
  57             SYSTEM 24
  58           END_SAMPLE 0.00
  59           BEGIN_SAMPLE 1.00
  60             elim 180
  61             insert 24
  62             intersect 12
  63             disin 60
  64             main 12
  65             reduce 20
  66             SYSTEM 12
  67           END_SAMPLE 1.00
  68           MARK 1.50
  69           MARK 1.75
  70           MARK 1.80
  71           BEGIN_SAMPLE 2.00
  72             elim 192
  73             insert 24
  74             intersect 12
  75             disin 84
  76             main 12
  77             SYSTEM 24
  78           END_SAMPLE 2.00
  79           BEGIN_SAMPLE 2.82
  80           END_SAMPLE 2.82
  81
  82 In HpView.lhs, I had a fancy parser to handle all this - but it was
  83 immensely inefficient.  We can produce something a lot more efficient
  84 and robust very easily by noting that the only lines we care about
  85 have precisely two entries on them.
  86
  87 > type Line = String
  88 > type Word = String
  89 > type Sample = (Float, [(String, Int)])
  90
  91 > parseProfile :: [[Word]] -> [Sample]
  92 > parseProfile [] = []
  93 > parseProfile ([keyword, time]:lines) | keyword == "BEGIN_SAMPLE" =
  94 >       let (sample,rest) = parseSample lines
  95 >       in
  96 >       (read time, sample) : parseProfile rest
  97 > parseProfile (_:xs) = parseProfile xs
  98
  99 > parseSample :: [[Word]] -> ([(String,Int)],[[Word]])
 100 > parseSample ([word, count]:lines) =
 101 >       if word == "END_SAMPLE"
 102 >       then ([], lines)
 103 >       else let (samples, rest) = parseSample lines
 104 >            in ( (word, read count):samples,  rest )
 105 > parseSample duff_lines = ([],duff_lines)
 106
 107 > screen_size = 200
 108
 109 > main :: IO ()
 110 > main =
 111 >       getArgs                                 >>= \ r ->
 112 >       case r of
 113 >         [filename, ident] ->
 114 >               xInitialise [] screen_size screen_size  >>
 115 >               readFile filename                       >>= \ hp ->
 116 >               let samples = parseProfile (map words (lines hp))
 117 >                   totals = [ sum [ s | (_,s) <- ss ] | (t,ss) <- samples ]
 118 >
 119 >                   ts = map scale totals
 120 >                   is = map scale (slice samples ident)
 121 >               in
 122 >               graphloop2 (is, []) (ts, [])
 123 >         _ -> error "usage: hpView2 file identifier\n"
 124
 125 For the example I'm running this on, the following scale does nicely.
 126
 127 > scale :: Int -> Float
 128 > scale n = (fromInt n) / 10000.0
 129
 130 Slice drawing stuff... shows profile for each identifier (Ignores time
 131 info in this version...)
 132
 133 > slice :: [Sample] -> String -> [Int]
 134 > slice samples ident =
 135 >       [ c | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
 136
 137 > lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
 138 > lookupPairs ((a', b') : hs) a b =
 139 >       if a == a' then b' else lookupPairs hs a b
 140 > lookupPairs [] a b = b
 141
 142 Number of samples to display on screen
 143
 144 > n :: Int
 145 > n = 40
 146
 147 Graph-drawing loop.  Get's the data for the particular identifier and
 148 the total usage, scales to get total to fit screen and draws them.
 149
 150 > graphloop2 :: ([Float], [Float]) -> ([Float], [Float]) -> IO ()
 151 > graphloop2 (i:is,is') (t:ts, ts') =
 152 >       let is'' = take n (i:is')
 153 >           ts'' = take n (t:ts')
 154 >
 155 >           -- scaling information:
 156 >           m = maximum ts''
 157 >           y_scale = (floor m) + 1
 158 >           y_scale' = fromInt y_scale
 159 >       in
 160 >       xCls                                            >>
 161 >       drawScales y_scale                              >>
 162 >       draw x_coords [ x / y_scale' | x <- is'' ]      >>
 163 >       draw x_coords [ x / y_scale' | x <- ts'' ]      >>
 164 >       xHandleEvent                                    >>
 165 >       graphloop2 (is,is'') (ts, ts'')
 166 > graphloop2 _ _ =
 167 >       return ()
 168
 169 > x_coords :: [Float]
 170 > x_coords = [ 0.0, 1 / (fromInt n) .. ]
 171
 172 Note: unpleasant as it is, the code cannot be simplified to something
 173 like the following (which has scope for changing draw to take a list
 174 of pairs).  The problem is that the graph won't start to be drawn
 175 until the first @n@ values are available. (Is there also a danger of
 176 clearing the screen while waiting for the next input value?)  A
 177 possible alternative solution is to keep count of how many values have
 178 actually been received.
 179
 180 < graphloop2 :: [Float] -> [Float] -> IO ()
 181 < graphloop2 [] =
 182 <       return ()
 183 < graphloop2 ys =
 184 <       let ys' = take n ys
 185 <           m = maximum ys'
 186 <           y_scale = (floor m) + 1
 187 <           y_scale' = fromInt y_scale
 188 <       in
 189 <       xCls                                            >>
 190 <       drawScales y_scale                              >>
 191 <       draw x_coords [ x / y_scale' | x <- ys' ]       >>
 192 <       xHandleEvent                                    >>
 193 <       graphloop2 (tail ys)
 194
 195 Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
 196
 197 > draw :: [Float] -> [Float] -> IO ()
 198 > draw xs ys = drawPoly (zip xs' (reverse ys'))
 199 >  where
 200 >   xs' = [ floor (x * sz) | x <- xs ]
 201 >   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
 202 >   sz = fromInt screen_size
 203
 204 > drawPoly :: [(Int, Int)] -> IO ()
 205 > drawPoly ((x1,y1):(x2,y2):poly) =
 206 >       xDrawLine x1 y1 x2 y2           >>
 207 >       drawPoly ((x2,y2):poly)
 208 > drawPoly _ = return ()
 209
 210 Draw horizontal line at major points on y-axis.
 211
 212 > drawScales :: Int -> IO ()
 213 > drawScales y_scale =
 214 >       sequence (map drawScale ys)     >>
 215 >       return ()
 216 >  where
 217 >   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
 218
 219 > drawScale :: Float -> IO ()
 220 > drawScale y =
 221 >       let y' = floor ((1.0 - y) * (fromInt screen_size))
 222 >       in
 223 >       xDrawLine 0 y' screen_size y'
 224
 225 >#include "common-bits"