Replace hooks by callbacks in RtsConfig (#8785)

Summary:
Hooks rely on static linking semantics, and are broken by -Bsymbolic
which we need when using dynamic linking.

Test Plan: Built it

Reviewers: austin, hvr, tibbe

Differential Revision: https://phabricator.haskell.org/D8

15 files changed, 177 insertions, 87 deletions

diff --git a/rts/Linker.c b/rts/Linker.c
index 5015135438..3323037b6c 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1095,10 +1095,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_block_readmvar)                           \
       SymI_HasProto(stg_block_putmvar)                                  \
       MAIN_CAP_SYM                                                      \
-      SymI_HasProto(MallocFailHook)                                     \
-      SymI_HasProto(OnExitHook)                                         \
-      SymI_HasProto(OutOfHeapHook)                                      \
-      SymI_HasProto(StackOverflowHook)                                  \
       SymI_HasProto(addDLL)                                             \
       SymI_HasProto(__int_encodeDouble)                                 \
       SymI_HasProto(__word_encodeDouble)                                \
@@ -1123,7 +1119,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_decodeDoublezu2Intzh)                           \
       SymI_HasProto(stg_decodeDoublezuInt64zh)                          \
       SymI_HasProto(stg_decodeFloatzuIntzh)                             \
-      SymI_HasProto(defaultsHook)                                       \
       SymI_HasProto(stg_delayzh)                                        \
       SymI_HasProto(stg_deRefWeakzh)                                    \
       SymI_HasProto(stg_deRefStablePtrzh)                               \
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index d7114bf88b..ef01ccb3ab 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -14,6 +14,7 @@
 #include "Profiling.h"
 #include "RtsFlags.h"
 #include "sm/OSMem.h"
+#include "hooks/Hooks.h"
 
 #ifdef HAVE_CTYPE_H
 #include <ctype.h>
@@ -52,6 +53,22 @@ int       win32_prog_argc = 0;
 wchar_t **win32_prog_argv = NULL;
 #endif
 
+// The global rtsConfig, set from the RtsConfig supplied by the call
+// to hs_init_ghc().
+RtsConfig rtsConfig;
+
+const RtsConfig defaultRtsConfig  = {
+    .rts_opts_enabled = RtsOptsSafeOnly,
+    .rts_opts = NULL,
+    .rts_hs_main = rtsFalse,
+    .defaultsHook = FlagDefaultsHook,
+    .onExitHook = OnExitHook,
+    .stackOverflowHook = StackOverflowHook,
+    .outOfHeapHook = OutOfHeapHook,
+    .mallocFailHook = MallocFailHook,
+    .gcDoneHook = NULL
+};
+
 /*
  * constants, used later
  */
@@ -62,31 +79,31 @@ wchar_t **win32_prog_argv = NULL;
    Static function decls
    -------------------------------------------------------------------------- */
 
-static void procRtsOpts      (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum enabled);
+static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum enabled);
 
 static void normaliseRtsOpts (void);
 
-static void initStatsFile    (FILE *f);
+static void initStatsFile (FILE *f);
 
-static int  openStatsFile    (char *filename, const char *FILENAME_FMT,
-                              FILE **file_ret);
+static int  openStatsFile (
+    char *filename, const char *FILENAME_FMT, FILE **file_ret);
 
-static StgWord64 decodeSize  (const char *flag, nat offset,
-                              StgWord64 min, StgWord64 max);
+static StgWord64 decodeSize (
+    const char *flag, nat offset, StgWord64 min, StgWord64 max);
 
-static void bad_option       (const char *s);
+static void bad_option (const char *s);
 
 #ifdef TRACING
 static void read_trace_flags(char *arg);
 #endif
 
-static void errorUsage      (void) GNU_ATTRIBUTE(__noreturn__);
+static void errorUsage (void) GNU_ATTRIBUTE(__noreturn__);
 
-static char *  copyArg  (char *arg);
+static char *  copyArg (char *arg);
 static char ** copyArgv (int argc, char *argv[]);
 static void    freeArgv (int argc, char *argv[]);
 
-static void errorRtsOptsDisabled(HsBool is_hs_main, const char *s);
+static void errorRtsOptsDisabled (const char *s);
 
 /* -----------------------------------------------------------------------------
  * Command-line option parsing routines.
@@ -416,8 +433,7 @@ usage_text[] = {
 0
 };
 
-STATIC_INLINE rtsBool
-strequal(const char *a, const char * b)
+STATIC_INLINE rtsBool strequal(const char *a, const char * b)
 {
     return(strcmp(a, b) == 0);
 }
@@ -457,10 +473,10 @@ static void splitRtsFlags(const char *s)
     } while (*c1 != '\0');
 }
 
-static void
-errorRtsOptsDisabled(HsBool is_hs_main, const char *s) {
+static void errorRtsOptsDisabled(const char *s)
+{
     char *advice;
-    if (is_hs_main) {
+    if (rtsConfig.rts_hs_main) {
         advice = "Link with -rtsopts to enable them.";
     } else {
         advice = "Use hs_init_with_rtsopts() to enable them.";
@@ -483,17 +499,18 @@ errorRtsOptsDisabled(HsBool is_hs_main, const char *s) {
 
      - prog_name   (global) contains the basename of prog_argv[0]
 
+     - rtsConfig   (global) contains the supplied RtsConfig
+
   -------------------------------------------------------------------------- */
 
-void setupRtsFlags (int *argc, char *argv[],
-                    RtsOptsEnabledEnum rtsOptsEnabled,
-                    const char *ghc_rts_opts,
-                    HsBool is_hs_main)
+void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config)
 {
     nat mode;
     nat total_arg;
     nat arg, rts_argc0;
 
+    rtsConfig = rts_config;
+
     setProgName (argv);
     total_arg = *argc;
     arg = 1;
@@ -510,10 +527,10 @@ void setupRtsFlags (int *argc, char *argv[],
     // (arguments from the GHCRTS environment variable and the command
     // line override these).
     {
-        if (ghc_rts_opts != NULL) {
-            splitRtsFlags(ghc_rts_opts);
-            // opts from ghc_rts_opts are always enabled:
-            procRtsOpts(is_hs_main, rts_argc0, RtsOptsAll);
+        if (rtsConfig.rts_opts != NULL) {
+            splitRtsFlags(rtsConfig.rts_opts);
+            // opts from rts_opts are always enabled:
+            procRtsOpts(rts_argc0, RtsOptsAll);
             rts_argc0 = rts_argc;
         }
     }
@@ -524,12 +541,13 @@ void setupRtsFlags (int *argc, char *argv[],
         char *ghc_rts = getenv("GHCRTS");
 
         if (ghc_rts != NULL) {
-            if (rtsOptsEnabled == RtsOptsNone) {
-                errorRtsOptsDisabled(is_hs_main, "Warning: Ignoring GHCRTS variable as RTS options are disabled.\n         %s");
+            if (rtsConfig.rts_opts_enabled == RtsOptsNone) {
+                errorRtsOptsDisabled(
+                    "Warning: Ignoring GHCRTS variable as RTS options are disabled.\n         %s");
                 // We don't actually exit, just warn
             } else {
                 splitRtsFlags(ghc_rts);
-                procRtsOpts(is_hs_main, rts_argc0, rtsOptsEnabled);
+                procRtsOpts(rts_argc0, rtsConfig.rts_opts_enabled);
                 rts_argc0 = rts_argc;
             }
         }
@@ -568,7 +586,7 @@ void setupRtsFlags (int *argc, char *argv[],
     }
     argv[*argc] = (char *) 0;
 
-    procRtsOpts(is_hs_main, rts_argc0, rtsOptsEnabled);
+    procRtsOpts(rts_argc0, rtsConfig.rts_opts_enabled);
 
     appendRtsArg((char *)0);
     rts_argc--; // appendRtsArg will have bumped it for the NULL (#7227)
@@ -590,32 +608,34 @@ void setupRtsFlags (int *argc, char *argv[],
  * -------------------------------------------------------------------------- */
 
 #if defined(HAVE_UNISTD_H) && defined(HAVE_SYS_TYPES_H) && !defined(mingw32_HOST_OS)
-static void checkSuid(HsBool is_hs_main, RtsOptsEnabledEnum enabled)
+static void checkSuid(RtsOptsEnabledEnum enabled)
 {
     if (enabled == RtsOptsSafeOnly) {
         /* This doesn't cover linux/posix capabilities like CAP_DAC_OVERRIDE,
            we'd have to link with -lcap for that. */
         if ((getuid() != geteuid()) || (getgid() != getegid())) {
-            errorRtsOptsDisabled(is_hs_main, "RTS options are disabled for setuid binaries. %s");
+            errorRtsOptsDisabled(
+                "RTS options are disabled for setuid binaries. %s");
             stg_exit(EXIT_FAILURE);
         }
     }
 }
 #else
-static void checkSuid(HsBool is_hs_main STG_UNUSED, RtsOptsEnabledEnum enabled STG_UNUSED)
+static void checkSuid (RtsOptsEnabledEnum enabled STG_UNUSED)
 {
 }
 #endif
 
-static void checkUnsafe(HsBool is_hs_main, RtsOptsEnabledEnum enabled)
+static void checkUnsafe(RtsOptsEnabledEnum enabled)
 {
     if (enabled == RtsOptsSafeOnly) {
-        errorRtsOptsDisabled(is_hs_main, "Most RTS options are disabled. %s");
+        errorRtsOptsDisabled("Most RTS options are disabled. %s");
         stg_exit(EXIT_FAILURE);
     }
 }
 
-static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled)
+static void procRtsOpts (int rts_argc0,
+                         RtsOptsEnabledEnum rtsOptsEnabled)
 {
     rtsBool error = rtsFalse;
     int arg;
@@ -623,11 +643,11 @@ static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum rt
     if (!(rts_argc0 < rts_argc)) return;
 
     if (rtsOptsEnabled == RtsOptsNone) {
-        errorRtsOptsDisabled(is_hs_main, "RTS options are disabled. %s");
+        errorRtsOptsDisabled("RTS options are disabled. %s");
         stg_exit(EXIT_FAILURE);
     }
 
-    checkSuid(is_hs_main, rtsOptsEnabled);
+    checkSuid(rtsOptsEnabled);
 
     // Process RTS (rts_argv) part: mainly to determine statsfile
     for (arg = rts_argc0; arg < rts_argc; arg++) {
@@ -639,7 +659,7 @@ static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum rt
         rtsBool option_checked = rtsFalse;
 
 #define OPTION_SAFE option_checked = rtsTrue;
-#define OPTION_UNSAFE checkUnsafe(is_hs_main, rtsOptsEnabled); option_checked = rtsTrue;
+#define OPTION_UNSAFE checkUnsafe(rtsOptsEnabled); option_checked = rtsTrue;
 
         if (rts_argv[arg][0] != '-') {
             fflush(stdout);
@@ -661,7 +681,8 @@ static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum rt
 # define TICKY_BUILD_ONLY(x) x
 #else
 # define TICKY_BUILD_ONLY(x) \
-errorBelch("the flag %s requires the program to be built with -ticky", rts_argv[arg]); \
+errorBelch("the flag %s requires the program to be built with -ticky", \
+           rts_argv[arg]);                                             \
 error = rtsTrue;
 #endif
 
@@ -669,7 +690,8 @@ error = rtsTrue;
 # define PROFILING_BUILD_ONLY(x)   x
 #else
 # define PROFILING_BUILD_ONLY(x) \
-errorBelch("the flag %s requires the program to be built with -prof", rts_argv[arg]); \
+errorBelch("the flag %s requires the program to be built with -prof", \
+           rts_argv[arg]);                                            \
 error = rtsTrue;
 #endif
 
@@ -677,7 +699,8 @@ error = rtsTrue;
 # define TRACING_BUILD_ONLY(x)   x
 #else
 # define TRACING_BUILD_ONLY(x) \
-errorBelch("the flag %s requires the program to be built with -eventlog or -debug", rts_argv[arg]); \
+errorBelch("the flag %s requires the program to be built with -eventlog or -debug", \
+           rts_argv[arg]);                                              \
 error = rtsTrue;
 #endif
 
@@ -685,7 +708,8 @@ error = rtsTrue;
 # define THREADED_BUILD_ONLY(x)      x
 #else
 # define THREADED_BUILD_ONLY(x) \
-errorBelch("the flag %s requires the program to be built with -threaded", rts_argv[arg]); \
+errorBelch("the flag %s requires the program to be built with -threaded", \
+           rts_argv[arg]);                                              \
 error = rtsTrue;
 #endif
 
@@ -693,7 +717,8 @@ error = rtsTrue;
 # define DEBUG_BUILD_ONLY(x) x
 #else
 # define DEBUG_BUILD_ONLY(x) \
-errorBelch("the flag %s requires the program to be built with -debug", rts_argv[arg]); \
+errorBelch("the flag %s requires the program to be built with -debug", \
+           rts_argv[arg]);                                             \
 error = rtsTrue;
 #endif
 
@@ -882,7 +907,8 @@ error = rtsTrue;
               case 'K':
                   OPTION_UNSAFE;
                   RtsFlags.GcFlags.maxStkSize =
-                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
+                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX)
+                      / sizeof(W_);
                   break;
 
               case 'k':
@@ -890,19 +916,23 @@ error = rtsTrue;
                 switch(rts_argv[arg][2]) {
                 case 'c':
                   RtsFlags.GcFlags.stkChunkSize =
-                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
+                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX)
+                      / sizeof(W_);
                   break;
                 case 'b':
                   RtsFlags.GcFlags.stkChunkBufferSize =
-                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
+                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX)
+                      / sizeof(W_);
                   break;
                 case 'i':
                   RtsFlags.GcFlags.initialStkSize =
-                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
+                      decodeSize(rts_argv[arg], 3, sizeof(W_), HS_WORD_MAX)
+                      / sizeof(W_);
                   break;
                 default:
                   RtsFlags.GcFlags.initialStkSize =
-                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX) / sizeof(W_);
+                      decodeSize(rts_argv[arg], 2, sizeof(W_), HS_WORD_MAX)
+                      / sizeof(W_);
                   break;
                 }
                 break;
@@ -910,8 +940,10 @@ error = rtsTrue;
               case 'M':
                   OPTION_UNSAFE;
                   RtsFlags.GcFlags.maxHeapSize =
-                      decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX) / BLOCK_SIZE;
-                  /* user give size in *bytes* but "maxHeapSize" is in *blocks* */
+                      decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX)
+                      / BLOCK_SIZE;
+                  /* user give size in *bytes* but "maxHeapSize" is in
+                   * *blocks* */
                   break;
 
               case 'm':
@@ -1024,7 +1056,8 @@ error = rtsTrue;
               case 'R':
                   OPTION_SAFE;
                   PROFILING_BUILD_ONLY(
-                      RtsFlags.ProfFlags.maxRetainerSetSize = atof(rts_argv[arg]+2);
+                      RtsFlags.ProfFlags.maxRetainerSetSize =
+                        atof(rts_argv[arg]+2);
                   ) break;
               case 'L':
                   OPTION_SAFE;
@@ -1207,7 +1240,7 @@ error = rtsTrue;
                     }
                     if (rtsOptsEnabled == RtsOptsSafeOnly &&
                         nNodes > (int)getNumberOfProcessors()) {
-                      errorRtsOptsDisabled(is_hs_main, "Using large values for -N is not allowed by default. %s");
+                      errorRtsOptsDisabled("Using large values for -N is not allowed by default. %s");
                       stg_exit(EXIT_FAILURE);
                     }
                     RtsFlags.ParFlags.nNodes = (nat)nNodes;
@@ -1248,10 +1281,12 @@ error = rtsTrue;
                         break;
                     case 'b':
                         if (rts_argv[arg][3] == '\0') {
-                            RtsFlags.ParFlags.parGcLoadBalancingEnabled = rtsFalse;
+                            RtsFlags.ParFlags.parGcLoadBalancingEnabled =
+                                rtsFalse;
                         }
                         else {
-                            RtsFlags.ParFlags.parGcLoadBalancingEnabled = rtsTrue;
+                            RtsFlags.ParFlags.parGcLoadBalancingEnabled =
+                                rtsTrue;
                             RtsFlags.ParFlags.parGcLoadBalancingGen
                                 = strtol(rts_argv[arg]+3, (char **) NULL, 10);
                         }
@@ -1365,7 +1400,8 @@ error = rtsTrue;
                     break;
 #endif
 
-                case 'c': /* Debugging tool: show current cost centre on an exception */
+                case 'c': /* Debugging tool: show current cost centre on
+                           an exception */
                     OPTION_SAFE;
                     PROFILING_BUILD_ONLY(
                         RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
@@ -1379,7 +1415,10 @@ error = rtsTrue;
                         );
                     goto check_rest;
 
-                  /* The option prefix '-xx' is reserved for future extension.  KSW 1999-11. */
+                  /*
+                   * The option prefix '-xx' is reserved for future
+                   * extension.  KSW 1999-11.
+                   */
 
                 case 'q':
                   OPTION_UNSAFE;
@@ -1486,7 +1525,8 @@ static void normaliseRtsOpts (void)
 
     if (RtsFlags.GcFlags.stkChunkBufferSize >
         RtsFlags.GcFlags.stkChunkSize / 2) {
-        errorBelch("stack chunk buffer size (-kb) must be less than 50%% of the stack chunk size (-kc)");
+        errorBelch("stack chunk buffer size (-kb) must be less than 50%%\n"
+                   "of the stack chunk size (-kc)");
         errorUsage();
     }
 }
@@ -1535,7 +1575,8 @@ openStatsFile (char *filename,           // filename, or NULL
         if (*filename != '\0') {  /* stats file specified */
             f = fopen(filename,"w");
         } else {
-            char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
+            /* default <program>.<ext> */
+            char stats_filename[STATS_FILENAME_MAXLEN];
             sprintf(stats_filename, filename_fmt, prog_name);
             f = fopen(stats_filename,"w");
         }
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index b3627e0e48..79ebd36a7e 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -15,13 +15,12 @@
 /* Routines that operate-on/to-do-with RTS flags: */
 
 void initRtsFlagsDefaults (void);
-void setupRtsFlags        (int *argc, char *argv[],
-                           RtsOptsEnabledEnum rtsOptsEnabled,
-                           const char *ghc_rts_opts,
-                           HsBool is_hs_main);
+void setupRtsFlags        (int *argc, char *argv[], RtsConfig rtsConfig);
 void setProgName          (char *argv[]);
 void freeRtsArgs          (void);
 
+extern RtsConfig rtsConfig;
+
 #include "EndPrivate.h"
 
 #endif /* RTSFLAGS_H */
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 190088274e..c50bb07f75 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -69,12 +69,6 @@ static int hs_init_count = 0;
 
 static void flushStdHandles(void);
 
-const RtsConfig defaultRtsConfig  = {
-    .rts_opts_enabled = RtsOptsSafeOnly,
-    .rts_opts = NULL,
-    .rts_hs_main = rtsFalse
-};
-
 /* -----------------------------------------------------------------------------
    Initialise floating point unit on x86 (currently disabled; See Note
    [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs)
@@ -148,7 +142,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     initRtsFlagsDefaults();
 
     /* Call the user hook to reset defaults, if present */
-    defaultsHook();
+    rts_config.defaultsHook();
 
     /* Parse the flags, separating the RTS flags from the programs args */
     if (argc == NULL || argv == NULL) {
@@ -156,12 +150,10 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
         int my_argc = 1;
         char *my_argv[] = { "<unknown>", NULL };
         setFullProgArgv(my_argc,my_argv);
-        setupRtsFlags(&my_argc, my_argv,
-                      rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
+        setupRtsFlags(&my_argc, my_argv, rts_config);
     } else {
         setFullProgArgv(*argc,*argv);
-        setupRtsFlags(argc, *argv,
-                      rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
+        setupRtsFlags(argc, *argv, rts_config);
 
 #ifdef DEBUG
         /* load debugging symbols for current binary */
@@ -328,7 +320,7 @@ hs_exit_(rtsBool wait_foreign)
     /* start timing the shutdown */
     stat_startExit();
 
-    OnExitHook();
+    rtsConfig.onExitHook();
 
     flushStdHandles();
 
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index fff87178a1..ddf5a1fef2 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -13,6 +13,7 @@
 #include "RtsUtils.h"
 #include "Ticky.h"
 #include "Schedule.h"
+#include "RtsFlags.h"
 
 #ifdef HAVE_TIME_H
 #include <time.h>
@@ -64,7 +65,7 @@ stgMallocBytes (int n, char *msg)
     n2 = (size_t) n;
     if ((space = (char *) malloc(n2)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
@@ -79,7 +80,7 @@ stgReallocBytes (void *p, int n, char *msg)
     n2 = (size_t) n;
     if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
@@ -92,7 +93,7 @@ stgCallocBytes (int n, int m, char *msg)
 
     if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n*m, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n*m, msg); /*msg*/
       stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
@@ -116,7 +117,7 @@ stgFree(void* p)
 void
 stackOverflow(StgTSO* tso)
 {
-    StackOverflowHook(tso->tot_stack_size * sizeof(W_));
+    rtsConfig.stackOverflowHook(tso->tot_stack_size * sizeof(W_));
 
 #if defined(TICKY_TICKY)
     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
@@ -129,8 +130,8 @@ heapOverflow(void)
     if (!heap_overflow)
     {
         /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-        OutOfHeapHook(0/*unknown request size*/,
-                      (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
+        rtsConfig.outOfHeapHook(0/*unknown request size*/,
+                                (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 
         heap_overflow = rtsTrue;
     }
diff --git a/rts/Stats.c b/rts/Stats.c
index d5efaa2330..71cb29c3f7 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -9,6 +9,7 @@
 #include "PosixSource.h"
 #include "Rts.h"
 
+#include "RtsFlags.h"
 #include "RtsUtils.h"
 #include "Schedule.h"
 #include "Stats.h"
@@ -249,6 +250,12 @@ stat_endExit(void)
     getProcessTimes(&end_exit_cpu, &end_exit_elapsed);
 }
 
+void
+stat_startGCSync (gc_thread *gct)
+{
+    gct->gc_sync_start_elapsed = getProcessElapsedTime();
+}
+
 /* -----------------------------------------------------------------------------
    Called at the beginning of each GC
    -------------------------------------------------------------------------- */
@@ -308,10 +315,11 @@ stat_endGC (Capability *cap, gc_thread *gct,
     W_ alloc;
 
     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS ||
+        rtsConfig.gcDoneHook != NULL ||
         RtsFlags.ProfFlags.doHeapProfile)
         // heap profiling needs GC_tot_time
     {
-        Time cpu, elapsed, gc_cpu, gc_elapsed;
+        Time cpu, elapsed, gc_cpu, gc_elapsed, gc_sync_elapsed;
 
         // Has to be emitted while all caps stopped for GC, but before GC_END.
         // See trac.haskell.org/ThreadScope/wiki/RTSsummaryEvents
@@ -341,6 +349,7 @@ stat_endGC (Capability *cap, gc_thread *gct,
         // timestamp as used in +RTS -s calculcations.
         traceEventGcEndAtT(cap, TimeToNS(elapsed - start_init_elapsed));
 
+        gc_sync_elapsed = gct->gc_start_elapsed - gct->gc_sync_start_elapsed;
         gc_elapsed = elapsed - gct->gc_start_elapsed;
         gc_cpu = cpu - gct->gc_start_cpu;
 
@@ -374,6 +383,21 @@ stat_endGC (Capability *cap, gc_thread *gct,
             statsFlush();
         }
 
+
+        if (rtsConfig.gcDoneHook != NULL) {
+            rtsConfig.gcDoneHook(gen,
+                                 alloc*sizeof(W_),
+                                 live*sizeof(W_),
+                                 copied*sizeof(W_),
+                                 par_max_copied * sizeof(W_),
+                                 mblocks_allocated * BLOCKS_PER_MBLOCK
+                                   * BLOCK_SIZE_W * sizeof(W_),
+                                 slop   * sizeof(W_),
+                                 TimeToNS(gc_sync_elapsed),
+                                 TimeToNS(gc_elapsed),
+                                 TimeToNS(gc_cpu));
+        }
+
         GC_coll_cpu[gen] += gc_cpu;
         GC_coll_elapsed[gen] += gc_elapsed;
         if (GC_coll_max_pause[gen] < gc_elapsed) {
diff --git a/rts/Stats.h b/rts/Stats.h
index 925920f108..76b522287e 100644
--- a/rts/Stats.h
+++ b/rts/Stats.h
@@ -27,6 +27,7 @@ struct gc_thread_;
 void      stat_startInit(void);
 void      stat_endInit(void);
 
+void      stat_startGCSync(struct gc_thread_ *_gct);
 void      stat_startGC(Capability *cap, struct gc_thread_ *_gct);
 void      stat_endGC  (Capability *cap, struct gc_thread_ *_gct,
                        W_ live, W_ copied, W_ slop, nat gen,
diff --git a/rts/hooks/FlagDefaults.c b/rts/hooks/FlagDefaults.c
index ce1666f06d..1307fa0239 100644
--- a/rts/hooks/FlagDefaults.c
+++ b/rts/hooks/FlagDefaults.c
@@ -6,10 +6,11 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
 
 void
-defaultsHook (void)
-{ /* this is called *after* RTSflags has had
+FlagDefaultsHook (void)
+{ /* this is called *after* RtsFlags has had
      its defaults set, but *before* we start
      processing the RTS command-line options.
 
diff --git a/rts/hooks/Hooks.h b/rts/hooks/Hooks.h
new file mode 100644
index 0000000000..35a6011aaa
--- /dev/null
+++ b/rts/hooks/Hooks.h
@@ -0,0 +1,29 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2009
+ *
+ * User-overridable RTS hooks.
+ *
+ * Do not #include this file directly: #include "Rts.h" instead.
+ *
+ * To understand the structure of the RTS headers, see the wiki:
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_HOOKS_H
+#define RTS_HOOKS_H
+
+#include "BeginPrivate.h"
+
+extern char *ghc_rts_opts;
+
+extern void OnExitHook (void);
+extern void StackOverflowHook (W_ stack_size);
+extern void OutOfHeapHook (W_ request_size, W_ heap_size);
+extern void MallocFailHook (W_ request_size /* in bytes */, char *msg);
+extern void FlagDefaultsHook (void);
+
+#include "EndPrivate.h"
+
+#endif /* RTS_HOOKS_H */
diff --git a/rts/hooks/MallocFail.c b/rts/hooks/MallocFail.c
index 6c3a1a0faf..63343a770c 100644
--- a/rts/hooks/MallocFail.c
+++ b/rts/hooks/MallocFail.c
@@ -6,6 +6,7 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
 
 #include <stdio.h>
 
diff --git a/rts/hooks/OnExit.c b/rts/hooks/OnExit.c
index 30764acba2..e5e85f5dd3 100644
--- a/rts/hooks/OnExit.c
+++ b/rts/hooks/OnExit.c
@@ -6,6 +6,7 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
 
 /* Note: by the time this hook has been called, Haskell land
  * will have been shut down completely.
diff --git a/rts/hooks/OutOfHeap.c b/rts/hooks/OutOfHeap.c
index ec4697b547..501bccddb7 100644
--- a/rts/hooks/OutOfHeap.c
+++ b/rts/hooks/OutOfHeap.c
@@ -6,6 +6,7 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
 #include <stdio.h>
 
 void
diff --git a/rts/hooks/StackOverflow.c b/rts/hooks/StackOverflow.c
index 407293902d..1095b1b81d 100644
--- a/rts/hooks/StackOverflow.c
+++ b/rts/hooks/StackOverflow.c
@@ -6,6 +6,7 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
 
 #include <stdio.h>
 
@@ -14,4 +15,3 @@ StackOverflowHook (W_ stack_size)    /* in bytes */
 {
     fprintf(stderr, "Stack space overflow: current size %" FMT_Word " bytes.\nUse `+RTS -Ksize -RTS' to increase it.\n", stack_size);
 }
-
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 9777f32a3b..52d7f98fa0 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -1091,6 +1091,9 @@ waitForGcThreads (Capability *cap USED_IF_THREADS)
     nat i, j;
     rtsBool retry = rtsTrue;
 
+    stat_startGCSync(gc_threads[cap->no]);
+
+
     while(retry) {
         for (i=0; i < n_threads; i++) {
             if (i == me || gc_threads[i]->idle) continue;
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index 84ce3f0239..cbe4346afe 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -183,6 +183,7 @@ typedef struct gc_thread_ {
     W_ scav_find_work;
 
     Time gc_start_cpu;   // process CPU time
+    Time gc_sync_start_elapsed;  // start of GC sync
     Time gc_start_elapsed;  // process elapsed time
     W_ gc_start_faults;