Commit 2b860efd authored by Austin Seipp's avatar Austin Seipp
Browse files

utils: delete obsolete heap-view program


Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 021b7978
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"
/*----------------------------------------------------------------------*
* 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);
}
> 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