Import libffi-3.0.4, and use it to provide FFI support in GHCi
[ghc-hetmet.git] / rts / FrontPanel.c
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team 2000
4  *
5  * RTS GTK Front Panel
6  *
7  * ---------------------------------------------------------------------------*/
8
9 #ifdef RTS_GTK_FRONTPANEL
10
11 /* Alas, not Posix. */
12 /* #include "PosixSource.h" */
13
14 #include "Rts.h"
15 #include "RtsUtils.h"
16 #include "MBlock.h"
17 #include "FrontPanel.h"
18 #include "Stats.h"
19 #include "RtsFlags.h"
20 #include "Schedule.h"
21
22 #include <gtk/gtk.h>
23 #include <unistd.h>
24 #include <string.h>
25
26 #include "VisSupport.h"
27 #include "VisWindow.h"
28
29 static GtkWidget *window, *map_drawing_area, *gen_drawing_area;
30 static GtkWidget *res_drawing_area;
31 static GtkWidget *continue_but, *stop_but, *quit_but;
32 static GtkWidget *statusbar;
33 static GtkWidget *live_label, *allocated_label;
34 static GtkWidget *footprint_label, *alloc_rate_label;
35 static GtkWidget *map_ruler, *gen_ruler;
36 static GtkWidget *res_vruler, *res_hruler;
37 static GtkWidget *running_label, *b_read_label, *b_write_label, *total_label;
38 static GtkWidget *b_mvar_label, *b_bh_label, *b_throwto_label, *sleeping_label;
39
40 static guint status_context_id;
41
42 gboolean continue_now = FALSE, stop_now = FALSE, quit = FALSE;
43 UpdateMode update_mode = Continuous;
44
45 static GdkPixmap *map_pixmap = NULL;
46 static GdkPixmap *gen_pixmap = NULL;
47 static GdkPixmap *res_pixmap = NULL;
48
49 #define N_GENS 10
50
51 static GdkColor 
52     bdescr_color = { 0, 0xffff, 0, 0 }, /* red */
53     free_color   = { 0, 0, 0, 0xffff }, /* blue */
54     gen_colors[N_GENS] = {
55         { 0, 0, 0xffff, 0 },
56         { 0, 0, 0xf000, 0 },
57         { 0, 0, 0xe000, 0 },
58         { 0, 0, 0xd000, 0 },
59         { 0, 0, 0xc000, 0 },
60         { 0, 0, 0xb000, 0 },
61         { 0, 0, 0xa000, 0 },
62         { 0, 0, 0x9000, 0 },
63         { 0, 0, 0x8000, 0 },
64         { 0, 0, 0x7000, 0 }
65     };
66
67 GdkGC *my_gc = NULL;
68
69 static void *mem_start = (void *) 0x50000000;
70
71 static void colorBlock( void *addr, GdkColor *color, 
72                         nat block_width, nat block_height, 
73                         nat blocks_per_line );
74
75 static void residencyCensus( void );
76 static void updateResidencyGraph( void );
77 static void updateThreadsPanel( void );
78
79 /* Some code pinched from examples/scribble-simple in the GTK+
80  * distribution.
81  */
82
83 /* Create a new backing pixmap of the appropriate size */
84 static gint 
85 configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED,
86                  GdkPixmap **pixmap )
87 {
88   if (*pixmap)
89     gdk_pixmap_unref(*pixmap);
90
91   *pixmap = gdk_pixmap_new(widget->window,
92                            widget->allocation.width,
93                            widget->allocation.height,
94                            -1);
95
96   gdk_draw_rectangle (*pixmap,
97                       widget->style->white_gc,
98                       TRUE,
99                       0, 0,
100                       widget->allocation.width,
101                       widget->allocation.height);
102
103   debugBelch("configure!\n");
104   updateFrontPanel();
105   return TRUE;
106 }
107
108 /* Redraw the screen from the backing pixmap */
109 static gint 
110 expose_event( GtkWidget *widget, GdkEventExpose *event, GdkPixmap **pixmap )
111 {
112   gdk_draw_pixmap(widget->window,
113                   widget->style->fg_gc[GTK_WIDGET_STATE (widget)],
114                   *pixmap,
115                   event->area.x, event->area.y,
116                   event->area.x, event->area.y,
117                   event->area.width, event->area.height);
118
119   return FALSE;
120 }
121
122 void
123 initFrontPanel( void )
124 {
125     GdkColormap *colormap;
126     GtkWidget *gen_hbox;
127
128     gtk_init( &prog_argc, &prog_argv );
129
130     window = create_GHC_Front_Panel();
131     map_drawing_area  = lookup_widget(window, "memmap");
132     gen_drawing_area  = lookup_widget(window, "generations");
133     res_drawing_area  = lookup_widget(window, "res_drawingarea");
134     stop_but          = lookup_widget(window, "stop_but");
135     continue_but      = lookup_widget(window, "continue_but");
136     quit_but          = lookup_widget(window, "quit_but");
137     statusbar         = lookup_widget(window, "statusbar");
138     live_label        = lookup_widget(window, "live_label");
139     footprint_label   = lookup_widget(window, "footprint_label");
140     allocated_label   = lookup_widget(window, "allocated_label");
141     alloc_rate_label  = lookup_widget(window, "alloc_rate_label");
142     gen_hbox          = lookup_widget(window, "gen_hbox");
143     gen_ruler         = lookup_widget(window, "gen_ruler");
144     map_ruler         = lookup_widget(window, "map_ruler");
145     res_vruler        = lookup_widget(window, "res_vruler");
146     res_hruler        = lookup_widget(window, "res_hruler");
147     running_label     = lookup_widget(window, "running_label");
148     b_read_label      = lookup_widget(window, "blockread_label");
149     b_write_label     = lookup_widget(window, "blockwrite_label");
150     b_mvar_label      = lookup_widget(window, "blockmvar_label");
151     b_bh_label        = lookup_widget(window, "blockbh_label");
152     b_throwto_label   = lookup_widget(window, "blockthrowto_label");
153     sleeping_label    = lookup_widget(window, "sleeping_label");
154     total_label       = lookup_widget(window, "total_label");
155     
156     status_context_id = 
157         gtk_statusbar_get_context_id( GTK_STATUSBAR(statusbar), "context" );
158
159     /* hook up some signals for the mem map drawing area */
160     gtk_signal_connect (GTK_OBJECT(map_drawing_area), "expose_event",
161                         (GtkSignalFunc)expose_event, &map_pixmap);
162     gtk_signal_connect (GTK_OBJECT(map_drawing_area), "configure_event",
163                         (GtkSignalFunc)configure_event, &map_pixmap);
164
165     gtk_widget_set_events(map_drawing_area, GDK_EXPOSURE_MASK);
166
167     /* hook up some signals for the gen drawing area */
168     gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "expose_event",
169                         (GtkSignalFunc)expose_event, &gen_pixmap);
170     gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "configure_event",
171                         (GtkSignalFunc)configure_event, &gen_pixmap);
172
173     gtk_widget_set_events(gen_drawing_area, GDK_EXPOSURE_MASK);
174     
175     /* hook up some signals for the res drawing area */
176     gtk_signal_connect (GTK_OBJECT(res_drawing_area), "expose_event",
177                         (GtkSignalFunc)expose_event, &res_pixmap);
178     gtk_signal_connect (GTK_OBJECT(res_drawing_area), "configure_event",
179                         (GtkSignalFunc)configure_event, &res_pixmap);
180
181     gtk_widget_set_events(res_drawing_area, GDK_EXPOSURE_MASK);
182     
183     /* allocate our colors */
184     colormap = gdk_colormap_get_system();
185     gdk_colormap_alloc_color(colormap, &bdescr_color, TRUE, TRUE);
186     gdk_colormap_alloc_color(colormap, &free_color, TRUE, TRUE);
187
188     {
189         gboolean success[N_GENS];
190         gdk_colormap_alloc_colors(colormap, gen_colors, N_GENS, TRUE,
191                                   TRUE, success);
192         if (!success) { barf("can't allocate colors"); }
193     }
194
195     /* set the labels on the generation histogram */
196     {
197         char buf[64];
198         nat g, s;
199         GtkWidget *label;
200
201         for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
202             for(s = 0; s < generations[g].n_steps; s++) {
203                 g_snprintf( buf, 64, "%d.%d", g, s );
204                 label = gtk_label_new( buf );
205                 gtk_box_pack_start( GTK_BOX(gen_hbox), label,
206                                     TRUE, TRUE, 5 );
207                 gtk_widget_show(label);
208             }
209         }
210     }
211
212     gtk_widget_show(window);
213
214     /* wait for the user to press "Continue" before getting going... */
215     gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
216                         "Program start");
217     gtk_widget_set_sensitive( stop_but, FALSE );
218     continue_now = FALSE;
219     while (continue_now == FALSE) {
220         gtk_main_iteration();
221     }
222     gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
223     gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
224                         "Running");
225
226     gtk_widget_set_sensitive( continue_but, FALSE );
227     gtk_widget_set_sensitive( stop_but, TRUE );
228     gtk_widget_set_sensitive( quit_but, FALSE );
229
230     while (gtk_events_pending()) {
231         gtk_main_iteration();
232     }
233 }
234
235 void
236 stopFrontPanel( void )
237 {
238     gtk_widget_set_sensitive( quit_but, TRUE );
239     gtk_widget_set_sensitive( continue_but, FALSE );
240     gtk_widget_set_sensitive( stop_but, FALSE );
241
242     updateFrontPanel();
243
244     gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
245                         "Program finished");
246
247     quit = FALSE;
248     while (quit == FALSE) {
249         gtk_main_iteration();
250     }
251 }
252
253 static void
254 waitForContinue( void )
255 {
256     gtk_widget_set_sensitive( continue_but, TRUE );
257     gtk_widget_set_sensitive( stop_but, FALSE );
258     stop_now = FALSE;
259     continue_now = FALSE;
260     while (continue_now == FALSE) {
261         gtk_main_iteration();
262     }
263     gtk_widget_set_sensitive( continue_but, FALSE );
264     gtk_widget_set_sensitive( stop_but, TRUE );
265 }
266
267 void
268 updateFrontPanelBeforeGC( nat N )
269 {
270     char buf[1000];
271
272     updateFrontPanel();
273
274     if (update_mode == BeforeGC 
275         || update_mode == BeforeAfterGC
276         || stop_now == TRUE) {
277         g_snprintf( buf, 1000, "Stopped (before GC, generation %d)", N );
278         gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
279         waitForContinue();
280         gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
281     }
282
283     g_snprintf( buf, 1000, "Garbage collecting (generation %d)", N );
284     gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf);
285
286     while (gtk_events_pending()) {
287         gtk_main_iteration();
288     }
289 }
290
291 static void
292 numLabel( GtkWidget *lbl, nat n )
293 {
294     char buf[64];
295     g_snprintf(buf, 64, "%d", n);
296     gtk_label_set_text( GTK_LABEL(lbl), buf );
297 }
298
299 void
300 updateFrontPanelAfterGC( nat N, lnat live )
301 {
302     char buf[1000];
303
304     gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
305
306     /* is a major GC? */
307     if (N == RtsFlags.GcFlags.generations-1) {
308         residencyCensus();
309     }
310
311     updateFrontPanel();
312
313     if (update_mode == AfterGC 
314         || update_mode == BeforeAfterGC
315         || stop_now == TRUE) {
316         snprintf( buf, 1000, "Stopped (after GC, generation %d)", N );
317         gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
318         waitForContinue();
319         gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
320     }
321
322     {
323         double words_to_megs = (1024 * 1024) / sizeof(W_);
324         double time = mut_user_time();
325
326         snprintf( buf, 1000, "%.2f", (double)live / words_to_megs );
327         gtk_label_set_text( GTK_LABEL(live_label), buf );
328
329         snprintf( buf, 1000, "%.2f", (double)total_allocated / words_to_megs );
330         gtk_label_set_text( GTK_LABEL(allocated_label), buf );
331
332         snprintf( buf, 1000, "%.2f",
333                   (double)(mblocks_allocated * MBLOCK_SIZE_W) / words_to_megs );
334         gtk_label_set_text( GTK_LABEL(footprint_label), buf );
335
336         if ( time == 0.0 )
337             snprintf( buf, 1000, "%.2f", time );
338         else
339             snprintf( buf, 1000, "%.2f",
340                       (double)(total_allocated / words_to_megs) / time );
341         gtk_label_set_text( GTK_LABEL(alloc_rate_label), buf );
342     }
343
344     while (gtk_events_pending()) {
345         gtk_main_iteration();
346     }
347 }
348
349 void
350 updateFrontPanel( void )
351 {
352     void *m, *a;
353     bdescr *bd;
354
355     updateThreadsPanel();
356
357     if (my_gc == NULL) {
358         my_gc = gdk_gc_new( window->window );
359     }
360
361     if (map_pixmap != NULL) {
362         nat height, width, blocks_per_line, 
363             block_height, block_width, mblock_height;
364
365         height = map_drawing_area->allocation.height;
366         width  = map_drawing_area->allocation.width;
367
368         mblock_height =  height / mblocks_allocated;
369         blocks_per_line = 16;
370         block_height  = mblock_height / 
371             ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
372         while (block_height == 0) {
373             blocks_per_line *= 2;
374             block_height  = mblock_height / 
375                 ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
376         }
377         block_width = width / blocks_per_line;
378
379         gdk_draw_rectangle (map_pixmap,
380                             map_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
381                             TRUE,
382                             0, 0,
383                             map_drawing_area->allocation.width,
384                             map_drawing_area->allocation.height);
385         
386         for ( m = mem_start; 
387               (char *)m < (char *)mem_start + 
388                   (mblocks_allocated * MBLOCK_SIZE); 
389               (char *)m += MBLOCK_SIZE ) {
390             
391             /* color the bdescr area first */
392             for (a = m; a < FIRST_BLOCK(m); (char *)a += BLOCK_SIZE) {
393                 colorBlock( a, &bdescr_color, 
394                             block_width, block_height, blocks_per_line );
395             }
396             
397 #if 0 /* Segfaults because bd appears to be bogus but != NULL. stolz, 2003-06-24 */
398             /* color each block */
399             for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
400                 bd = Bdescr((P_)a);
401                 ASSERT(bd->start == a);
402                 if (bd->flags & BF_FREE) {
403                     colorBlock( a, &free_color, 
404                                 block_width, block_height, blocks_per_line );
405                 } else {
406                     colorBlock( a, &gen_colors[bd->gen_no],
407                                 block_width, block_height, blocks_per_line );
408                 }
409             }
410 #endif
411         }
412
413         
414         { 
415             nat height = map_drawing_area->allocation.height,
416                 block_height, mblock_height;
417
418             block_height = (height / mblocks_allocated) / 
419                 ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
420             if (block_height < 1) block_height = 1;
421             mblock_height = block_height * 
422                 ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
423
424             gtk_ruler_set_range( GTK_RULER(map_ruler), 0, 
425                                  (double)(height * mblocks_allocated) / 
426                                  (double)((mblock_height * mblocks_allocated)),
427                                  0,
428                                  (double)(height * mblocks_allocated) / 
429                                  (double)((mblock_height * mblocks_allocated))
430                 );
431         }
432                                   
433         gtk_widget_draw( map_drawing_area, NULL );
434     }
435
436     if (gen_pixmap != NULL) {
437
438         GdkRectangle rect;
439         nat g, s, columns, column, max_blocks, height_blocks,
440             width, height;
441         
442         gdk_draw_rectangle (gen_pixmap,
443                             gen_drawing_area->style->white_gc,
444                             TRUE,
445                             0, 0,
446                             gen_drawing_area->allocation.width,
447                             gen_drawing_area->allocation.height);
448
449         height = gen_drawing_area->allocation.height;
450         width  = gen_drawing_area->allocation.width;
451
452         columns = 0; max_blocks = 0;
453         for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
454             columns += generations[g].n_steps;
455             for(s = 0; s < generations[g].n_steps; s++) {
456                 if (generations[g].steps[s].n_blocks > max_blocks) {
457                     max_blocks = generations[g].steps[s].n_blocks;
458                 }
459             }
460         }
461
462         /* find a reasonable height value larger than max_blocks */
463         { 
464             nat n = 0;
465             while (max_blocks != 0) {
466                 max_blocks >>= 1; n++;
467             }
468             height_blocks = 1 << n;
469         }
470
471         column = 0;
472         for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
473             for(s = 0; s < generations[g].n_steps; s++, column++) {
474                 gdk_gc_set_foreground(my_gc, &gen_colors[g]);
475
476                 rect.x = column * (width / columns);
477
478                 if (generations[g].steps[s].n_blocks == 0)
479                     rect.y = height;
480                 else
481                     rect.y = height - 
482                         (height * generations[g].steps[s].n_blocks
483                          / height_blocks);
484
485                 rect.width = (width / columns);
486                 rect.height = height - rect.y;
487
488                 gdk_draw_rectangle( gen_pixmap, my_gc, TRUE/*filled*/, 
489                                     rect.x, rect.y, rect.width,
490                                     rect.height );
491             }
492         }
493
494         gtk_ruler_set_range( GTK_RULER(gen_ruler), 
495                              height_blocks * BLOCK_SIZE / (1024 * 1024),
496                              0, 0,
497                              height_blocks * BLOCK_SIZE / (1024 * 1024)
498             );
499
500         gtk_widget_draw( gen_drawing_area, NULL );
501     }
502
503     if (res_pixmap != NULL) {
504         updateResidencyGraph();
505     }
506
507     while (gtk_events_pending()) {
508         gtk_main_iteration_do(FALSE/*don't block*/);
509     }
510 }
511
512 static void
513 colorBlock( void *addr, GdkColor *color, 
514             nat block_width, nat block_height, nat blocks_per_line )
515 {
516     GdkRectangle rect;
517     nat block_no;
518
519     gdk_gc_set_foreground(my_gc, color);
520
521     block_no = ((char *)addr - (char *)mem_start) / BLOCK_SIZE;
522
523     rect.x = (block_no % blocks_per_line) * block_width;
524     rect.y = block_no / blocks_per_line * block_height;
525     rect.width = block_width;
526     rect.height = block_height;
527     gdk_draw_rectangle( map_pixmap, my_gc, TRUE/*filled*/, 
528                         rect.x, rect.y, rect.width, rect.height );
529 }
530
531 static void
532 updateThreadsPanel( void )
533 {
534     nat running = 0,
535         b_read = 0,
536         b_write = 0,
537         b_mvar = 0,
538         b_throwto = 0,
539         b_bh = 0,
540         sleeping = 0,
541         total = 0;
542
543     StgTSO *t;
544
545     for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
546         switch (t->what_next) {
547         case ThreadKilled:          break;
548         case ThreadComplete:        break;
549         default:
550             switch (t->why_blocked) {
551             case BlockedOnRead:       b_read++;    break;
552             case BlockedOnWrite:      b_write++;   break;
553             case BlockedOnDelay:      sleeping++;  break;
554             case BlockedOnMVar:       b_mvar++;    break;
555             case BlockedOnException:  b_throwto++; break;
556             case BlockedOnBlackHole:  b_bh++;      break;
557             case NotBlocked:          running++;   break;
558             }
559         }
560     }
561     total = running + b_read + b_write + b_mvar + b_throwto + b_bh + sleeping;
562     numLabel(running_label,   running);
563     numLabel(b_read_label,    b_read);
564     numLabel(b_write_label,   b_write);
565     numLabel(b_mvar_label,    b_mvar);
566     numLabel(b_bh_label,      b_bh);
567     numLabel(b_throwto_label, b_throwto);
568     numLabel(sleeping_label,  sleeping);
569     numLabel(total_label,     total);
570 }
571
572 typedef enum { Thunk, Fun, Constr, BlackHole,
573                Array, Thread, Other, N_Cats } ClosureCategory;
574
575 #define N_SLICES 100
576
577 static nat *res_prof[N_SLICES];
578 static double res_time[N_SLICES];
579 static nat next_slice = 0;
580
581 static void
582 residencyCensus( void )
583 {
584     nat slice = next_slice++, *prof;
585     bdescr *bd;
586     nat g, s, size, type;
587     StgPtr p;
588     StgInfoTable *info;
589
590     if (slice >= N_SLICES) {
591         barf("too many slices");
592     }
593     res_prof[slice] = stgMallocBytes(N_Cats * sizeof(nat), "residencyCensus");
594     prof = res_prof[slice];
595     memset(prof, 0, N_Cats * sizeof(nat));
596
597     res_time[slice] = mut_user_time();
598     
599     for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
600         for(s = 0; s < generations[g].n_steps; s++) {
601
602             /* skip over g0s0 if multi-generational */
603             if (RtsFlags.GcFlags.generations > 1 &&
604                 g == 0 && s == 0) continue;
605
606             if (RtsFlags.GcFlags.generations == 1) {
607 /*              bd = generations[g].steps[s].to_blocks; FIXME to_blocks does not exist */
608             } else {
609                 bd = generations[g].steps[s].blocks;
610             }
611
612             for (; bd != NULL; bd = bd->link) {
613
614                 p = bd->start;
615
616                 while (p < bd->free) {
617                     info = get_itbl((StgClosure *)p);
618                     type = Other;
619                     
620                     switch (info->type) {
621
622                     case CONSTR:
623                     case BCO:
624                         if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info) {
625                             size = sizeofW(StgWeak);
626                             type = Other;
627                             break;
628                         }
629                         /* else, fall through... */
630                     case CONSTR_1_0:
631                     case CONSTR_0_1:
632                     case CONSTR_1_1:
633                     case CONSTR_0_2:
634                     case CONSTR_2_0:
635                         size = sizeW_fromITBL(info);
636                         type = Constr;
637                         break;
638                         
639                     case FUN_1_0:
640                     case FUN_0_1:
641                         size = sizeofW(StgHeader) + 1;
642                         goto fun;
643                     case FUN_1_1:
644                     case FUN_0_2:
645                     case FUN_2_0:
646                     case FUN:
647                         size = sizeW_fromITBL(info);
648                     fun:
649                         type = Fun;
650                         break;
651
652                     case THUNK_1_0:
653                     case THUNK_0_1:
654                     case THUNK_SELECTOR:
655                         size = sizeofW(StgHeader) + 2;
656                         goto thunk;
657                     case THUNK_1_1:
658                     case THUNK_0_2:
659                     case THUNK_2_0:
660                     case THUNK:
661                         size = sizeW_fromITBL(info);
662                     thunk:
663                         type = Thunk;
664                         break;
665
666                     case CAF_BLACKHOLE:
667                     case SE_CAF_BLACKHOLE:
668                     case SE_BLACKHOLE:
669                     case BLACKHOLE:
670 /*                  case BLACKHOLE_BQ: FIXME: case does not exist */
671                         size = sizeW_fromITBL(info);
672                         type = BlackHole;
673                         break;
674
675                     case AP:
676                         size = pap_sizeW((StgPAP *)p);
677                         type = Thunk;
678                         break;
679
680                     case PAP:
681                         size = pap_sizeW((StgPAP *)p);
682                         type = Fun;
683                         break;
684                         
685                     case ARR_WORDS:
686                         size = arr_words_sizeW(stgCast(StgArrWords*,p));
687                         type = Array;
688                         break;
689                         
690                     case MUT_ARR_PTRS:
691                     case MUT_ARR_PTRS_FROZEN:
692                         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
693                         type = Array;
694                         break;
695                         
696                     case TSO:
697                         size = tso_sizeW((StgTSO *)p);
698                         type = Thread;
699                         break;
700                         
701                     case WEAK:
702                     case STABLE_NAME:
703                     case MVAR:
704                     case MUT_VAR:
705 /*                  case MUT_CONS: FIXME: case does not exist */
706                     case IND_PERM:
707                     case IND_OLDGEN_PERM:
708                         size = sizeW_fromITBL(info);
709                         type = Other;
710                         break;
711
712                     default:
713                         barf("updateResidencyGraph: strange closure "
714                              "%d", info->type );
715                     }
716
717                     prof[type] += size;
718                     p += size;
719                 }
720             }
721         }
722     }
723
724 }
725             
726 static void
727 updateResidencyGraph( void )
728 {
729     nat total, prev_total, i, max_res;
730     double time;
731     double time_scale = 1;
732     nat last_slice = next_slice-1;
733     double res_scale  = 1; /* in megabytes, doubles */
734     nat *prof;
735     nat width, height;
736     GdkPoint points[4];
737
738     gdk_draw_rectangle (res_pixmap,
739                         res_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
740                         TRUE,
741                         0, 0,
742                         res_drawing_area->allocation.width,
743                         res_drawing_area->allocation.height);
744     
745     if (next_slice == 0) return;
746
747     time = res_time[last_slice];
748     while (time > time_scale) {
749         time_scale *= 2;
750     }
751
752     max_res = 0; 
753     for (i = 0; i < next_slice; i++) {
754         prof = res_prof[i];
755         total = prof[Thunk] + prof[Fun] + prof[Constr] +
756             prof[BlackHole] + prof[Array] + prof[Other];
757         if (total > max_res) {
758             max_res = total;
759         }
760     }
761     while (max_res > res_scale) {
762         res_scale *= 2;
763     }
764
765     height = res_drawing_area->allocation.height;
766     width  = res_drawing_area->allocation.width;
767
768     points[0].x = 0;
769     points[0].y = height;
770     points[1].y = height;
771     points[3].x = 0;
772     points[3].y = height;
773
774     gdk_gc_set_foreground(my_gc, &free_color);
775
776     prev_total = 0;
777     for (i = 0; i < next_slice; i++) {
778         prof = res_prof[i];
779         total = prof[Thunk] + prof[Fun] + prof[Constr] +
780             prof[BlackHole] + prof[Array] + prof[Other];
781         points[1].x = width * res_time[i] / time_scale;
782         points[2].x = points[1].x;
783         points[2].y = height - ((height * total) / res_scale);
784         gdk_draw_polygon(res_pixmap, my_gc, TRUE/*filled*/, points, 4);
785         points[3] = points[2];
786         points[0] = points[1];
787     }
788
789     gtk_ruler_set_range( GTK_RULER(res_vruler), 
790                          res_scale / ((1024*1024)/sizeof(W_)),
791                          0, 0,
792                          res_scale / ((1024*1024)/sizeof(W_)) );
793
794     gtk_ruler_set_range( GTK_RULER(res_hruler), 
795                          0, time_scale, 0, time_scale );
796
797
798     gtk_widget_draw( res_drawing_area, NULL );
799 }
800
801 #endif /* RTS_GTK_FRONTPANEL */