utils/heap-view/HpView.lhs

   1 > module Main where
   2 > import PreludeGlaST
   3 > import LibSystem
   4
   5 > import Parse
   6
   7 Program to interpret a heap profile.
   8
   9 Started 28/11/93: parsing of profile
  10 Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added
  11
  12 To be done:
  13
  14 0) think about where I want to go with this
  15 1) further processing... sorting, filtering, ...
  16 2) get dynamic display
  17 3) maybe use widgets
  18
  19 Here's an example heap profile
  20
  21           JOB "a.out -p"
  22           DATE "Fri Apr 17 11:43:45 1992"
  23           SAMPLE_UNIT "seconds"
  24           VALUE_UNIT "bytes"
  25           BEGIN_SAMPLE 0.00
  26             SYSTEM 24
  27           END_SAMPLE 0.00
  28           BEGIN_SAMPLE 1.00
  29             elim 180
  30             insert 24
  31             intersect 12
  32             disin 60
  33             main 12
  34             reduce 20
  35             SYSTEM 12
  36           END_SAMPLE 1.00
  37           MARK 1.50
  38           MARK 1.75
  39           MARK 1.80
  40           BEGIN_SAMPLE 2.00
  41             elim 192
  42             insert 24
  43             intersect 12
  44             disin 84
  45             main 12
  46             SYSTEM 24
  47           END_SAMPLE 2.00
  48           BEGIN_SAMPLE 2.82
  49           END_SAMPLE 2.82
  50
  51 By inspection, the format seems to be:
  52
  53 profile :== header { sample }
  54 header :== job date { unit }
  55 job :== "JOB" command
  56 date :== "DATE" dte
  57 unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string
  58
  59 sample :== samp | mark
  60 samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time
  61 pairs :== identifer count
  62 mark :== "MARK" time
  63
  64 command :== string
  65 dte :== string
  66 time :== float
  67 count :== integer
  68
  69 But, this doesn't indicate the line structure.  The simplest way to do
  70 this is to treat each line as a single token --- for which the
  71 following parser is useful:
  72
  73 Special purpose parser that recognises a string if it matches a given
  74 prefix and returns the remainder.
  75
  76 > prefixP :: String -> P String String
  77 > prefixP p =
  78 >       itemP                   `thenP` \ a ->
  79 >       let (p',a') = splitAt (length p) a
  80 >       in      if p == p'
  81 >               then unitP a'
  82 >               else zeroP
  83
  84
  85 To begin with I want to parse a profile into a list of readings for
  86 each identifier at each time.
  87
  88 > type Sample = (Float, [(String, Int)])
  89
  90 > type Line = String
  91
  92
  93 > profile :: P Line [Sample]
  94 > profile =
  95 >       header                  `thenP_`
  96 >       zeroOrMoreP sample
  97
  98 > header :: P Line ()
  99 > header =
 100 >       job                     `thenP_`
 101 >       date                    `thenP_`
 102 >       zeroOrMoreP unit        `thenP_`
 103 >       unitP ()
 104
 105 > job :: P Line String
 106 > job = prefixP "JOB "
 107
 108 > date :: P Line String
 109 > date = prefixP "DATE "
 110
 111 > unit :: P Line String
 112 > unit =
 113 >       ( prefixP "SAMPLE_UNIT " )
 114 >       `plusP`
 115 >       ( prefixP "VALUE_UNIT " )
 116
 117 > sample :: P Line Sample
 118 > sample =
 119 >       samp `plusP` mark
 120
 121 > mark :: P Line Sample
 122 > mark =
 123 >       prefixP "MARK "         `thenP` \ time ->
 124 >       unitP (read time, [])
 125
 126 ToDo: check that @time1 == time2@
 127
 128 > samp :: P Line Sample
 129 > samp =
 130 >       prefixP "BEGIN_SAMPLE "         `thenP` \ time1 ->
 131 >       zeroOrMoreP pair                `thenP` \ pairs ->
 132 >       prefixP "END_SAMPLE "           `thenP` \ time2 ->
 133 >       unitP (read time1, pairs)
 134
 135 > pair :: P Line (String, Int)
 136 > pair =
 137 >       prefixP "  "                    `thenP` \ sample_line ->
 138 >       let [identifier,count] = words sample_line
 139 >       in unitP (identifier, read count)
 140
 141 This test works fine
 142
 143 > {-
 144 > test :: String -> String
 145 > test str = ppSamples (theP profile (lines str))
 146
 147 > test1 = test example
 148
 149 > test2 :: String -> Dialogue
 150 > test2 file =
 151 >       readFile file                           exit
 152 >       (\ hp -> appendChan stdout (test hp)    exit
 153 >       done)
 154 > -}
 155
 156 Inefficient pretty-printer (uses ++ excessively)
 157
 158 > ppSamples :: [ Sample ] -> String
 159 > ppSamples = unlines . map ppSample
 160
 161 > ppSample :: Sample -> String
 162 > ppSample (time, samps) =
 163 >       (show time) ++ unwords (map ppSamp samps)
 164
 165 > ppSamp :: (String, Int) -> String
 166 > ppSamp (identifier, count) = identifier ++ ":" ++ show count
 167
 168 To get the test1 to work in gofer, you need to fiddle with the input
 169 a bit to get over Gofer's lack of string-parsing code.
 170
 171 > example =
 172 >  "JOB \"a.out -p\"\n" ++
 173 >  "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++
 174 >  "SAMPLE_UNIT \"seconds\"\n" ++
 175 >  "VALUE_UNIT \"bytes\"\n" ++
 176 >  "BEGIN_SAMPLE 0.00\n" ++
 177 >  "  SYSTEM 24\n" ++
 178 >  "END_SAMPLE 0.00\n" ++
 179 >  "BEGIN_SAMPLE 1.00\n" ++
 180 >  "  elim 180\n" ++
 181 >  "  insert 24\n" ++
 182 >  "  intersect 12\n" ++
 183 >  "  disin 60\n" ++
 184 >  "  main 12\n" ++
 185 >  "  reduce 20\n" ++
 186 >  "  SYSTEM 12\n" ++
 187 >  "END_SAMPLE 1.00\n" ++
 188 >  "MARK 1.50\n" ++
 189 >  "MARK 1.75\n" ++
 190 >  "MARK 1.80\n" ++
 191 >  "BEGIN_SAMPLE 2.00\n" ++
 192 >  "  elim 192\n" ++
 193 >  "  insert 24\n" ++
 194 >  "  intersect 12\n" ++
 195 >  "  disin 84\n" ++
 196 >  "  main 12\n" ++
 197 >  "  SYSTEM 24\n" ++
 198 >  "END_SAMPLE 2.00\n" ++
 199 >  "BEGIN_SAMPLE 2.82\n" ++
 200 >  "END_SAMPLE 2.82"
 201
 202
 203
 204
 205 Hack to let me test this code... Gofer doesn't have integer parsing built in.
 206
 207 > {-
 208 > read :: String -> Int
 209 > read s = 0
 210 > -}
 211
 212 > screen_size = 200
 213
 214 ToDo:
 215
 216 1) the efficiency of finding slices can probably be dramatically
 217    improved... if it matters.
 218
 219 2) the scaling should probably depend on the slices used
 220
 221 3) labelling graphs, colour, ...
 222
 223 4) responding to resize events
 224
 225 > main :: IO ()
 226 > main =
 227 >       getArgs                         >>= \ r ->
 228 >       case r of
 229 >         filename:idents ->
 230 >               readFile filename       >>= \ hp ->
 231 >               let samples = theP profile (lines hp)
 232 >
 233 >                   times = [ t | (t,ss) <- samples ]
 234 >                   names = [ n | (t,ss) <- samples, (n,c) <- ss ]
 235 >                   counts = [ c | (t,ss) <- samples, (n,c) <- ss ]
 236 >
 237 >                   time = maximum times
 238 >                   x_scale = (fromInt screen_size) / time
 239 >
 240 >                   max_count = maximum counts
 241 >                   y_scale = (fromInt screen_size) / (fromInt max_count)
 242 >
 243 >                   slices = map (slice samples) idents
 244 >               in
 245 >               xInitialise [] screen_size screen_size              >>
 246 > --            drawHeap x_scale y_scale samples                    >>
 247 >               sequence (map (drawSlice x_scale y_scale) slices)   >>
 248 >               freeze
 249 >         _ -> error "usage: hpView filename identifiers\n"
 250
 251 > freeze :: IO ()
 252 > freeze =
 253 >       xHandleEvent                            >>
 254 >       usleep 100                              >>
 255 >       freeze
 256
 257
 258 Slice drawing stuff... shows profile for each identifier
 259
 260 > slice :: [Sample] -> String -> [(Float,Int)]
 261 > slice samples ident =
 262 >       [ (t,c) | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
 263
 264 > lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
 265 > lookupPairs ((a', b') : hs) a b =
 266 >       if a == a' then b' else lookupPairs hs a b
 267 > lookupPairs [] a b = b
 268
 269 > drawSlice :: Float -> Float -> [(Float,Int)] -> IO ()
 270 > drawSlice x_scale y_scale slc =
 271 >       drawPoly
 272 >       [ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ]
 273
 274 > drawPoly :: [(Int, Int)] -> IO ()
 275 > drawPoly ((x1,y1):(x2,y2):poly) =
 276 >       xDrawLine x1 y1 x2 y2           >>
 277 >       drawPoly ((x2,y2):poly)
 278 > drawPoly _ = return ()
 279
 280
 281 Very simple heap profiler... doesn't do a proper job at all.  Good for
 282 testing.
 283
 284 > drawHeap :: Float -> Float -> [Sample] -> IO ()
 285 > drawHeap x_scale y_scale samples =
 286 >       sequence (map xBar
 287 >               [ (t*x_scale, (fromInt c)*y_scale)
 288 >               | (t,ss) <- samples, (n,c) <- ss ])     >>
 289 >       return ()
 290
 291 > xBar :: (Float, Float) -> IO ()
 292 > xBar (x, y) =
 293 >       let {x' = round x; y' = round y}
 294 >       in xDrawLine x' screen_size x' (screen_size - y')
 295
 296 >#include "common-bits"