summaryrefslogtreecommitdiff
path: root/rts/FrontPanel.c
diff options
context:
space:
mode:
Diffstat (limited to 'rts/FrontPanel.c')
-rw-r--r--rts/FrontPanel.c802
1 files changed, 802 insertions, 0 deletions
diff --git a/rts/FrontPanel.c b/rts/FrontPanel.c
new file mode 100644
index 0000000000..579b75bab3
--- /dev/null
+++ b/rts/FrontPanel.c
@@ -0,0 +1,802 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2000
+ *
+ * RTS GTK Front Panel
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifdef RTS_GTK_FRONTPANEL
+
+/* Alas, not Posix. */
+/* #include "PosixSource.h" */
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "MBlock.h"
+#include "FrontPanel.h"
+#include "Storage.h"
+#include "Stats.h"
+#include "RtsFlags.h"
+#include "Schedule.h"
+
+#include <gtk/gtk.h>
+#include <unistd.h>
+#include <string.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);
+
+ debugBelch("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_Front_Panel();
+ 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 );
+ }
+
+#if 0 /* Segfaults because bd appears to be bogus but != NULL. stolz, 2003-06-24 */
+ /* color each block */
+ for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
+ bd = Bdescr((P_)a);
+ ASSERT(bd->start == a);
+ if (bd->flags & BF_FREE) {
+ colorBlock( a, &free_color,
+ block_width, block_height, blocks_per_line );
+ } else {
+ colorBlock( a, &gen_colors[bd->gen_no],
+ block_width, block_height, blocks_per_line );
+ }
+ }
+#endif
+ }
+
+
+ {
+ 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_blocks; FIXME to_blocks does not exist */
+ } 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 CONSTR:
+ case BCO:
+ if (((StgClosure *)p)->header.info == &stg_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: FIXME: case does not exist */
+ size = sizeW_fromITBL(info);
+ type = BlackHole;
+ break;
+
+ case AP:
+ 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 STABLE_NAME:
+ case MVAR:
+ case MUT_VAR:
+/* case MUT_CONS: FIXME: case does not exist */
+ 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 */