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