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