diff options
Diffstat (limited to 'utils')
-rw-r--r-- | utils/heap-view/Graph.lhs | 165 | ||||
-rw-r--r-- | utils/heap-view/HaskXLib.c | 297 | ||||
-rw-r--r-- | utils/heap-view/HpView.lhs | 296 | ||||
-rw-r--r-- | utils/heap-view/HpView2.lhs | 225 | ||||
-rw-r--r-- | utils/heap-view/MAIL | 67 | ||||
-rw-r--r-- | utils/heap-view/Makefile | 31 | ||||
-rw-r--r-- | utils/heap-view/Makefile.original | 48 | ||||
-rw-r--r-- | utils/heap-view/Parse.lhs | 92 | ||||
-rw-r--r-- | utils/heap-view/README | 62 | ||||
-rw-r--r-- | utils/heap-view/common-bits | 35 |
10 files changed, 0 insertions, 1318 deletions
diff --git a/utils/heap-view/Graph.lhs b/utils/heap-view/Graph.lhs deleted file mode 100644 index b8e08dbb9b..0000000000 --- a/utils/heap-view/Graph.lhs +++ /dev/null @@ -1,165 +0,0 @@ -Started 29/11/93: - -> module Main where -> import PreludeGlaST -> import LibSystem - -Program to draw a graph of last @n@ pieces of data from standard input -continuously. - -> n :: Int -> n = 40 - -> max_sample :: Int -> max_sample = 100 - -> screen_size :: Int -> screen_size = 200 - -Version of grapher that can handle the output of ghc's @+RTS -Sstderr@ -option. - -Nice variant would be to take a list of numbers from the commandline -and display several graphs at once. - -> main :: IO () -> main = -> getArgs >>= \ r -> -> case r of -> [select] -> -> let selection = read select -> in -> xInitialise [] screen_size screen_size >> -> hGetContents stdin >>= \ input -> -> graphloop2 (parseGCData selection input) [] -> _ -> -> error "usage: graph <number in range 0..17>\n" - -The format of glhc18's stderr stuff is: - --- start of example (view in 120 column window) -graph +RTS -Sstderr -H500 - -Collector: APPEL HeapSize: 500 (bytes) - - Alloc Collect Live Resid GC GC TOT TOT Page Flts No of Roots Caf Mut- Old Collec Resid - bytes bytes bytes ency user elap user elap GC MUT Astk Bstk Reg No able Gen tion %heap - 248 248 60 24.2% 0.00 0.04 0.05 0.23 1 1 1 0 0 1 0 0 Minor --- end of example - 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 - -That is: 6 header lines followed by 17-18 columns of integers, -percentages, floats and text. - -The scaling in the following is largely based on guesses about likely -values - needs tuned. - -@gcParsers@ is a list of functions which parse the corresponding -column and attempts to scale the numbers into the range $0.0 .. 1.0$. -(But may return a number avove $1.0$ which graphing part will scale to -fit screen...) - -(Obvious optimisation - replace by list of scaling information!) - -(Obvious improvement - return (x,y) pair based on elapsed (or user) time.) - -> gcParsers :: [ String -> Float ] -> gcParsers = [ heap, heap, heap, percent, time, time, time, time, flts, flts, stk, stk, reg, caf, caf, heap, text, percent ] -> where -> heap = scale 100000.0 . fromInt . check 0 . readDec -> stk = scale 25000.0 . fromInt . check 0 . readDec -> int = scale 1000.0 . fromInt . check 0 . readDec -> reg = scale 10.0 . fromInt . check 0 . readDec -> caf = scale 100.0 . fromInt . check 0 . readDec -> flts = scale 100.0 . fromInt . check 0 . readDec -> percent = scale 100.0 . check 0.0 . readFloat -> time = scale 20.0 . check 0.0 . readFloat -> text s = 0.0 - -> check :: a -> [(a,String)] -> a -> check error_value parses = -> case parses of -> [] -> error_value -> ((a,s):_) -> a - -> scale :: Float -> Float -> Float -> scale max n = n / max - -> parseGCData :: Int -> String -> [Float] -> parseGCData column input = -> map ((gcParsers !! column) . (!! column) . words) (drop 6 (lines input)) - -Hmmm, how to add logarithmic scaling neatly? Do I still need to? - -Note: unpleasant as it is, the code cannot be simplified to something -like the following. 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) - - -> graphloop2 :: [Float] -> [Float] -> IO () -> graphloop2 (y:ys) xs = -> let xs' = take n (y:xs) -> m = maximum xs' -> y_scale = (floor m) + 1 -> y_scale' = fromInt y_scale -> in -> xCls >> -> drawScales y_scale >> -> draw x_coords [ x / y_scale' | x <- xs' ] >> -> xHandleEvent >> -> graphloop2 ys xs' -> graphloop2 [] xs = -> return () - -> x_coords :: [Float] -> x_coords = [ 0.0, 1 / (fromInt n) .. ] - -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" diff --git a/utils/heap-view/HaskXLib.c b/utils/heap-view/HaskXLib.c deleted file mode 100644 index b6cf1f137c..0000000000 --- a/utils/heap-view/HaskXLib.c +++ /dev/null @@ -1,297 +0,0 @@ -/*----------------------------------------------------------------------* - * X from Haskell (PicoX) - * - * (c) 1993 Andy Gill - * - *----------------------------------------------------------------------*/ - -#include <X11/Xlib.h> -#include <X11/Xutil.h> -#include <X11/Xatom.h> -#include <stdio.h> -#include <strings.h> - -/*----------------------------------------------------------------------*/ - -/* First the X Globals */ - -Display *MyDisplay; -int MyScreen; -Window MyWindow; -XEvent MyWinEvent; -GC DrawGC; -GC UnDrawGC; - -/* and the Haskell globals */ - -typedef struct { - int HaskButtons[5]; - int HaskPointerX,HaskPointerY; - int PointMoved; -} HaskGlobType; - -HaskGlobType HaskGlob; - -/*----------------------------------------------------------------------*/ - -/* - * Now the access functions into the haskell globals - */ - -int haskGetButtons(int n) -{ - return(HaskGlob.HaskButtons[n]); -} - -int haskGetPointerX(void) -{ - return(HaskGlob.HaskPointerX); -} - -int haskGetPointerY(void) -{ - return(HaskGlob.HaskPointerY); -} - -/*----------------------------------------------------------------------*/ - -/* - *The (rather messy) initiualisation - */ - -haskXBegin(int x,int y,int sty) -{ - /* - * later include these via interface hacks - */ - - /* (int argc, char **argv) */ - int argc = 0; - char **argv = 0; - - XSizeHints XHints; - int MyWinFG, MyWinBG,tmp; - - if ((MyDisplay = XOpenDisplay("")) == NULL) { - fprintf(stderr, "Cannot connect to X server '%s'\n", XDisplayName("")); - exit(1); - } - - MyScreen = DefaultScreen(MyDisplay); - - MyWinBG = WhitePixel(MyDisplay, MyScreen); - MyWinFG = BlackPixel(MyDisplay, MyScreen); - - XHints.x = x; - XHints.y = y; - XHints.width = x; - XHints.height = y; - XHints.flags = PPosition | PSize; - - MyWindow = - XCreateSimpleWindow( - MyDisplay, - DefaultRootWindow(MyDisplay), - x,y, x, y, - 5, - MyWinFG, - MyWinBG - ); - - XSetStandardProperties( - MyDisplay, - MyWindow, - "XLib for Glasgow Haskell", - "XLib for Glasgow Haskell", - None, - argv, - argc, - &XHints - ); - - /* Create drawing and erasing GC */ - - DrawGC = XCreateGC(MyDisplay,MyWindow,0, 0); - XSetBackground(MyDisplay,DrawGC,MyWinBG); - XSetForeground(MyDisplay,DrawGC,MyWinFG); - - UnDrawGC = XCreateGC(MyDisplay,MyWindow,0, 0); - XSetBackground(MyDisplay,UnDrawGC,MyWinFG); - XSetForeground(MyDisplay,UnDrawGC,MyWinBG); - - XSetGraphicsExposures(MyDisplay,DrawGC,False); - XSetGraphicsExposures(MyDisplay,UnDrawGC,False); - XMapRaised(MyDisplay,MyWindow); - - /* the user should be able to choose which are tested for - */ - - XSelectInput( - MyDisplay, - MyWindow, - ButtonPressMask | ButtonReleaseMask | PointerMotionMask - ); - - /* later have more drawing styles - */ - - switch (sty) - { - case 0: - /* Andy, this used to be GXor not much use for Undrawing so I - changed it. (Not much use for colour either - see next - comment */ - XSetFunction(MyDisplay,DrawGC,GXcopy); - XSetFunction(MyDisplay,UnDrawGC,GXcopy); - break; - case 1: - /* Andy, this can have totally bogus results on a colour screen */ - XSetFunction(MyDisplay,DrawGC,GXxor); - XSetFunction(MyDisplay,UnDrawGC,GXxor); - break; - default: - /* Andy, is this really a good error message? */ - printf(stderr,"Wrong Argument to XSet function\n"); - } - /* - * reset the (Haskell) globals - */ - - for(tmp=0;tmp<5;tmp++) - { - HaskGlob.HaskButtons[tmp] = 0; - } - HaskGlob.HaskPointerX = 0; - HaskGlob.HaskPointerY = 0; - HaskGlob.PointMoved = 0; - - XFlush(MyDisplay); - -} - -/*----------------------------------------------------------------------*/ - -/* Boring X ``Do Something'' functions - */ - -haskXClose(void) -{ - XFreeGC( MyDisplay, DrawGC); - XFreeGC( MyDisplay, UnDrawGC); - XDestroyWindow( MyDisplay, MyWindow); - XCloseDisplay( MyDisplay); - return(0); -} - -haskXDraw(x,y,x1,y1) -int x,y,x1,y1; -{ - XDrawLine(MyDisplay, - MyWindow, - DrawGC, - x,y,x1,y1); - return(0); -} - - -haskXPlot(c,x,y) -int c; -int x,y; -{ - XDrawPoint(MyDisplay, - MyWindow, - (c?DrawGC:UnDrawGC), - x,y); - return(0); -} - -haskXFill(c,x,y,w,h) -int c; -int x, y; -int w, h; -{ - XFillRectangle(MyDisplay, - MyWindow, - (c?DrawGC:UnDrawGC), - x, y, w, h); - return(0); -} - -/*----------------------------------------------------------------------*/ - - /* This has to be called every time round the loop, - * it flushed the buffer and handles input from the user - */ - -haskHandleEvent() -{ - XFlush( MyDisplay); - while (XEventsQueued( MyDisplay, QueuedAfterReading) != 0) { - XNextEvent( MyDisplay, &MyWinEvent); - switch (MyWinEvent.type) { - case ButtonPress: - switch (MyWinEvent.xbutton.button) - { - case Button1: HaskGlob.HaskButtons[0] = 1; break; - case Button2: HaskGlob.HaskButtons[1] = 1; break; - case Button3: HaskGlob.HaskButtons[2] = 1; break; - case Button4: HaskGlob.HaskButtons[3] = 1; break; - case Button5: HaskGlob.HaskButtons[4] = 1; break; - } - break; - case ButtonRelease: - switch (MyWinEvent.xbutton.button) - { - case Button1: HaskGlob.HaskButtons[0] = 0; break; - case Button2: HaskGlob.HaskButtons[1] = 0; break; - case Button3: HaskGlob.HaskButtons[2] = 0; break; - case Button4: HaskGlob.HaskButtons[3] = 0; break; - case Button5: HaskGlob.HaskButtons[4] = 0; break; - } - break; - case MotionNotify: - HaskGlob.HaskPointerX = MyWinEvent.xmotion.x; - HaskGlob.HaskPointerY = MyWinEvent.xmotion.y; - HaskGlob.PointMoved = 1; - break; - default: - printf("UNKNOWN INTERUPT ???? (%d) \n",MyWinEvent.type); - break; - } /*switch*/ - } /*if*/ - return(0); -} - - -/*----------------------------------------------------------------------*/ - - /* A function to clear the screen - */ - -haskXCls(void) -{ - XClearWindow(MyDisplay,MyWindow); -} - -/*----------------------------------------------------------------------*/ - - /* A function to write a string - */ - -haskXDrawString(int x,int y,char *str) -{ - return(0); -/* printf("GOT HERE %s %d %d",str,x,y); - XDrawString(MyDisplay,MyWindow,DrawGC,x,y,str,strlen(str)); -*/ -} - -/*----------------------------------------------------------------------*/ - -extern int prog_argc; -extern char **prog_argv; - -haskArgs() -{ - return(prog_argc > 1 ? atoi(prog_argv[1]) : 0); -} diff --git a/utils/heap-view/HpView.lhs b/utils/heap-view/HpView.lhs deleted file mode 100644 index a7b4cbb78e..0000000000 --- a/utils/heap-view/HpView.lhs +++ /dev/null @@ -1,296 +0,0 @@ -> module Main where -> import PreludeGlaST -> import LibSystem - -> import Parse - -Program to interpret a heap profile. - -Started 28/11/93: parsing of profile -Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added - -To be done: - -0) think about where I want to go with this -1) further processing... sorting, filtering, ... -2) get dynamic display -3) maybe use widgets - -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 - -By inspection, the format seems to be: - -profile :== header { sample } -header :== job date { unit } -job :== "JOB" command -date :== "DATE" dte -unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string - -sample :== samp | mark -samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time -pairs :== identifer count -mark :== "MARK" time - -command :== string -dte :== string -time :== float -count :== integer - -But, this doesn't indicate the line structure. The simplest way to do -this is to treat each line as a single token --- for which the -following parser is useful: - -Special purpose parser that recognises a string if it matches a given -prefix and returns the remainder. - -> prefixP :: String -> P String String -> prefixP p = -> itemP `thenP` \ a -> -> let (p',a') = splitAt (length p) a -> in if p == p' -> then unitP a' -> else zeroP - - -To begin with I want to parse a profile into a list of readings for -each identifier at each time. - -> type Sample = (Float, [(String, Int)]) - -> type Line = String - - -> profile :: P Line [Sample] -> profile = -> header `thenP_` -> zeroOrMoreP sample - -> header :: P Line () -> header = -> job `thenP_` -> date `thenP_` -> zeroOrMoreP unit `thenP_` -> unitP () - -> job :: P Line String -> job = prefixP "JOB " - -> date :: P Line String -> date = prefixP "DATE " - -> unit :: P Line String -> unit = -> ( prefixP "SAMPLE_UNIT " ) -> `plusP` -> ( prefixP "VALUE_UNIT " ) - -> sample :: P Line Sample -> sample = -> samp `plusP` mark - -> mark :: P Line Sample -> mark = -> prefixP "MARK " `thenP` \ time -> -> unitP (read time, []) - -ToDo: check that @time1 == time2@ - -> samp :: P Line Sample -> samp = -> prefixP "BEGIN_SAMPLE " `thenP` \ time1 -> -> zeroOrMoreP pair `thenP` \ pairs -> -> prefixP "END_SAMPLE " `thenP` \ time2 -> -> unitP (read time1, pairs) - -> pair :: P Line (String, Int) -> pair = -> prefixP " " `thenP` \ sample_line -> -> let [identifier,count] = words sample_line -> in unitP (identifier, read count) - -This test works fine - -> {- -> test :: String -> String -> test str = ppSamples (theP profile (lines str)) - -> test1 = test example - -> test2 :: String -> Dialogue -> test2 file = -> readFile file exit -> (\ hp -> appendChan stdout (test hp) exit -> done) -> -} - -Inefficient pretty-printer (uses ++ excessively) - -> ppSamples :: [ Sample ] -> String -> ppSamples = unlines . map ppSample - -> ppSample :: Sample -> String -> ppSample (time, samps) = -> (show time) ++ unwords (map ppSamp samps) - -> ppSamp :: (String, Int) -> String -> ppSamp (identifier, count) = identifier ++ ":" ++ show count - -To get the test1 to work in gofer, you need to fiddle with the input -a bit to get over Gofer's lack of string-parsing code. - -> example = -> "JOB \"a.out -p\"\n" ++ -> "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++ -> "SAMPLE_UNIT \"seconds\"\n" ++ -> "VALUE_UNIT \"bytes\"\n" ++ -> "BEGIN_SAMPLE 0.00\n" ++ -> " SYSTEM 24\n" ++ -> "END_SAMPLE 0.00\n" ++ -> "BEGIN_SAMPLE 1.00\n" ++ -> " elim 180\n" ++ -> " insert 24\n" ++ -> " intersect 12\n" ++ -> " disin 60\n" ++ -> " main 12\n" ++ -> " reduce 20\n" ++ -> " SYSTEM 12\n" ++ -> "END_SAMPLE 1.00\n" ++ -> "MARK 1.50\n" ++ -> "MARK 1.75\n" ++ -> "MARK 1.80\n" ++ -> "BEGIN_SAMPLE 2.00\n" ++ -> " elim 192\n" ++ -> " insert 24\n" ++ -> " intersect 12\n" ++ -> " disin 84\n" ++ -> " main 12\n" ++ -> " SYSTEM 24\n" ++ -> "END_SAMPLE 2.00\n" ++ -> "BEGIN_SAMPLE 2.82\n" ++ -> "END_SAMPLE 2.82" - - - - -Hack to let me test this code... Gofer doesn't have integer parsing built in. - -> {- -> read :: String -> Int -> read s = 0 -> -} - -> screen_size = 200 - -ToDo: - -1) the efficiency of finding slices can probably be dramatically - improved... if it matters. - -2) the scaling should probably depend on the slices used - -3) labelling graphs, colour, ... - -4) responding to resize events - -> main :: IO () -> main = -> getArgs >>= \ r -> -> case r of -> filename:idents -> -> readFile filename >>= \ hp -> -> let samples = theP profile (lines hp) -> -> times = [ t | (t,ss) <- samples ] -> names = [ n | (t,ss) <- samples, (n,c) <- ss ] -> counts = [ c | (t,ss) <- samples, (n,c) <- ss ] -> -> time = maximum times -> x_scale = (fromInt screen_size) / time -> -> max_count = maximum counts -> y_scale = (fromInt screen_size) / (fromInt max_count) -> -> slices = map (slice samples) idents -> in -> xInitialise [] screen_size screen_size >> -> -- drawHeap x_scale y_scale samples >> -> sequence (map (drawSlice x_scale y_scale) slices) >> -> freeze -> _ -> error "usage: hpView filename identifiers\n" - -> freeze :: IO () -> freeze = -> xHandleEvent >> -> usleep 100 >> -> freeze - - -Slice drawing stuff... shows profile for each identifier - -> slice :: [Sample] -> String -> [(Float,Int)] -> slice samples ident = -> [ (t,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 - -> drawSlice :: Float -> Float -> [(Float,Int)] -> IO () -> drawSlice x_scale y_scale slc = -> drawPoly -> [ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ] - -> drawPoly :: [(Int, Int)] -> IO () -> drawPoly ((x1,y1):(x2,y2):poly) = -> xDrawLine x1 y1 x2 y2 >> -> drawPoly ((x2,y2):poly) -> drawPoly _ = return () - - -Very simple heap profiler... doesn't do a proper job at all. Good for -testing. - -> drawHeap :: Float -> Float -> [Sample] -> IO () -> drawHeap x_scale y_scale samples = -> sequence (map xBar -> [ (t*x_scale, (fromInt c)*y_scale) -> | (t,ss) <- samples, (n,c) <- ss ]) >> -> return () - -> xBar :: (Float, Float) -> IO () -> xBar (x, y) = -> let {x' = round x; y' = round y} -> in xDrawLine x' screen_size x' (screen_size - y') - ->#include "common-bits" diff --git a/utils/heap-view/HpView2.lhs b/utils/heap-view/HpView2.lhs deleted file mode 100644 index fa8044b8b4..0000000000 --- a/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" diff --git a/utils/heap-view/MAIL b/utils/heap-view/MAIL deleted file mode 100644 index 966fcdcfc7..0000000000 --- a/utils/heap-view/MAIL +++ /dev/null @@ -1,67 +0,0 @@ -To: partain@dcs.gla.ac.uk -cc: areid@dcs.gla.ac.uk, andy@dcs.gla.ac.uk -Subject: Heap profiling programs -Date: Thu, 09 Dec 93 17:33:09 +0000 -From: Alastair Reid <areid@dcs.gla.ac.uk> - - -I've hacked up a couple of programs which it might be worth putting in -the next ghc distribution. They are: - -graph: - - Draws a continuous graph of any one column of the statistics - produced using the "+RTS -Sstderr" option. - - I'm not convinced this is astonishingly useful since I'm yet to - learn anything useful from (manually) examining these statistics. - (Although I do vaguely remember asking Patrick if the heap profiler - could do stack profiles too.) - - A typical usage is: - - slife 2 Unis/gardenofeden +RTS -Sstderr -H1M -RTS |& graph 2 - - which draws a graph of the third column (ie column 2!) of the - stats. - - (btw is there a neater way of connecting stderr to graph's stdin?) - -hpView2: - - Draws a continuous graph of the statistics reported by the "+RTS -h" - option. - - Since I understand what the figures mean, this seems to be the more - useful program. - - A typical usage is: - - mkfifo slife.hp - hpView2 slife.hp Main:mkQuad & - slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS - rm slife.hp - - which draws a graph of the total heap usage and the usage for Main:mkQuad. - - -Minor problems: - -The code is a gross hack... but it works. (Maybe distribute in rot13 -format so that you don't get accidentally get exposed to obscene code -:-)) - -The code uses a variant of Andy's picoXlibrary (which he was talking -about releasing but maybe isn't ready to do yet.) - -Also, there are lots of obvious extensions etc which could be made but -haven't yet... (The major one is being able to set the initial -scale-factor for displaying the graphs or being able to graph several -stats at once without having to tee.) - - -Hope you find them interesting. - -Alastair - -ps Code is in ~areid/hask/Life and should be readable/executable. diff --git a/utils/heap-view/Makefile b/utils/heap-view/Makefile deleted file mode 100644 index e8fa8faf08..0000000000 --- a/utils/heap-view/Makefile +++ /dev/null @@ -1,31 +0,0 @@ -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -PROGRAMS = graph hpView hpView2 - -SRC_HC_OPTS += -hi-diffs -fglasgow-exts -fhaskell-1.3 -O -L/usr/X11/lib -cpp -SRC_CC_OPTS += -ansi -I/usr/X11/include -# ToDo: use AC_PATH_X in configure to get lib/include dirs for X. - -OBJS_graph = Graph.o HaskXLib.o -OBJS_hpView = HpView.o Parse.o HaskXLib.o -OBJS_hpView2 = HpView2.o Parse.o HaskXLib.o - -all :: $(PROGRAMS) - -graph : $(OBJS_graph) - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_graph) -lX11 - -hpView : $(OBJS_hpView) - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView) -lX11 - -hpView2 : $(OBJS_hpView2) - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView2) -lX11 - -HaskXLib.o : HaskXLib.c - $(CC) -c $(CC_OPTS) HaskXLib.c - -INSTALL_PROGS += $(PROGRAMS) -CLEAN_FILES += $(PROGRAMS) - -include $(TOP)/mk/target.mk diff --git a/utils/heap-view/Makefile.original b/utils/heap-view/Makefile.original deleted file mode 100644 index 1e35bc2e43..0000000000 --- a/utils/heap-view/Makefile.original +++ /dev/null @@ -1,48 +0,0 @@ -CC=gcc -GLHC18 = glhc18 -GLHC19 = /users/fp/partain/bin/sun4/glhc -HC= ghc -hi-diffs -fglasgow-exts -fhaskell-1.3 -HC_FLAGS = -O -prof -auto-all -#HC_FLAGS = -O -LIBS=-lX11 -FILES2 = Life2.o HaskXLib.o -FILESS = LifeWithStability.o HaskXLib.o -FILES = Life.o HaskXLib.o - -all : hpView hpView2 - -# ADR's heap profile viewer -hpView: HpView.o Parse.o HaskXLib.o - $(HC) -o hpView $(HC_FLAGS) HpView.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib -clean:: - rm -f hpView - -# ADR's continuous heap profile viewer (handles output of -p) -hpView2: HpView2.o Parse.o HaskXLib.o - $(HC) -o hpView2 $(HC_FLAGS) HpView2.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib -clean:: - rm -f hpView2 - - -# ADR's continuous graph program (handles output of -Sstderr) -graph: Graph.o HaskXLib.o - $(HC) -o graph $(HC_FLAGS) Graph.o HaskXLib.o $(LIBS) -L/usr/X11/lib -clean:: - rm -f graph - -# ADR's continuous graph program (part of heap profile viewer) that -# crashes the compiler -bugGraph: bugGraph.o HaskXLib.o - $(HC) -o bugGraph $(HC_FLAGS) bugGraph.o HaskXLib.o $(LIBS) -L/usr/X11/lib -clean:: - rm -f bugGraph - -%.o:%.c - $(CC) -c -ansi -traditional -g -I/usr/X11/include/ $< $(INC) - -%.o:%.lhs - $(HC) $(HC_FLAGS) -c $< $(INC) - -clean:: - rm -f core *.o *% #* - rm -f *.hc diff --git a/utils/heap-view/Parse.lhs b/utils/heap-view/Parse.lhs deleted file mode 100644 index 9d7652fdcc..0000000000 --- a/utils/heap-view/Parse.lhs +++ /dev/null @@ -1,92 +0,0 @@ -> module Parse where - -The Parser monad in "Comprehending Monads" - -> infixr 9 `thenP` -> infixr 9 `thenP_` -> infixr 9 `plusP` - -> type P t a = [t] -> [(a,[t])] - -> unitP :: a -> P t a -> unitP a = \i -> [(a,i)] - -> thenP :: P t a -> (a -> P t b) -> P t b -> m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1] - -> thenP_ :: P t a -> P t b -> P t b -> m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1] - -zeroP is the parser that always fails to parse its input - -> zeroP :: P t a -> zeroP = \i -> [] - -plusP combines two parsers in parallel -(called "alt" in "Comprehending Monads") - -> plusP :: P t a -> P t a -> P t a -> a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i) - -itemP is the parser that parses a single token -(called "next" in "Comprehending Monads") - -> itemP :: P t t -> itemP = \i -> [(head i, tail i) | not (null i)] - -force successful parse - -> cutP :: P t a -> P t a -> cutP p = \u -> let l = p u in if null l then [] else [head l] - -find all complete parses of a given string - -> useP :: P t a -> [t] -> [a] -> useP m = \x -> [ a | (a,[]) <- m x ] - -find first complete parse - -> theP :: P t a -> [t] -> a -> theP m = head . (useP m) - - -Some standard parser definitions - -mapP applies f to all current parse trees - -> mapP :: (a -> b) -> P t a -> P t b -> f `mapP` m = m `thenP` (\a -> unitP (f a)) - -filter is the parser that parses a single token if it satisfies a -predicate and fails otherwise. - -> filterP :: (a -> Bool) -> P t a -> P t a -> p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP)) - -lit recognises literals - -> litP :: Eq t => t -> P t () -> litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () ) - -> showP :: (Text a) => P t a -> [t] -> String -> showP m xs = show (theP m xs) - - -Simon Peyton Jones adds some useful operations: - -> zeroOrMoreP :: P t a -> P t [a] -> zeroOrMoreP p = oneOrMoreP p `plusP` unitP [] - -> oneOrMoreP :: P t a -> P t [a] -> oneOrMoreP p = seq p -> where seq p = p `thenP` (\a -> -> (seq p `thenP` (\as -> unitP (a:as))) -> `plusP` -> unitP [a] ) - -> oneOrMoreWithSepP :: P t a -> P t b -> P t [a] -> oneOrMoreWithSepP p1 p2 = seq1 p1 p2 -> where seq1 p1 p2 = p1 `thenP` (\a -> seq2 p1 p2 a `plusP` unitP [a]) -> seq2 p1 p2 a = p2 `thenP` (\_ -> -> seq1 p1 p2 `thenP` (\as -> unitP (a:as) )) - diff --git a/utils/heap-view/README b/utils/heap-view/README deleted file mode 100644 index db9503abc4..0000000000 --- a/utils/heap-view/README +++ /dev/null @@ -1,62 +0,0 @@ -@HpView.lhs@ is a very primitive heap profile viewer written in -Haskell. It feeds off the same files as hp2ps. It needs a lot of -tidying up and would be far more useful as a continuous display. -(It's in this directory `cos there happens to be a heap profile here -and I couldn't be bothered setting up a new directory, Makefile, etc.) - -@Graph.lhs@ is a continuous heap viewer that "parses" the output of -the +RTS -Sstderr option. Typical usage: - - slife 1 r4 +RTS -Sstderr |& graph 2 - -(You might also try - - cat data | graph 2 - - to see it in action on some sample data. -) - -Things to watch: - - 1) Scaling varies from column to column - consult the source. - - 2) The horizontal scale is not time - it is garbage collections. - - 3) The graph is of the (n+1)st column of the -Sstderr output. - - The data is not always incredibly useful: For example, when using - the (default) Appel 2-space garbage collector, the 3rd column - displays the amount of "live" data in the minor space. A program - with a constant data usage will appear to have a sawtooth usage - as minor data gradually transfers to the major space and then, - suddenly, all gets transferred back at major collections. - Decreasing heap size decreases the size of the minor collections - and increases major collections exaggerating the sawtooth. - - 4) The program is not as robust as it might be. - - -@HpView2.lhs@ is the result of a casual coupling of @Graph.lhs@ and -@HpView.lhs@ which draws continuous graphs of the heap consisting of: -total usage and usage by one particular cost centre. For example: - - mkfifo slife.hp - hpView2 slife.hp Main:mkQuad & - slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS - rm slife.hp - -draws a graph of total usage and usage by the function @mkQuad@. - -(You might also try - - hpView2 slife.old-hp Main:mkQuad - - to see it in action on some older data) - -The business with named pipes (mkfifo) is a little unfortunate - it -would be nicer if the Haskell runtime system could output to stderr -(say) which I could pipe into hpView which could just graph it's stdin -(like graph does). It's probably worth wrapping the whole thing up in -a little shell-script. - - diff --git a/utils/heap-view/common-bits b/utils/heap-view/common-bits deleted file mode 100644 index f41223b7f4..0000000000 --- a/utils/heap-view/common-bits +++ /dev/null @@ -1,35 +0,0 @@ - ----------------------------------------------------------------------------- - - xInitialise :: [String] -> Int -> Int -> IO () - xInitialise str x y = - _ccall_ haskXBegin x y (0::Int) `seqPrimIO` - return () - - xHandleEvent :: IO () - xHandleEvent = - _ccall_ haskHandleEvent `thenPrimIO` \ n -> - case (n::Int) of - 0 -> return () - _ -> error "Unknown Message back from Handle Event" - - xClose :: IO () - xClose = - _ccall_ haskXClose `seqPrimIO` - return () - - xCls :: IO () - xCls = - _ccall_ haskXCls `seqPrimIO` - return () - - xDrawLine :: Int -> Int -> Int -> Int -> IO () - xDrawLine x1 y1 x2 y2 = - _ccall_ haskXDraw x1 y1 x2 y2 `seqPrimIO` - return () - - ---------------------------------------------------------------- - - usleep :: Int -> IO () - usleep t = - _ccall_ usleep t `seqPrimIO` - return () |