[project @ 2000-11-01 11:41:47 by simonmar]
authorsimonmar <unknown>
Wed, 1 Nov 2000 11:41:47 +0000 (11:41 +0000)
committersimonmar <unknown>
Wed, 1 Nov 2000 11:41:47 +0000 (11:41 +0000)
Add a basic "front panel" for GHC-compiled programs.

How to use it:

- re-autoconf & configure to detect GTK+

- add "GhcRtsWithFrontPanel = YES" to mk/build.mk

- rebuild the RTS

- compile up a program, add `gtk-config --libs` to the
  link command line

- run with program with +RTS -f,

- sit back & watch the show :-)  Programs with lots of
  heap-resident data are the most interesting.  For extra
  kicks, turn up the number of generations & steps like so:
  +RTS -f -G5 -T3.

- Bootstrap your compiler, and see in glorious technicolor
  just how much of a lumbering beast GHC really is.

This is a work in progress.  There's lots more stuff we could display
on the panel: suggestions/comments are of course welcome.  The window
layout was designed with GLADE, I'll commit the config file shortly.

I haven't quite figured out how we're going to integrate this with the
release yet (ie. whether we'll distribute two separate RTS's or what).

15 files changed:
ghc/rts/FrontPanel.c [new file with mode: 0644]
ghc/rts/FrontPanel.h [new file with mode: 0644]
ghc/rts/GC.c
ghc/rts/Makefile
ghc/rts/RtsFlags.c
ghc/rts/RtsFlags.h
ghc/rts/RtsStartup.c
ghc/rts/Storage.c
ghc/rts/StoragePriv.h
ghc/rts/VisCallbacks.c [new file with mode: 0644]
ghc/rts/VisCallbacks.h [new file with mode: 0644]
ghc/rts/VisSupport.c [new file with mode: 0644]
ghc/rts/VisSupport.h [new file with mode: 0644]
ghc/rts/VisWindow.c [new file with mode: 0644]
ghc/rts/VisWindow.h [new file with mode: 0644]

diff --git a/ghc/rts/FrontPanel.c b/ghc/rts/FrontPanel.c
new file mode 100644 (file)
index 0000000..fd5bbe1
--- /dev/null
@@ -0,0 +1,814 @@
+/* -----------------------------------------------------------------------------
+ * $Id: FrontPanel.c,v 1.1 2000/11/01 11:41:47 simonmar Exp $
+ *
+ * (c) The GHC Team 2000
+ *
+ * RTS GTK Front Panel
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifdef RTS_GTK_FRONTPANEL
+
+#define NON_POSIX_SOURCE
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "MBlock.h"
+#include "FrontPanel.h"
+#include "StoragePriv.h"
+#include "Stats.h"
+#include "RtsFlags.h"
+#include "Schedule.h"
+
+#include <unistd.h>
+#include <gdk/gdktypes.h>
+#include <gtk/gtk.h>
+
+#include "VisSupport.h"
+#include "VisWindow.h"
+
+static GtkWidget *window, *map_drawing_area, *gen_drawing_area;
+static GtkWidget *res_drawing_area;
+static GtkWidget *continue_but, *stop_but, *quit_but;
+static GtkWidget *statusbar;
+static GtkWidget *live_label, *allocated_label;
+static GtkWidget *footprint_label, *alloc_rate_label;
+static GtkWidget *map_ruler, *gen_ruler;
+static GtkWidget *res_vruler, *res_hruler;
+static GtkWidget *running_label, *b_read_label, *b_write_label, *total_label;
+static GtkWidget *b_mvar_label, *b_bh_label, *b_throwto_label, *sleeping_label;
+
+static guint status_context_id;
+
+gboolean continue_now = FALSE, stop_now = FALSE, quit = FALSE;
+UpdateMode update_mode = Continuous;
+
+static GdkPixmap *map_pixmap = NULL;
+static GdkPixmap *gen_pixmap = NULL;
+static GdkPixmap *res_pixmap = NULL;
+
+#define N_GENS 10
+
+static GdkColor 
+    bdescr_color = { 0, 0xffff, 0, 0 },        /* red */
+    free_color   = { 0, 0, 0, 0xffff },        /* blue */
+    gen_colors[N_GENS] = {
+       { 0, 0, 0xffff, 0 },
+       { 0, 0, 0xf000, 0 },
+       { 0, 0, 0xe000, 0 },
+       { 0, 0, 0xd000, 0 },
+       { 0, 0, 0xc000, 0 },
+       { 0, 0, 0xb000, 0 },
+       { 0, 0, 0xa000, 0 },
+       { 0, 0, 0x9000, 0 },
+       { 0, 0, 0x8000, 0 },
+       { 0, 0, 0x7000, 0 }
+    };
+
+GdkGC *my_gc = NULL;
+
+static void *mem_start = (void *) 0x50000000;
+
+static void colorBlock( void *addr, GdkColor *color, 
+                       nat block_width, nat block_height, 
+                       nat blocks_per_line );
+
+static void residencyCensus( void );
+static void updateResidencyGraph( void );
+static void updateThreadsPanel( void );
+
+/* Some code pinched from examples/scribble-simple in the GTK+
+ * distribution.
+ */
+
+/* Create a new backing pixmap of the appropriate size */
+static gint 
+configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED,
+                GdkPixmap **pixmap )
+{
+  if (*pixmap)
+    gdk_pixmap_unref(*pixmap);
+
+  *pixmap = gdk_pixmap_new(widget->window,
+                          widget->allocation.width,
+                          widget->allocation.height,
+                          -1);
+
+  gdk_draw_rectangle (*pixmap,
+                     widget->style->white_gc,
+                     TRUE,
+                     0, 0,
+                     widget->allocation.width,
+                     widget->allocation.height);
+
+  fprintf(stderr, "configure!\n");
+  updateFrontPanel();
+  return TRUE;
+}
+
+/* Redraw the screen from the backing pixmap */
+static gint 
+expose_event( GtkWidget *widget, GdkEventExpose *event, GdkPixmap **pixmap )
+{
+  gdk_draw_pixmap(widget->window,
+                 widget->style->fg_gc[GTK_WIDGET_STATE (widget)],
+                 *pixmap,
+                 event->area.x, event->area.y,
+                 event->area.x, event->area.y,
+                 event->area.width, event->area.height);
+
+  return FALSE;
+}
+
+void
+initFrontPanel( void )
+{
+    GdkColormap *colormap;
+    GtkWidget *gen_hbox;
+
+    gtk_init( &prog_argc, &prog_argv );
+
+    window = create_GHC_Visualisation_Tool();
+    map_drawing_area  = lookup_widget(window, "memmap");
+    gen_drawing_area  = lookup_widget(window, "generations");
+    res_drawing_area  = lookup_widget(window, "res_drawingarea");
+    stop_but          = lookup_widget(window, "stop_but");
+    continue_but      = lookup_widget(window, "continue_but");
+    quit_but          = lookup_widget(window, "quit_but");
+    statusbar         = lookup_widget(window, "statusbar");
+    live_label        = lookup_widget(window, "live_label");
+    footprint_label   = lookup_widget(window, "footprint_label");
+    allocated_label   = lookup_widget(window, "allocated_label");
+    alloc_rate_label  = lookup_widget(window, "alloc_rate_label");
+    gen_hbox          = lookup_widget(window, "gen_hbox");
+    gen_ruler         = lookup_widget(window, "gen_ruler");
+    map_ruler         = lookup_widget(window, "map_ruler");
+    res_vruler        = lookup_widget(window, "res_vruler");
+    res_hruler        = lookup_widget(window, "res_hruler");
+    running_label     = lookup_widget(window, "running_label");
+    b_read_label      = lookup_widget(window, "blockread_label");
+    b_write_label     = lookup_widget(window, "blockwrite_label");
+    b_mvar_label      = lookup_widget(window, "blockmvar_label");
+    b_bh_label        = lookup_widget(window, "blockbh_label");
+    b_throwto_label   = lookup_widget(window, "blockthrowto_label");
+    sleeping_label    = lookup_widget(window, "sleeping_label");
+    total_label       = lookup_widget(window, "total_label");
+    
+    status_context_id = 
+       gtk_statusbar_get_context_id( GTK_STATUSBAR(statusbar), "context" );
+
+    /* hook up some signals for the mem map drawing area */
+    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "expose_event",
+                       (GtkSignalFunc)expose_event, &map_pixmap);
+    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "configure_event",
+                       (GtkSignalFunc)configure_event, &map_pixmap);
+
+    gtk_widget_set_events(map_drawing_area, GDK_EXPOSURE_MASK);
+
+    /* hook up some signals for the gen drawing area */
+    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "expose_event",
+                       (GtkSignalFunc)expose_event, &gen_pixmap);
+    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "configure_event",
+                       (GtkSignalFunc)configure_event, &gen_pixmap);
+
+    gtk_widget_set_events(gen_drawing_area, GDK_EXPOSURE_MASK);
+    
+    /* hook up some signals for the res drawing area */
+    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "expose_event",
+                       (GtkSignalFunc)expose_event, &res_pixmap);
+    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "configure_event",
+                       (GtkSignalFunc)configure_event, &res_pixmap);
+
+    gtk_widget_set_events(res_drawing_area, GDK_EXPOSURE_MASK);
+    
+    /* allocate our colors */
+    colormap = gdk_colormap_get_system();
+    gdk_colormap_alloc_color(colormap, &bdescr_color, TRUE, TRUE);
+    gdk_colormap_alloc_color(colormap, &free_color, TRUE, TRUE);
+
+    {
+       gboolean success[N_GENS];
+       gdk_colormap_alloc_colors(colormap, gen_colors, N_GENS, TRUE,
+                                 TRUE, success);
+       if (!success) { barf("can't allocate colors"); }
+    }
+
+    /* set the labels on the generation histogram */
+    {
+       char buf[64];
+       nat g, s;
+       GtkWidget *label;
+
+       for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
+           for(s = 0; s < generations[g].n_steps; s++) {
+               g_snprintf( buf, 64, "%d.%d", g, s );
+               label = gtk_label_new( buf );
+               gtk_box_pack_start( GTK_BOX(gen_hbox), label,
+                                   TRUE, TRUE, 5 );
+               gtk_widget_show(label);
+           }
+       }
+    }
+
+    gtk_widget_show(window);
+
+    /* wait for the user to press "Continue" before getting going... */
+    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
+                       "Program start");
+    gtk_widget_set_sensitive( stop_but, FALSE );
+    continue_now = FALSE;
+    while (continue_now == FALSE) {
+       gtk_main_iteration();
+    }
+    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
+    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
+                       "Running");
+
+    gtk_widget_set_sensitive( continue_but, FALSE );
+    gtk_widget_set_sensitive( stop_but, TRUE );
+    gtk_widget_set_sensitive( quit_but, FALSE );
+
+    while (gtk_events_pending()) {
+       gtk_main_iteration();
+    }
+}
+
+void
+stopFrontPanel( void )
+{
+    gtk_widget_set_sensitive( quit_but, TRUE );
+    gtk_widget_set_sensitive( continue_but, FALSE );
+    gtk_widget_set_sensitive( stop_but, FALSE );
+
+    updateFrontPanel();
+
+    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
+                       "Program finished");
+
+    quit = FALSE;
+    while (quit == FALSE) {
+       gtk_main_iteration();
+    }
+}
+
+static void
+waitForContinue( void )
+{
+    gtk_widget_set_sensitive( continue_but, TRUE );
+    gtk_widget_set_sensitive( stop_but, FALSE );
+    stop_now = FALSE;
+    continue_now = FALSE;
+    while (continue_now == FALSE) {
+       gtk_main_iteration();
+    }
+    gtk_widget_set_sensitive( continue_but, FALSE );
+    gtk_widget_set_sensitive( stop_but, TRUE );
+}
+
+void
+updateFrontPanelBeforeGC( nat N )
+{
+    char buf[1000];
+
+    updateFrontPanel();
+
+    if (update_mode == BeforeGC 
+       || update_mode == BeforeAfterGC
+       || stop_now == TRUE) {
+       g_snprintf( buf, 1000, "Stopped (before GC, generation %d)", N );
+       gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
+       waitForContinue();
+       gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
+    }
+
+    g_snprintf( buf, 1000, "Garbage collecting (generation %d)", N );
+    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf);
+
+    while (gtk_events_pending()) {
+       gtk_main_iteration();
+    }
+}
+
+static void
+numLabel( GtkWidget *lbl, nat n )
+{
+    char buf[64];
+    g_snprintf(buf, 64, "%d", n);
+    gtk_label_set_text( GTK_LABEL(lbl), buf );
+}
+
+void
+updateFrontPanelAfterGC( nat N, lnat live )
+{
+    char buf[1000];
+
+    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
+
+    /* is a major GC? */
+    if (N == RtsFlags.GcFlags.generations-1) {
+       residencyCensus();
+    }
+
+    updateFrontPanel();
+
+    if (update_mode == AfterGC 
+       || update_mode == BeforeAfterGC
+       || stop_now == TRUE) {
+       snprintf( buf, 1000, "Stopped (after GC, generation %d)", N );
+       gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
+       waitForContinue();
+       gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
+    }
+
+    {
+       double words_to_megs = (1024 * 1024) / sizeof(W_);
+       double time = mut_user_time();
+
+       snprintf( buf, 1000, "%.2f", (double)live / words_to_megs );
+       gtk_label_set_text( GTK_LABEL(live_label), buf );
+
+       snprintf( buf, 1000, "%.2f", (double)total_allocated / words_to_megs );
+       gtk_label_set_text( GTK_LABEL(allocated_label), buf );
+
+       snprintf( buf, 1000, "%.2f",
+                 (double)(mblocks_allocated * MBLOCK_SIZE_W) / words_to_megs );
+       gtk_label_set_text( GTK_LABEL(footprint_label), buf );
+
+       if ( time == 0.0 )
+           snprintf( buf, 1000, "%.2f", time );
+       else
+           snprintf( buf, 1000, "%.2f",
+                     (double)(total_allocated / words_to_megs) / time );
+       gtk_label_set_text( GTK_LABEL(alloc_rate_label), buf );
+    }
+
+    while (gtk_events_pending()) {
+       gtk_main_iteration();
+    }
+}
+
+void
+updateFrontPanel( void )
+{
+    void *m, *a;
+    bdescr *bd;
+
+    updateThreadsPanel();
+
+    if (my_gc == NULL) {
+       my_gc = gdk_gc_new( window->window );
+    }
+
+    if (map_pixmap != NULL) {
+       nat height, width, blocks_per_line, 
+           block_height, block_width, mblock_height;
+
+       height = map_drawing_area->allocation.height;
+       width  = map_drawing_area->allocation.width;
+
+       mblock_height =  height / mblocks_allocated;
+       blocks_per_line = 16;
+       block_height  = mblock_height / 
+           ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
+       while (block_height == 0) {
+           blocks_per_line *= 2;
+           block_height  = mblock_height / 
+               ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
+       }
+       block_width = width / blocks_per_line;
+
+       gdk_draw_rectangle (map_pixmap,
+                           map_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
+                           TRUE,
+                           0, 0,
+                           map_drawing_area->allocation.width,
+                           map_drawing_area->allocation.height);
+       
+       for ( m = mem_start; 
+             (char *)m < (char *)mem_start + 
+                 (mblocks_allocated * MBLOCK_SIZE); 
+             (char *)m += MBLOCK_SIZE ) {
+           
+           /* color the bdescr area first */
+           for (a = m; a < FIRST_BLOCK(m); (char *)a += BLOCK_SIZE) {
+               colorBlock( a, &bdescr_color, 
+                           block_width, block_height, blocks_per_line );
+           }
+           
+           /* color each block */
+           for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
+               bd = Bdescr((P_)a);
+               ASSERT(bd->start == a);
+               if (bd->free == (void *)-1) {
+                   colorBlock( a, &free_color, 
+                               block_width, block_height, blocks_per_line );
+               } else if (bd->gen != NULL) {
+                   colorBlock( a, &gen_colors[bd->gen->no],
+                               block_width, block_height, blocks_per_line );
+               } else if (bd->link != NULL) {
+                   if (bd->link->free == (void *)-1) {
+                       colorBlock( a, &free_color, 
+                                   block_width, block_height, blocks_per_line );
+                       
+                   } else if (bd->link->gen != NULL) {
+                       colorBlock( a, &gen_colors[bd->link->gen->no],
+                                   block_width, block_height, blocks_per_line );
+                   } else {
+                       belch("block at %p: can't indentify", bd->start);
+                   }
+               }
+           }
+       }
+
+       
+       { 
+           nat height = map_drawing_area->allocation.height,
+               block_height, mblock_height;
+
+           block_height = (height / mblocks_allocated) / 
+               ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
+           if (block_height < 1) block_height = 1;
+           mblock_height = block_height * 
+               ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
+
+           gtk_ruler_set_range( GTK_RULER(map_ruler), 0, 
+                                (double)(height * mblocks_allocated) / 
+                                (double)((mblock_height * mblocks_allocated)),
+                                0,
+                                (double)(height * mblocks_allocated) / 
+                                (double)((mblock_height * mblocks_allocated))
+               );
+       }
+                                 
+       gtk_widget_draw( map_drawing_area, NULL );
+    }
+
+    if (gen_pixmap != NULL) {
+
+       GdkRectangle rect;
+       nat g, s, columns, column, max_blocks, height_blocks,
+           width, height;
+       
+       gdk_draw_rectangle (gen_pixmap,
+                           gen_drawing_area->style->white_gc,
+                           TRUE,
+                           0, 0,
+                           gen_drawing_area->allocation.width,
+                           gen_drawing_area->allocation.height);
+
+       height = gen_drawing_area->allocation.height;
+       width  = gen_drawing_area->allocation.width;
+
+       columns = 0; max_blocks = 0;
+       for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
+           columns += generations[g].n_steps;
+           for(s = 0; s < generations[g].n_steps; s++) {
+               if (generations[g].steps[s].n_blocks > max_blocks) {
+                   max_blocks = generations[g].steps[s].n_blocks;
+               }
+           }
+       }
+
+       /* find a reasonable height value larger than max_blocks */
+       { 
+           nat n = 0;
+           while (max_blocks != 0) {
+               max_blocks >>= 1; n++;
+           }
+           height_blocks = 1 << n;
+       }
+
+       column = 0;
+       for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
+           for(s = 0; s < generations[g].n_steps; s++, column++) {
+               gdk_gc_set_foreground(my_gc, &gen_colors[g]);
+
+               rect.x = column * (width / columns);
+
+               if (generations[g].steps[s].n_blocks == 0)
+                   rect.y = height;
+               else
+                   rect.y = height - 
+                       (height * generations[g].steps[s].n_blocks
+                        / height_blocks);
+
+               rect.width = (width / columns);
+               rect.height = height - rect.y;
+
+               gdk_draw_rectangle( gen_pixmap, my_gc, TRUE/*filled*/, 
+                                   rect.x, rect.y, rect.width,
+                                   rect.height );
+           }
+       }
+
+       gtk_ruler_set_range( GTK_RULER(gen_ruler), 
+                            height_blocks * BLOCK_SIZE / (1024 * 1024),
+                            0, 0,
+                            height_blocks * BLOCK_SIZE / (1024 * 1024)
+           );
+
+       gtk_widget_draw( gen_drawing_area, NULL );
+    }
+
+    if (res_pixmap != NULL) {
+       updateResidencyGraph();
+    }
+
+    while (gtk_events_pending()) {
+       gtk_main_iteration_do(FALSE/*don't block*/);
+    }
+}
+
+static void
+colorBlock( void *addr, GdkColor *color, 
+           nat block_width, nat block_height, nat blocks_per_line )
+{
+    GdkRectangle rect;
+    nat block_no;
+
+    gdk_gc_set_foreground(my_gc, color);
+
+    block_no = ((char *)addr - (char *)mem_start) / BLOCK_SIZE;
+
+    rect.x = (block_no % blocks_per_line) * block_width;
+    rect.y = block_no / blocks_per_line * block_height;
+    rect.width = block_width;
+    rect.height = block_height;
+    gdk_draw_rectangle( map_pixmap, my_gc, TRUE/*filled*/, 
+                       rect.x, rect.y, rect.width, rect.height );
+}
+
+static void
+updateThreadsPanel( void )
+{
+    nat running = 0,
+       b_read = 0,
+       b_write = 0,
+       b_mvar = 0,
+       b_throwto = 0,
+       b_bh = 0,
+       sleeping = 0,
+       total = 0;
+
+    StgTSO *t;
+
+    for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
+       switch (t->what_next) {
+       case ThreadKilled:          break;
+       case ThreadComplete:        break;
+       default:
+           switch (t->why_blocked) {
+           case BlockedOnRead:       b_read++;    break;
+           case BlockedOnWrite:      b_write++;   break;
+           case BlockedOnDelay:      sleeping++;  break;
+           case BlockedOnMVar:       b_mvar++;    break;
+           case BlockedOnException:  b_throwto++; break;
+           case BlockedOnBlackHole:  b_bh++;      break;
+           case NotBlocked:          running++;   break;
+           }
+       }
+    }
+    total = running + b_read + b_write + b_mvar + b_throwto + b_bh + sleeping;
+    numLabel(running_label,   running);
+    numLabel(b_read_label,    b_read);
+    numLabel(b_write_label,   b_write);
+    numLabel(b_mvar_label,    b_mvar);
+    numLabel(b_bh_label,      b_bh);
+    numLabel(b_throwto_label, b_throwto);
+    numLabel(sleeping_label,  sleeping);
+    numLabel(total_label,     total);
+}
+
+typedef enum { Thunk, Fun, Constr, BlackHole,
+              Array, Thread, Other, N_Cats } ClosureCategory;
+
+#define N_SLICES 100
+
+static nat *res_prof[N_SLICES];
+static double res_time[N_SLICES];
+static nat next_slice = 0;
+
+static void
+residencyCensus( void )
+{
+    nat slice = next_slice++, *prof;
+    bdescr *bd;
+    nat g, s, size, type;
+    StgPtr p;
+    StgInfoTable *info;
+
+    if (slice >= N_SLICES) {
+       barf("too many slices");
+    }
+    res_prof[slice] = stgMallocBytes(N_Cats * sizeof(nat), "residencyCensus");
+    prof = res_prof[slice];
+    memset(prof, 0, N_Cats * sizeof(nat));
+
+    res_time[slice] = mut_user_time();
+    
+    for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
+       for(s = 0; s < generations[g].n_steps; s++) {
+
+           /* skip over g0s0 if multi-generational */
+           if (RtsFlags.GcFlags.generations > 1 &&
+               g == 0 && s == 0) continue;
+
+           if (RtsFlags.GcFlags.generations == 1) {
+               bd = generations[g].steps[s].to_space;
+           } else {
+               bd = generations[g].steps[s].blocks;
+           }
+
+           for (; bd != NULL; bd = bd->link) {
+
+               p = bd->start;
+
+               while (p < bd->free) {
+                   info = get_itbl((StgClosure *)p);
+                   type = Other;
+                   
+                   switch (info->type) {
+                   case BCO:
+                       size = bco_sizeW((StgBCO *)p);
+                       type = Other;
+                       break;
+                       
+                   case CONSTR:
+                       if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
+                           size = sizeofW(StgWeak);
+                           type = Other;
+                           break;
+                       }
+                       /* else, fall through... */
+                   case CONSTR_1_0:
+                   case CONSTR_0_1:
+                   case CONSTR_1_1:
+                   case CONSTR_0_2:
+                   case CONSTR_2_0:
+                       size = sizeW_fromITBL(info);
+                       type = Constr;
+                       break;
+                       
+                   case FUN_1_0:
+                   case FUN_0_1:
+                       size = sizeofW(StgHeader) + 1;
+                       goto fun;
+                   case FUN_1_1:
+                   case FUN_0_2:
+                   case FUN_2_0:
+                   case FUN:
+                       size = sizeW_fromITBL(info);
+                   fun:
+                       type = Fun;
+                       break;
+
+                   case THUNK_1_0:
+                   case THUNK_0_1:
+                   case THUNK_SELECTOR:
+                       size = sizeofW(StgHeader) + 2;
+                       goto thunk;
+                   case THUNK_1_1:
+                   case THUNK_0_2:
+                   case THUNK_2_0:
+                   case THUNK:
+                       size = sizeW_fromITBL(info);
+                   thunk:
+                       type = Thunk;
+                       break;
+
+                   case CAF_BLACKHOLE:
+                   case SE_CAF_BLACKHOLE:
+                   case SE_BLACKHOLE:
+                   case BLACKHOLE:
+                   case BLACKHOLE_BQ:
+                       size = sizeW_fromITBL(info);
+                       type = BlackHole;
+                       break;
+
+                   case AP_UPD:
+                       size = pap_sizeW((StgPAP *)p);
+                       type = Thunk;
+                       break;
+
+                   case PAP:
+                       size = pap_sizeW((StgPAP *)p);
+                       type = Fun;
+                       break;
+                       
+                   case ARR_WORDS:
+                       size = arr_words_sizeW(stgCast(StgArrWords*,p));
+                       type = Array;
+                       break;
+                       
+                   case MUT_ARR_PTRS:
+                   case MUT_ARR_PTRS_FROZEN:
+                       size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+                       type = Array;
+                       break;
+                       
+                   case TSO:
+                       size = tso_sizeW((StgTSO *)p);
+                       type = Thread;
+                       break;
+                       
+                   case WEAK:
+                   case FOREIGN:
+                   case STABLE_NAME:
+                   case MVAR:
+                   case MUT_VAR:
+                   case IND_PERM:
+                   case IND_OLDGEN_PERM:
+                       size = sizeW_fromITBL(info);
+                       type = Other;
+                       break;
+
+                   default:
+                       barf("updateResidencyGraph: strange closure "
+                             "%d", info->type );
+                   }
+
+                   prof[type] += size;
+                   p += size;
+               }
+           }
+       }
+    }
+
+}
+           
+static void
+updateResidencyGraph( void )
+{
+    nat total, prev_total, i, max_res;
+    double time;
+    double time_scale = 1;
+    nat last_slice = next_slice-1;
+    double res_scale  = 1; /* in megabytes, doubles */
+    nat *prof;
+    nat width, height;
+    GdkPoint points[4];
+
+    gdk_draw_rectangle (res_pixmap,
+                       res_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
+                       TRUE,
+                       0, 0,
+                       res_drawing_area->allocation.width,
+                       res_drawing_area->allocation.height);
+    
+    if (next_slice == 0) return;
+
+    time = res_time[last_slice];
+    while (time > time_scale) {
+       time_scale *= 2;
+    }
+
+    max_res = 0; 
+    for (i = 0; i < next_slice; i++) {
+       prof = res_prof[i];
+       total = prof[Thunk] + prof[Fun] + prof[Constr] +
+           prof[BlackHole] + prof[Array] + prof[Other];
+       if (total > max_res) {
+           max_res = total;
+       }
+    }
+    while (max_res > res_scale) {
+       res_scale *= 2;
+    }
+
+    height = res_drawing_area->allocation.height;
+    width  = res_drawing_area->allocation.width;
+
+    points[0].x = 0;
+    points[0].y = height;
+    points[1].y = height;
+    points[3].x = 0;
+    points[3].y = height;
+
+    gdk_gc_set_foreground(my_gc, &free_color);
+
+    prev_total = 0;
+    for (i = 0; i < next_slice; i++) {
+       prof = res_prof[i];
+       total = prof[Thunk] + prof[Fun] + prof[Constr] +
+           prof[BlackHole] + prof[Array] + prof[Other];
+       points[1].x = width * res_time[i] / time_scale;
+       points[2].x = points[1].x;
+       points[2].y = height - ((height * total) / res_scale);
+       gdk_draw_polygon(res_pixmap, my_gc, TRUE/*filled*/, points, 4);
+       points[3] = points[2];
+       points[0] = points[1];
+    }
+
+    gtk_ruler_set_range( GTK_RULER(res_vruler), 
+                        res_scale / ((1024*1024)/sizeof(W_)),
+                        0, 0,
+                        res_scale / ((1024*1024)/sizeof(W_)) );
+
+    gtk_ruler_set_range( GTK_RULER(res_hruler), 
+                        0, time_scale, 0, time_scale );
+
+
+    gtk_widget_draw( res_drawing_area, NULL );
+}
+
+#endif /* RTS_GTK_FRONTPANEL */
diff --git a/ghc/rts/FrontPanel.h b/ghc/rts/FrontPanel.h
new file mode 100644 (file)
index 0000000..e2ea76c
--- /dev/null
@@ -0,0 +1,31 @@
+/* -----------------------------------------------------------------------------
+ * $Id: FrontPanel.h,v 1.1 2000/11/01 11:41:47 simonmar Exp $
+ *
+ * (c) The GHC Team 2000
+ *
+ * RTS GTK Front Panel
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifdef RTS_GTK_FRONTPANEL
+
+#include "Rts.h"  /* needed because this file gets included by
+                  * auto-generated code */
+
+void initFrontPanel( void );
+void stopFrontPanel( void );
+void updateFrontPanelBeforeGC( nat N );
+void updateFrontPanelAfterGC( nat N, lnat live );
+void updateFrontPanel( void );
+
+
+/* --------- PRIVATE ----------------------------------------- */
+
+#include <gdk/gdktypes.h>
+
+typedef enum { BeforeGC, AfterGC, BeforeAfterGC, Continuous } UpdateMode;
+extern UpdateMode update_mode;
+extern gboolean continue_now, stop_now, quit;
+
+#endif /* RTS_GTK_FRONTPANEL */
+
index ef4e7e6..7578d1c 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.85 2000/10/06 15:38:06 simonmar Exp $
+ * $Id: GC.c,v 1.86 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -56,6 +56,9 @@
 # include "HsFFI.h"
 # include "Linker.h"
 #endif
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
 
 //@node STATIC OBJECT LIST, Static function declarations, Includes
 //@subsection STATIC OBJECT LIST
@@ -130,7 +133,6 @@ static rtsBool failed_to_evac;
  */
 bdescr *old_to_space;
 
-
 /* Data used for allocation area sizing.
  */
 lnat new_blocks;               /* blocks allocated during this GC */
@@ -213,7 +215,9 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   CCCS = CCS_GC;
 #endif
 
-  /* Approximate how much we allocated */
+  /* Approximate how much we allocated.  
+   * Todo: only when generating stats? 
+   */
   allocated = calcAllocated();
 
   /* Figure out which generation to collect
@@ -231,6 +235,12 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
     major_gc = (N == RtsFlags.GcFlags.generations-1);
   }
 
+#ifdef RTS_GTK_FRONTPANEL
+  if (RtsFlags.GcFlags.frontpanel) {
+      updateFrontPanelBeforeGC(N);
+  }
+#endif
+
   /* check stack sanity *before* GC (ToDo: check all threads) */
 #if defined(GRAN)
   // ToDo!: check sanity  IF_DEBUG(sanity, checkTSOsSanity());
@@ -762,6 +772,12 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   /* check for memory leaks if sanity checking is on */
   IF_DEBUG(sanity, memInventory());
 
+#ifdef RTS_GTK_VISUALS
+  if (RtsFlags.GcFlags.visuals) {
+      updateFrontPanelAfterGC( N, live );
+  }
+#endif
+
   /* ok, GC over: tell the stats department what happened. */
   stat_endGC(allocated, collected, live, copied, N);
 }
index 265008d..4ff8d8c 100644 (file)
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.37 2000/09/11 15:02:51 rrt Exp $
+# $Id: Makefile,v 1.38 2000/11/01 11:41:47 simonmar Exp $
 #
 #  This is the Makefile for the runtime-system stuff.
 #  This stuff is written in C (and cannot be written in Haskell).
@@ -72,6 +72,24 @@ ifeq "$(way)" "mp"
 SRC_HC_OPTS += -I$$PVM_ROOT/include
 endif
 
+#-----------------------------------------------------------------------------
+# Include the Front panel code?
+
+# we need GTK+ for the front panel
+ifneq "$(GTK_CONFIG)" ""
+
+ifeq "$(GhcRtsWithFrontPanel)" "YES"
+SRC_HC_OPTS += `$(GTK_CONFIG) --cflags` -optc-DRTS_GTK_FRONTPANEL
+else
+SRCS_RTS_C :=  $(filter-out Vis*.c, $(SRCS_RTS_C))
+endif
+
+VisCallbacks_CC_OPTS = -optc-Wno-unused
+
+endif # GTK_CONFIG
+
+#-----------------------------------------------------------------------------
+
 C_SRCS = $(SRCS_RTS_C) $(SRCS_RTS_HC) $(SRCS_RTS_S)
 
 SRC_MKDEPENDC_OPTS += -I. -I../includes
index 1a4effe..3dc773f 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.32 2000/10/06 15:35:09 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.33 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -229,6 +229,9 @@ void initRtsFlagsDefaults(void)
     RtsFlags.GcFlags.steps              = 2;
 
     RtsFlags.GcFlags.squeezeUpdFrames  = rtsTrue;
+#ifdef RTS_GTK_FRONTPANEL
+    RtsFlags.GcFlags.frontpanel         = rtsFalse;
+#endif
 
 #if defined(PROFILING) || defined(PAR)
     RtsFlags.CcFlags.doCostCentres     = 0;
@@ -353,7 +356,7 @@ usage_text[] = {
 "",
 "The following run time system options are available:",
 "",
-"  -? -f    Prints this message and exits; the program is not executed",
+"  -?       Prints this message and exits; the program is not executed",
 "",
 "  -K<size> Sets the maximum stack size (default 1M)  Egs: -K32k   -K512k",
 "  -k<size> Sets the initial thread stack size (default 1k)  Egs: -K4k   -K2m",
@@ -366,6 +369,9 @@ usage_text[] = {
 "  -T<n>    Number of steps in younger generations (default: 2)",
 "  -s<file> Summary GC statistics   (default file: <program>.stat)",
 "  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
+#ifdef RTS_GTK_FRONTPANEL
+"  -f       Display front panel (requires X11 & GTK+)",
+#endif
 "",
 "",
 "  -Z       Don't squeeze out update frames on stack overflow",
@@ -566,7 +572,6 @@ error = rtsTrue;
 
              /* =========== GENERAL ========================== */
              case '?':
-             case 'f':
                error = rtsTrue;
                break;
 
@@ -656,6 +661,12 @@ error = rtsTrue;
                }
                break;
 
+#ifdef RTS_GTK_FRONTPANEL
+             case 'f':
+                 RtsFlags.GcFlags.frontpanel = rtsTrue;
+                 break;
+#endif
+
              case 'S':
                RtsFlags.GcFlags.giveStats ++;
 
index 835e954..192ac61 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.27 2000/10/06 15:35:09 simonmar Exp $
+ * $Id: RtsFlags.h,v 1.28 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -35,6 +35,10 @@ struct GC_FLAGS {
     rtsBool ringBell;
 
     rtsBool squeezeUpdFrames;
+
+#ifdef RTS_GTK_FRONTPANEL
+    rtsBool frontpanel;
+#endif
 };
 
 /* Hack: this struct uses bitfields so that we can use a binary arg
index f992f1b..705f72a 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.43 2000/10/06 15:35:47 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.44 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
 #include "Linker.h"
 #endif
 
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
+
 #if defined(PROFILING) || defined(DEBUG)
 # include "Profiling.h"
 # include "ProfHeap.h"
@@ -196,6 +200,12 @@ startupHaskell(int argc, char *argv[], void *init_root)
     fixupRTStoPreludeRefs(NULL);
 #endif
 
+#ifdef RTS_GTK_FRONTPANEL
+    if (RtsFlags.GcFlags.frontpanel) {
+       initFrontPanel();
+    }
+#endif
+
     /* Record initialization times */
     end_init();
 }
@@ -313,6 +323,12 @@ shutdownHaskell(void)
    */
   exitStorage();
 
+#ifdef RTS_GTK_FRONTPANEL
+    if (RtsFlags.GcFlags.frontpanel) {
+       stopFrontPanel();
+    }
+#endif
+
 #if defined(PROFILING) || defined(DEBUG)
   endProfiling();
 #endif
index c903d3f..5919f7e 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.26 2000/07/14 13:28:35 simonmar Exp $
+ * $Id: Storage.c,v 1.27 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -40,6 +40,8 @@ generation *g0;                       /* generation 0, for convenience */
 generation *oldest_gen;                /* oldest generation, for convenience */
 step *g0s0;                    /* generation 0, step 0, for convenience */
 
+lnat total_allocated = 0;      /* total memory allocated during run */
+
 /*
  * Storage manager mutex:  protects all the above state from
  * simultaneous access by two STG threads.
@@ -191,7 +193,7 @@ initStorage (void)
 void
 exitStorage (void)
 {
-  stat_exit(calcAllocated());
+    stat_exit(calcAllocated());
 }
 
 
@@ -578,6 +580,7 @@ calcAllocated( void )
   }
 #endif
 
+  total_allocated += allocated;
   return allocated;
 }  
 
index 5b4019d..7ef008d 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.10 1999/11/09 15:47:00 simonmar Exp $
+ * $Id: StoragePriv.h,v 1.11 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -36,6 +36,8 @@ extern nat nursery_blocks;
 extern nat alloc_blocks;
 extern nat alloc_blocks_lim;
 
+extern lnat total_allocated;
+
 /* Nursery manipulation */
 extern void     allocNurseries ( void );
 extern void     resetNurseries ( void );
diff --git a/ghc/rts/VisCallbacks.c b/ghc/rts/VisCallbacks.c
new file mode 100644 (file)
index 0000000..928ed60
--- /dev/null
@@ -0,0 +1,78 @@
+/* -----------------------------------------------------------------------------
+ * $Id: VisCallbacks.c,v 1.1 2000/11/01 11:41:47 simonmar Exp $
+ *
+ * (c) The GHC Team 2000
+ *
+ * RTS GTK Front Panel (callbacks)
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifdef RTS_GTK_FRONTPANEL
+
+#define NON_POSIX_SOURCE
+
+#include "Rts.h"
+
+#include <gtk/gtk.h>
+
+#include "VisCallbacks.h"
+#include "VisWindow.h"
+#include "VisSupport.h"
+#include "FrontPanel.h"
+
+void
+on_cont_radio_clicked                  (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    update_mode = Continuous;
+}
+
+
+void
+on_stop_before_radio_clicked           (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    update_mode = BeforeGC;
+}
+
+
+void
+on_stop_after_radio_clicked            (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    update_mode = AfterGC;
+}
+
+
+void
+on_stop_both_radio_clicked             (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    update_mode = BeforeAfterGC;
+}
+
+
+void
+on_stop_but_clicked                    (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    stop_now = TRUE;
+}
+
+
+void
+on_continue_but_clicked                (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    continue_now = TRUE;
+}
+
+
+void
+on_quit_but_clicked                    (GtkButton       *button,
+                                        gpointer         user_data)
+{
+    quit = TRUE;
+}
+
+#endif /* RTS_GTK_FRONTPANEL */
diff --git a/ghc/rts/VisCallbacks.h b/ghc/rts/VisCallbacks.h
new file mode 100644 (file)
index 0000000..d242010
--- /dev/null
@@ -0,0 +1,30 @@
+#include <gtk/gtk.h>
+
+
+void
+on_cont_radio_clicked                  (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_stop_before_radio_clicked           (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_stop_after_radio_clicked            (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_stop_both_radio_clicked             (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_stop_but_clicked                    (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_continue_but_clicked                (GtkButton       *button,
+                                        gpointer         user_data);
+
+void
+on_quit_but_clicked                    (GtkButton       *button,
+                                        gpointer         user_data);
diff --git a/ghc/rts/VisSupport.c b/ghc/rts/VisSupport.c
new file mode 100644 (file)
index 0000000..f1c6bfb
--- /dev/null
@@ -0,0 +1,162 @@
+/*
+ * DO NOT EDIT THIS FILE - it is generated by Glade.
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <string.h>
+
+#include <gtk/gtk.h>
+
+#include "VisSupport.h"
+
+/* This is an internally used function to check if a pixmap file exists. */
+static gchar* check_file_exists        (const gchar     *directory,
+                                        const gchar     *filename);
+
+/* This is an internally used function to create pixmaps. */
+static GtkWidget* create_dummy_pixmap  (GtkWidget       *widget);
+
+GtkWidget*
+lookup_widget                          (GtkWidget       *widget,
+                                        const gchar     *widget_name)
+{
+  GtkWidget *parent, *found_widget;
+
+  for (;;)
+    {
+      if (GTK_IS_MENU (widget))
+        parent = gtk_menu_get_attach_widget (GTK_MENU (widget));
+      else
+        parent = widget->parent;
+      if (parent == NULL)
+        break;
+      widget = parent;
+    }
+
+  found_widget = (GtkWidget*) gtk_object_get_data (GTK_OBJECT (widget),
+                                                   widget_name);
+  if (!found_widget)
+    g_warning ("Widget not found: %s", widget_name);
+  return found_widget;
+}
+
+/* This is a dummy pixmap we use when a pixmap can't be found. */
+static char *dummy_pixmap_xpm[] = {
+/* columns rows colors chars-per-pixel */
+"1 1 1 1",
+"  c None",
+/* pixels */
+" "
+};
+
+/* This is an internally used function to create pixmaps. */
+static GtkWidget*
+create_dummy_pixmap                    (GtkWidget       *widget)
+{
+  GdkColormap *colormap;
+  GdkPixmap *gdkpixmap;
+  GdkBitmap *mask;
+  GtkWidget *pixmap;
+
+  colormap = gtk_widget_get_colormap (widget);
+  gdkpixmap = gdk_pixmap_colormap_create_from_xpm_d (NULL, colormap, &mask,
+                                                     NULL, dummy_pixmap_xpm);
+  if (gdkpixmap == NULL)
+    g_error ("Couldn't create replacement pixmap.");
+  pixmap = gtk_pixmap_new (gdkpixmap, mask);
+  gdk_pixmap_unref (gdkpixmap);
+  gdk_bitmap_unref (mask);
+  return pixmap;
+}
+
+static GList *pixmaps_directories = NULL;
+
+/* Use this function to set the directory containing installed pixmaps. */
+void
+add_pixmap_directory                   (const gchar     *directory)
+{
+  pixmaps_directories = g_list_prepend (pixmaps_directories,
+                                        g_strdup (directory));
+}
+
+/* This is an internally used function to create pixmaps. */
+GtkWidget*
+create_pixmap                          (GtkWidget       *widget,
+                                        const gchar     *filename)
+{
+  gchar *found_filename = NULL;
+  GdkColormap *colormap;
+  GdkPixmap *gdkpixmap;
+  GdkBitmap *mask;
+  GtkWidget *pixmap;
+  GList *elem;
+
+  if (!filename || !filename[0])
+      return create_dummy_pixmap (widget);
+
+  /* We first try any pixmaps directories set by the application. */
+  elem = pixmaps_directories;
+  while (elem)
+    {
+      found_filename = check_file_exists ((gchar*)elem->data, filename);
+      if (found_filename)
+        break;
+      elem = elem->next;
+    }
+
+  /* If we haven't found the pixmap, try the source directory. */
+  if (!found_filename)
+    {
+      found_filename = check_file_exists ("../pixmaps", filename);
+    }
+
+  if (!found_filename)
+    {
+      g_warning ("Couldn't find pixmap file: %s", filename);
+      return create_dummy_pixmap (widget);
+    }
+
+  colormap = gtk_widget_get_colormap (widget);
+  gdkpixmap = gdk_pixmap_colormap_create_from_xpm (NULL, colormap, &mask,
+                                                   NULL, found_filename);
+  if (gdkpixmap == NULL)
+    {
+      g_warning ("Error loading pixmap file: %s", found_filename);
+      g_free (found_filename);
+      return create_dummy_pixmap (widget);
+    }
+  g_free (found_filename);
+  pixmap = gtk_pixmap_new (gdkpixmap, mask);
+  gdk_pixmap_unref (gdkpixmap);
+  gdk_bitmap_unref (mask);
+  return pixmap;
+}
+
+/* This is an internally used function to check if a pixmap file exists. */
+gchar*
+check_file_exists                      (const gchar     *directory,
+                                        const gchar     *filename)
+{
+  gchar *full_filename;
+  struct stat s;
+  gint status;
+
+  full_filename = (gchar*) g_malloc (strlen (directory) + 1
+                                     + strlen (filename) + 1);
+  strcpy (full_filename, directory);
+  strcat (full_filename, G_DIR_SEPARATOR_S);
+  strcat (full_filename, filename);
+
+  status = stat (full_filename, &s);
+  if (status == 0 && S_ISREG (s.st_mode))
+    return full_filename;
+  g_free (full_filename);
+  return NULL;
+}
+
diff --git a/ghc/rts/VisSupport.h b/ghc/rts/VisSupport.h
new file mode 100644 (file)
index 0000000..aee31f9
--- /dev/null
@@ -0,0 +1,38 @@
+/*
+ * DO NOT EDIT THIS FILE - it is generated by Glade.
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <gtk/gtk.h>
+
+/*
+ * Public Functions.
+ */
+
+/*
+ * This function returns a widget in a component created by Glade.
+ * Call it with the toplevel widget in the component (i.e. a window/dialog),
+ * or alternatively any widget in the component, and the name of the widget
+ * you want returned.
+ */
+GtkWidget*  lookup_widget              (GtkWidget       *widget,
+                                        const gchar     *widget_name);
+
+/* get_widget() is deprecated. Use lookup_widget instead. */
+#define get_widget lookup_widget
+
+/* Use this function to set the directory containing installed pixmaps. */
+void        add_pixmap_directory       (const gchar     *directory);
+
+
+/*
+ * Private Functions.
+ */
+
+/* This is used to create the pixmaps in the interface. */
+GtkWidget*  create_pixmap              (GtkWidget       *widget,
+                                        const gchar     *filename);
+
diff --git a/ghc/rts/VisWindow.c b/ghc/rts/VisWindow.c
new file mode 100644 (file)
index 0000000..711dcdb
--- /dev/null
@@ -0,0 +1,738 @@
+/*
+ * DO NOT EDIT THIS FILE - it is generated by Glade.
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <string.h>
+
+#include <gdk/gdkkeysyms.h>
+#include <gtk/gtk.h>
+
+#include "VisCallbacks.h"
+#include "VisWindow.h"
+#include "VisSupport.h"
+
+GtkWidget*
+create_GHC_Visualisation_Tool (void)
+{
+  GtkWidget *GHC_Visualisation_Tool;
+  GtkWidget *vbox1;
+  GtkWidget *hbox1;
+  GtkWidget *vbox4;
+  GtkWidget *frame3;
+  GtkWidget *hbox3;
+  GtkWidget *label40;
+  GtkWidget *map_ruler;
+  GtkWidget *memmap;
+  GtkWidget *frame8;
+  GtkWidget *vbox14;
+  GtkWidget *table4;
+  GtkWidget *gen_ruler;
+  GtkWidget *gen_hbox;
+  GtkWidget *generations;
+  GtkWidget *label39;
+  GtkWidget *frame7;
+  GtkWidget *table3;
+  GtkWidget *res_hruler;
+  GtkWidget *res_vruler;
+  GtkWidget *res_drawingarea;
+  GtkWidget *label37;
+  GtkWidget *label38;
+  GtkWidget *vbox5;
+  GtkWidget *frame5;
+  GtkWidget *vbox6;
+  GtkWidget *table1;
+  GtkWidget *label12;
+  GtkWidget *label13;
+  GtkWidget *label14;
+  GtkWidget *label15;
+  GtkWidget *label16;
+  GtkWidget *label17;
+  GtkWidget *label18;
+  GtkWidget *label19;
+  GtkWidget *live_label;
+  GtkWidget *allocated_label;
+  GtkWidget *footprint_label;
+  GtkWidget *alloc_rate_label;
+  GtkWidget *frame9;
+  GtkWidget *table5;
+  GtkWidget *label20;
+  GtkWidget *label21;
+  GtkWidget *label22;
+  GtkWidget *label24;
+  GtkWidget *label26;
+  GtkWidget *label25;
+  GtkWidget *label27;
+  GtkWidget *running_label;
+  GtkWidget *blockread_label;
+  GtkWidget *blockwrite_label;
+  GtkWidget *blockmvar_label;
+  GtkWidget *blockthrowto_label;
+  GtkWidget *blockbh_label;
+  GtkWidget *sleeping_label;
+  GtkWidget *hseparator1;
+  GtkWidget *hseparator2;
+  GtkWidget *label35;
+  GtkWidget *total_label;
+  GtkWidget *frame6;
+  GtkWidget *vbox7;
+  GtkWidget *vbox9;
+  GSList *grp1_group = NULL;
+  GtkWidget *cont_radio;
+  GtkWidget *stop_before_radio;
+  GtkWidget *stop_after_radio;
+  GtkWidget *stop_both_radio;
+  GtkWidget *vbox8;
+  GtkWidget *stop_but;
+  GtkWidget *continue_but;
+  GtkWidget *quit_but;
+  GtkWidget *statusbar;
+
+  GHC_Visualisation_Tool = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+  gtk_object_set_data (GTK_OBJECT (GHC_Visualisation_Tool), "GHC_Visualisation_Tool", GHC_Visualisation_Tool);
+  gtk_window_set_title (GTK_WINDOW (GHC_Visualisation_Tool), "GHC Visualisation Tool");
+  gtk_window_set_default_size (GTK_WINDOW (GHC_Visualisation_Tool), 450, 600);
+
+  vbox1 = gtk_vbox_new (FALSE, 0);
+  gtk_widget_ref (vbox1);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox1", vbox1,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox1);
+  gtk_container_add (GTK_CONTAINER (GHC_Visualisation_Tool), vbox1);
+
+  hbox1 = gtk_hbox_new (FALSE, 10);
+  gtk_widget_ref (hbox1);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "hbox1", hbox1,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (hbox1);
+  gtk_box_pack_start (GTK_BOX (vbox1), hbox1, TRUE, TRUE, 0);
+  gtk_container_set_border_width (GTK_CONTAINER (hbox1), 10);
+
+  vbox4 = gtk_vbox_new (FALSE, 10);
+  gtk_widget_ref (vbox4);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox4", vbox4,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox4);
+  gtk_box_pack_start (GTK_BOX (hbox1), vbox4, TRUE, TRUE, 0);
+
+  frame3 = gtk_frame_new ("Memory Map");
+  gtk_widget_ref (frame3);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame3", frame3,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame3);
+  gtk_box_pack_start (GTK_BOX (vbox4), frame3, TRUE, TRUE, 0);
+
+  hbox3 = gtk_hbox_new (FALSE, 0);
+  gtk_widget_ref (hbox3);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "hbox3", hbox3,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (hbox3);
+  gtk_container_add (GTK_CONTAINER (frame3), hbox3);
+
+  label40 = gtk_label_new ("Mb");
+  gtk_widget_ref (label40);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label40", label40,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label40);
+  gtk_box_pack_start (GTK_BOX (hbox3), label40, FALSE, FALSE, 0);
+
+  map_ruler = gtk_vruler_new ();
+  gtk_widget_ref (map_ruler);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "map_ruler", map_ruler,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (map_ruler);
+  gtk_box_pack_start (GTK_BOX (hbox3), map_ruler, FALSE, FALSE, 0);
+  gtk_ruler_set_range (GTK_RULER (map_ruler), 0, 10, 5.18797, 10);
+
+  memmap = gtk_drawing_area_new ();
+  gtk_widget_ref (memmap);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "memmap", memmap,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (memmap);
+  gtk_box_pack_start (GTK_BOX (hbox3), memmap, TRUE, TRUE, 0);
+
+  frame8 = gtk_frame_new ("Generations");
+  gtk_widget_ref (frame8);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame8", frame8,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame8);
+  gtk_box_pack_start (GTK_BOX (vbox4), frame8, TRUE, TRUE, 0);
+
+  vbox14 = gtk_vbox_new (FALSE, 0);
+  gtk_widget_ref (vbox14);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox14", vbox14,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox14);
+  gtk_container_add (GTK_CONTAINER (frame8), vbox14);
+
+  table4 = gtk_table_new (2, 3, FALSE);
+  gtk_widget_ref (table4);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "table4", table4,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (table4);
+  gtk_box_pack_start (GTK_BOX (vbox14), table4, TRUE, TRUE, 0);
+
+  gen_ruler = gtk_vruler_new ();
+  gtk_widget_ref (gen_ruler);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "gen_ruler", gen_ruler,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (gen_ruler);
+  gtk_table_attach (GTK_TABLE (table4), gen_ruler, 1, 2, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
+  gtk_ruler_set_range (GTK_RULER (gen_ruler), 0, 10, 1.69935, 10);
+
+  gen_hbox = gtk_hbox_new (FALSE, 0);
+  gtk_widget_ref (gen_hbox);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "gen_hbox", gen_hbox,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (gen_hbox);
+  gtk_table_attach (GTK_TABLE (table4), gen_hbox, 2, 3, 1, 2,
+                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL),
+                    (GtkAttachOptions) (GTK_FILL), 0, 0);
+
+  generations = gtk_drawing_area_new ();
+  gtk_widget_ref (generations);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "generations", generations,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (generations);
+  gtk_table_attach (GTK_TABLE (table4), generations, 2, 3, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_FILL), 0, 0);
+
+  label39 = gtk_label_new ("Mb");
+  gtk_widget_ref (label39);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label39", label39,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label39);
+  gtk_table_attach (GTK_TABLE (table4), label39, 0, 1, 0, 1,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  frame7 = gtk_frame_new ("Residency");
+  gtk_widget_ref (frame7);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame7", frame7,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame7);
+  gtk_box_pack_start (GTK_BOX (vbox4), frame7, TRUE, TRUE, 0);
+
+  table3 = gtk_table_new (3, 3, FALSE);
+  gtk_widget_ref (table3);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "table3", table3,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (table3);
+  gtk_container_add (GTK_CONTAINER (frame7), table3);
+  gtk_container_set_border_width (GTK_CONTAINER (table3), 2);
+
+  res_hruler = gtk_hruler_new ();
+  gtk_widget_ref (res_hruler);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "res_hruler", res_hruler,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (res_hruler);
+  gtk_table_attach (GTK_TABLE (table3), res_hruler, 2, 3, 1, 2,
+                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL),
+                    (GtkAttachOptions) (GTK_FILL), 0, 0);
+  gtk_ruler_set_range (GTK_RULER (res_hruler), 0, 10, 8.35443, 10);
+
+  res_vruler = gtk_vruler_new ();
+  gtk_widget_ref (res_vruler);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "res_vruler", res_vruler,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (res_vruler);
+  gtk_table_attach (GTK_TABLE (table3), res_vruler, 1, 2, 2, 3,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
+  gtk_ruler_set_range (GTK_RULER (res_vruler), 0, 10, 9.69925, 10);
+
+  res_drawingarea = gtk_drawing_area_new ();
+  gtk_widget_ref (res_drawingarea);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "res_drawingarea", res_drawingarea,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (res_drawingarea);
+  gtk_table_attach (GTK_TABLE (table3), res_drawingarea, 2, 3, 2, 3,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_FILL), 0, 0);
+
+  label37 = gtk_label_new ("Secs");
+  gtk_widget_ref (label37);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label37", label37,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label37);
+  gtk_table_attach (GTK_TABLE (table3), label37, 2, 3, 0, 1,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  label38 = gtk_label_new ("Mb");
+  gtk_widget_ref (label38);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label38", label38,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label38);
+  gtk_table_attach (GTK_TABLE (table3), label38, 0, 1, 2, 3,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  vbox5 = gtk_vbox_new (FALSE, 10);
+  gtk_widget_ref (vbox5);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox5", vbox5,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox5);
+  gtk_box_pack_end (GTK_BOX (hbox1), vbox5, FALSE, FALSE, 0);
+
+  frame5 = gtk_frame_new ("Stats");
+  gtk_widget_ref (frame5);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame5", frame5,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame5);
+  gtk_box_pack_start (GTK_BOX (vbox5), frame5, FALSE, TRUE, 0);
+
+  vbox6 = gtk_vbox_new (FALSE, 0);
+  gtk_widget_ref (vbox6);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox6", vbox6,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox6);
+  gtk_container_add (GTK_CONTAINER (frame5), vbox6);
+  gtk_container_set_border_width (GTK_CONTAINER (vbox6), 5);
+
+  table1 = gtk_table_new (4, 3, FALSE);
+  gtk_widget_ref (table1);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "table1", table1,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (table1);
+  gtk_box_pack_start (GTK_BOX (vbox6), table1, TRUE, TRUE, 0);
+  gtk_table_set_col_spacings (GTK_TABLE (table1), 7);
+
+  label12 = gtk_label_new ("Allocated");
+  gtk_widget_ref (label12);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label12", label12,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label12);
+  gtk_table_attach (GTK_TABLE (table1), label12, 0, 1, 1, 2,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_label_set_justify (GTK_LABEL (label12), GTK_JUSTIFY_RIGHT);
+  gtk_misc_set_alignment (GTK_MISC (label12), 1, 0.5);
+
+  label13 = gtk_label_new ("Live");
+  gtk_widget_ref (label13);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label13", label13,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label13);
+  gtk_table_attach (GTK_TABLE (table1), label13, 0, 1, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_label_set_justify (GTK_LABEL (label13), GTK_JUSTIFY_RIGHT);
+  gtk_misc_set_alignment (GTK_MISC (label13), 1, 0.5);
+
+  label14 = gtk_label_new ("Allocation Rate");
+  gtk_widget_ref (label14);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label14", label14,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label14);
+  gtk_table_attach (GTK_TABLE (table1), label14, 0, 1, 3, 4,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_label_set_justify (GTK_LABEL (label14), GTK_JUSTIFY_RIGHT);
+  gtk_misc_set_alignment (GTK_MISC (label14), 1, 0.5);
+
+  label15 = gtk_label_new ("\t\tFootprint");
+  gtk_widget_ref (label15);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label15", label15,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label15);
+  gtk_table_attach (GTK_TABLE (table1), label15, 0, 1, 2, 3,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_label_set_justify (GTK_LABEL (label15), GTK_JUSTIFY_RIGHT);
+  gtk_misc_set_alignment (GTK_MISC (label15), 1, 0.5);
+
+  label16 = gtk_label_new ("M/sec");
+  gtk_widget_ref (label16);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label16", label16,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label16);
+  gtk_table_attach (GTK_TABLE (table1), label16, 2, 3, 3, 4,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  label17 = gtk_label_new ("M");
+  gtk_widget_ref (label17);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label17", label17,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label17);
+  gtk_table_attach (GTK_TABLE (table1), label17, 2, 3, 2, 3,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_label_set_justify (GTK_LABEL (label17), GTK_JUSTIFY_LEFT);
+  gtk_misc_set_alignment (GTK_MISC (label17), 7.45058e-09, 0.5);
+
+  label18 = gtk_label_new ("M");
+  gtk_widget_ref (label18);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label18", label18,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label18);
+  gtk_table_attach (GTK_TABLE (table1), label18, 2, 3, 1, 2,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label18), 7.45058e-09, 0.5);
+
+  label19 = gtk_label_new ("M");
+  gtk_widget_ref (label19);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label19", label19,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label19);
+  gtk_table_attach (GTK_TABLE (table1), label19, 2, 3, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label19), 7.45058e-09, 0.5);
+
+  live_label = gtk_label_new ("");
+  gtk_widget_ref (live_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "live_label", live_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (live_label);
+  gtk_table_attach (GTK_TABLE (table1), live_label, 1, 2, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_widget_set_usize (live_label, 70, -2);
+  gtk_misc_set_alignment (GTK_MISC (live_label), 1, 0.5);
+
+  allocated_label = gtk_label_new ("");
+  gtk_widget_ref (allocated_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "allocated_label", allocated_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (allocated_label);
+  gtk_table_attach (GTK_TABLE (table1), allocated_label, 1, 2, 1, 2,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_widget_set_usize (allocated_label, 70, -2);
+  gtk_misc_set_alignment (GTK_MISC (allocated_label), 1, 0.5);
+
+  footprint_label = gtk_label_new ("");
+  gtk_widget_ref (footprint_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "footprint_label", footprint_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (footprint_label);
+  gtk_table_attach (GTK_TABLE (table1), footprint_label, 1, 2, 2, 3,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_widget_set_usize (footprint_label, 70, -2);
+  gtk_misc_set_alignment (GTK_MISC (footprint_label), 1, 0.5);
+
+  alloc_rate_label = gtk_label_new ("");
+  gtk_widget_ref (alloc_rate_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "alloc_rate_label", alloc_rate_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (alloc_rate_label);
+  gtk_table_attach (GTK_TABLE (table1), alloc_rate_label, 1, 2, 3, 4,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_widget_set_usize (alloc_rate_label, 70, -2);
+  gtk_misc_set_alignment (GTK_MISC (alloc_rate_label), 1, 0.5);
+
+  frame9 = gtk_frame_new ("Threads");
+  gtk_widget_ref (frame9);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame9", frame9,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame9);
+  gtk_box_pack_start (GTK_BOX (vbox5), frame9, FALSE, TRUE, 0);
+
+  table5 = gtk_table_new (9, 2, FALSE);
+  gtk_widget_ref (table5);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "table5", table5,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (table5);
+  gtk_container_add (GTK_CONTAINER (frame9), table5);
+  gtk_container_set_border_width (GTK_CONTAINER (table5), 6);
+  gtk_table_set_col_spacings (GTK_TABLE (table5), 10);
+
+  label20 = gtk_label_new ("Running");
+  gtk_widget_ref (label20);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label20", label20,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label20);
+  gtk_table_attach (GTK_TABLE (table5), label20, 0, 1, 0, 1,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label20), 1, 0.5);
+
+  label21 = gtk_label_new ("Blocked on I/O (Read)");
+  gtk_widget_ref (label21);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label21", label21,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label21);
+  gtk_table_attach (GTK_TABLE (table5), label21, 0, 1, 1, 2,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label21), 1, 0.5);
+
+  label22 = gtk_label_new ("Blocked on MVar");
+  gtk_widget_ref (label22);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label22", label22,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label22);
+  gtk_table_attach (GTK_TABLE (table5), label22, 0, 1, 3, 4,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label22), 1, 0.5);
+
+  label24 = gtk_label_new ("Blocked on throwTo");
+  gtk_widget_ref (label24);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label24", label24,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label24);
+  gtk_table_attach (GTK_TABLE (table5), label24, 0, 1, 4, 5,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label24), 1, 0.5);
+
+  label26 = gtk_label_new ("Blocked on Black Hole");
+  gtk_widget_ref (label26);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label26", label26,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label26);
+  gtk_table_attach (GTK_TABLE (table5), label26, 0, 1, 5, 6,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label26), 1, 0.5);
+
+  label25 = gtk_label_new ("Sleeping");
+  gtk_widget_ref (label25);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label25", label25,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label25);
+  gtk_table_attach (GTK_TABLE (table5), label25, 0, 1, 6, 7,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label25), 1, 0.5);
+
+  label27 = gtk_label_new ("Blocked on I/O (Write)");
+  gtk_widget_ref (label27);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label27", label27,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label27);
+  gtk_table_attach (GTK_TABLE (table5), label27, 0, 1, 2, 3,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label27), 1, 0.5);
+
+  running_label = gtk_label_new ("label28");
+  gtk_widget_ref (running_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "running_label", running_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (running_label);
+  gtk_table_attach (GTK_TABLE (table5), running_label, 1, 2, 0, 1,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  blockread_label = gtk_label_new ("label29");
+  gtk_widget_ref (blockread_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "blockread_label", blockread_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (blockread_label);
+  gtk_table_attach (GTK_TABLE (table5), blockread_label, 1, 2, 1, 2,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  blockwrite_label = gtk_label_new ("label30");
+  gtk_widget_ref (blockwrite_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "blockwrite_label", blockwrite_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (blockwrite_label);
+  gtk_table_attach (GTK_TABLE (table5), blockwrite_label, 1, 2, 2, 3,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  blockmvar_label = gtk_label_new ("label31");
+  gtk_widget_ref (blockmvar_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "blockmvar_label", blockmvar_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (blockmvar_label);
+  gtk_table_attach (GTK_TABLE (table5), blockmvar_label, 1, 2, 3, 4,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  blockthrowto_label = gtk_label_new ("label32");
+  gtk_widget_ref (blockthrowto_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "blockthrowto_label", blockthrowto_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (blockthrowto_label);
+  gtk_table_attach (GTK_TABLE (table5), blockthrowto_label, 1, 2, 4, 5,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  blockbh_label = gtk_label_new ("label33");
+  gtk_widget_ref (blockbh_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "blockbh_label", blockbh_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (blockbh_label);
+  gtk_table_attach (GTK_TABLE (table5), blockbh_label, 1, 2, 5, 6,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  sleeping_label = gtk_label_new ("label34");
+  gtk_widget_ref (sleeping_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "sleeping_label", sleeping_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (sleeping_label);
+  gtk_table_attach (GTK_TABLE (table5), sleeping_label, 1, 2, 6, 7,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  hseparator1 = gtk_hseparator_new ();
+  gtk_widget_ref (hseparator1);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "hseparator1", hseparator1,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (hseparator1);
+  gtk_table_attach (GTK_TABLE (table5), hseparator1, 0, 1, 7, 8,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
+
+  hseparator2 = gtk_hseparator_new ();
+  gtk_widget_ref (hseparator2);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "hseparator2", hseparator2,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (hseparator2);
+  gtk_table_attach (GTK_TABLE (table5), hseparator2, 1, 2, 7, 8,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (GTK_FILL), 0, 0);
+
+  label35 = gtk_label_new ("Total");
+  gtk_widget_ref (label35);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "label35", label35,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (label35);
+  gtk_table_attach (GTK_TABLE (table5), label35, 0, 1, 8, 9,
+                    (GtkAttachOptions) (GTK_FILL),
+                    (GtkAttachOptions) (0), 0, 0);
+  gtk_misc_set_alignment (GTK_MISC (label35), 1, 0.5);
+
+  total_label = gtk_label_new ("label36");
+  gtk_widget_ref (total_label);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "total_label", total_label,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (total_label);
+  gtk_table_attach (GTK_TABLE (table5), total_label, 1, 2, 8, 9,
+                    (GtkAttachOptions) (0),
+                    (GtkAttachOptions) (0), 0, 0);
+
+  frame6 = gtk_frame_new ("Updates");
+  gtk_widget_ref (frame6);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "frame6", frame6,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (frame6);
+  gtk_box_pack_start (GTK_BOX (vbox5), frame6, FALSE, FALSE, 0);
+
+  vbox7 = gtk_vbox_new (FALSE, 10);
+  gtk_widget_ref (vbox7);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox7", vbox7,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox7);
+  gtk_container_add (GTK_CONTAINER (frame6), vbox7);
+  gtk_container_set_border_width (GTK_CONTAINER (vbox7), 5);
+
+  vbox9 = gtk_vbox_new (FALSE, 0);
+  gtk_widget_ref (vbox9);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox9", vbox9,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox9);
+  gtk_box_pack_start (GTK_BOX (vbox7), vbox9, TRUE, TRUE, 0);
+
+  cont_radio = gtk_radio_button_new_with_label (grp1_group, "Continuous");
+  grp1_group = gtk_radio_button_group (GTK_RADIO_BUTTON (cont_radio));
+  gtk_widget_ref (cont_radio);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "cont_radio", cont_radio,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (cont_radio);
+  gtk_box_pack_start (GTK_BOX (vbox9), cont_radio, FALSE, FALSE, 0);
+  gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (cont_radio), TRUE);
+
+  stop_before_radio = gtk_radio_button_new_with_label (grp1_group, "Stop before GC");
+  grp1_group = gtk_radio_button_group (GTK_RADIO_BUTTON (stop_before_radio));
+  gtk_widget_ref (stop_before_radio);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "stop_before_radio", stop_before_radio,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (stop_before_radio);
+  gtk_box_pack_start (GTK_BOX (vbox9), stop_before_radio, FALSE, FALSE, 0);
+
+  stop_after_radio = gtk_radio_button_new_with_label (grp1_group, "Stop after GC");
+  grp1_group = gtk_radio_button_group (GTK_RADIO_BUTTON (stop_after_radio));
+  gtk_widget_ref (stop_after_radio);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "stop_after_radio", stop_after_radio,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (stop_after_radio);
+  gtk_box_pack_start (GTK_BOX (vbox9), stop_after_radio, FALSE, FALSE, 0);
+
+  stop_both_radio = gtk_radio_button_new_with_label (grp1_group, "Stop before & after GC");
+  grp1_group = gtk_radio_button_group (GTK_RADIO_BUTTON (stop_both_radio));
+  gtk_widget_ref (stop_both_radio);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "stop_both_radio", stop_both_radio,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (stop_both_radio);
+  gtk_box_pack_start (GTK_BOX (vbox9), stop_both_radio, FALSE, FALSE, 0);
+
+  vbox8 = gtk_vbox_new (FALSE, 0);
+  gtk_widget_ref (vbox8);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "vbox8", vbox8,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (vbox8);
+  gtk_box_pack_start (GTK_BOX (vbox7), vbox8, FALSE, FALSE, 0);
+
+  stop_but = gtk_button_new_with_label ("Stop");
+  gtk_widget_ref (stop_but);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "stop_but", stop_but,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (stop_but);
+  gtk_box_pack_start (GTK_BOX (vbox8), stop_but, FALSE, FALSE, 0);
+
+  continue_but = gtk_button_new_with_label ("Continue");
+  gtk_widget_ref (continue_but);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "continue_but", continue_but,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (continue_but);
+  gtk_box_pack_start (GTK_BOX (vbox8), continue_but, FALSE, FALSE, 0);
+
+  quit_but = gtk_button_new_with_label ("Quit");
+  gtk_widget_ref (quit_but);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "quit_but", quit_but,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (quit_but);
+  gtk_box_pack_end (GTK_BOX (vbox5), quit_but, FALSE, FALSE, 0);
+
+  statusbar = gtk_statusbar_new ();
+  gtk_widget_ref (statusbar);
+  gtk_object_set_data_full (GTK_OBJECT (GHC_Visualisation_Tool), "statusbar", statusbar,
+                            (GtkDestroyNotify) gtk_widget_unref);
+  gtk_widget_show (statusbar);
+  gtk_box_pack_start (GTK_BOX (vbox1), statusbar, FALSE, FALSE, 0);
+
+  gtk_signal_connect (GTK_OBJECT (cont_radio), "clicked",
+                      GTK_SIGNAL_FUNC (on_cont_radio_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (stop_before_radio), "clicked",
+                      GTK_SIGNAL_FUNC (on_stop_before_radio_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (stop_after_radio), "clicked",
+                      GTK_SIGNAL_FUNC (on_stop_after_radio_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (stop_both_radio), "clicked",
+                      GTK_SIGNAL_FUNC (on_stop_both_radio_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (stop_but), "clicked",
+                      GTK_SIGNAL_FUNC (on_stop_but_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (continue_but), "clicked",
+                      GTK_SIGNAL_FUNC (on_continue_but_clicked),
+                      NULL);
+  gtk_signal_connect (GTK_OBJECT (quit_but), "clicked",
+                      GTK_SIGNAL_FUNC (on_quit_but_clicked),
+                      NULL);
+
+  return GHC_Visualisation_Tool;
+}
+
diff --git a/ghc/rts/VisWindow.h b/ghc/rts/VisWindow.h
new file mode 100644 (file)
index 0000000..a30c40f
--- /dev/null
@@ -0,0 +1,5 @@
+/*
+ * DO NOT EDIT THIS FILE - it is generated by Glade.
+ */
+
+GtkWidget* create_GHC_Visualisation_Tool (void);