diff options
Diffstat (limited to 'utils/heap-view/HpView2.lhs')
| -rw-r--r-- | utils/heap-view/HpView2.lhs | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/utils/heap-view/HpView2.lhs b/utils/heap-view/HpView2.lhs new file mode 100644 index 0000000000..fa8044b8b4 --- /dev/null +++ b/utils/heap-view/HpView2.lhs @@ -0,0 +1,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" |