8 files changed, 145 insertions, 0 deletions
diff --git a/rts/hooks/FlagDefaults.c b/rts/hooks/FlagDefaults.c
new file mode 100644
index 0000000000..393d39bc39
--- /dev/null
+++ b/rts/hooks/FlagDefaults.c
@@ -0,0 +1,20 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+void
+defaultsHook (void)
+{ /* this is called *after* RTSflags has had
+     its defaults set, but *before* we start
+     processing the RTS command-line options.
+
+     This default version does *nothing*.
+     The user may provide a more interesting
+     one.
+  */
+}
+
diff --git a/rts/hooks/InitEachPE.c b/rts/hooks/InitEachPE.c
new file mode 100644
index 0000000000..cc9cdc0dba
--- /dev/null
+++ b/rts/hooks/InitEachPE.c
@@ -0,0 +1,23 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+#ifdef PAR
+void
+InitEachPEHook (void)
+{ /* In a GUM setup this is called on each
+     PE immediately before SynchroniseSystem.
+     It can be used to read in static data 
+     to each PE which has to be available to
+     each PE. See GPH-Maple as an example how to
+     use this in combination with foreign language
+     code:
+       http://www.risc.uni-linz.ac.at/software/ghc-maple/
+     -- HWL
+  */
+}
+#endif
diff --git a/rts/hooks/MallocFail.c b/rts/hooks/MallocFail.c
new file mode 100644
index 0000000000..1218d1d8d0
--- /dev/null
+++ b/rts/hooks/MallocFail.c
@@ -0,0 +1,16 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+#include <stdio.h>
+
+void
+MallocFailHook (lnat request_size /* in bytes */, char *msg)
+{
+    fprintf(stderr, "malloc: failed on request for %lu bytes; message: %s\n", request_size, msg);
+}
+
diff --git a/rts/hooks/OnExit.c b/rts/hooks/OnExit.c
new file mode 100644
index 0000000000..dd4c3b4bb0
--- /dev/null
+++ b/rts/hooks/OnExit.c
@@ -0,0 +1,19 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+/* Note: by the time this hook has been called, Haskell land
+ * will have been shut down completely.
+ *
+ * ToDo: feed the hook info on whether we're shutting down as a result
+ * of termination or run-time error ?
+ */
+ 
+void
+OnExitHook ()
+{
+}
diff --git a/rts/hooks/OutOfHeap.c b/rts/hooks/OutOfHeap.c
new file mode 100644
index 0000000000..98db0d7d49
--- /dev/null
+++ b/rts/hooks/OutOfHeap.c
@@ -0,0 +1,19 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+#include <stdio.h>
+
+void
+OutOfHeapHook (lnat request_size, lnat heap_size) /* both sizes in bytes */
+{
+  /*    fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n", */
+
+  (void)request_size;   /* keep gcc -Wall happy */
+  fprintf(stderr, "Heap exhausted;\nCurrent maximum heap size is %lu bytes (%lu Mb);\nuse `+RTS -M<size>' to increase it.\n",
+	  heap_size, heap_size / (1024*1024));
+}
+
diff --git a/rts/hooks/RtsOpts.c b/rts/hooks/RtsOpts.c
new file mode 100644
index 0000000000..b934b05f1b
--- /dev/null
+++ b/rts/hooks/RtsOpts.c
@@ -0,0 +1,13 @@
+/* -----------------------------------------------------------------------------
+ *
+ * Default RTS options.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+#include <stdlib.h>
+
+// Default RTS options can be given by providing an alternate
+// definition for this variable, pointing to a string of RTS options.
+char *ghc_rts_opts = NULL;
diff --git a/rts/hooks/ShutdownEachPEHook.c b/rts/hooks/ShutdownEachPEHook.c
new file mode 100644
index 0000000000..f5e3ba9344
--- /dev/null
+++ b/rts/hooks/ShutdownEachPEHook.c
@@ -0,0 +1,19 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+#ifdef PAR
+void
+ShutdownEachPEHook (void)
+{ /* In a GUM setup this routine is called at the end of 
+     shutdownParallelSystem on each PE. Useful for
+     cleaning up stuff, especially when interfacing 
+     with foreign language code.
+     -- HWL 
+  */
+}
+#endif
diff --git a/rts/hooks/StackOverflow.c b/rts/hooks/StackOverflow.c
new file mode 100644
index 0000000000..a395a3a1a5
--- /dev/null
+++ b/rts/hooks/StackOverflow.c
@@ -0,0 +1,16 @@
+/* -----------------------------------------------------------------------------
+ *
+ * User-overridable RTS hooks.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+
+#include <stdio.h>
+
+void
+StackOverflowHook (lnat stack_size)    /* in bytes */
+{
+    fprintf(stderr, "Stack space overflow: current size %ld bytes.\nUse `+RTS -Ksize' to increase it.\n", stack_size);
+}
+