--- /dev/null
+> 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"
projects / ghc-hetmet.git / blobdiff