Commit 39a99171 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-11-01 11:41:47 by simonmar]

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).
parent e4cc93bd
This diff is collapsed.
/* -----------------------------------------------------------------------------
* $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 */
/* -----------------------------------------------------------------------------
* $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);
}
......
#-----------------------------------------------------------------------------
# $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
......
/* -----------------------------------------------------------------------------
* $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 ++;
......
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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
*
......@@ -28,6 +28,10 @@
#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
......
/* -----------------------------------------------------------------------------
* $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;
}
......
/* -----------------------------------------------------------------------------
* $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 );
......
/* -----------------------------------------------------------------------------
* $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 */
#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);
/*
* 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;
}
/*
* 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);
This diff is collapsed.
/*
* DO NOT EDIT THIS FILE - it is generated by Glade.
*/
GtkWidget* create_GHC_Visualisation_Tool (void);
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment