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

compiler/main/SysTools.hs

@@ -1604,14 +1604,9 @@ linkDynLib dflags0 o_files dep_packages
             -------------------------------------------------------------------
 
             let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
-            let buildingRts = thisPackage dflags == rtsPackageKey
-            let bsymbolicFlag = if buildingRts
-                                then -- -Bsymbolic breaks the way we implement
-                                     -- hooks in the RTS
-                                     []
-                                else -- we need symbolic linking to resolve
-                                     -- non-PIC intra-package-relocations
-                                     ["-Wl,-Bsymbolic"]
+            let bsymbolicFlag = -- we need symbolic linking to resolve
+                                -- non-PIC intra-package-relocations
+                                ["-Wl,-Bsymbolic"]
 
             runLink dflags (
                     map Option verbFlags

ghc/ghc.mk

@@ -51,6 +51,10 @@ ghc_stage1_C_FILES_NODEPS = ghc/hschooks.c
 ghc_stage2_MKDEPENDC_OPTS = -DMAKING_GHC_BUILD_SYSTEM_DEPENDENCIES
 ghc_stage3_MKDEPENDC_OPTS = -DMAKING_GHC_BUILD_SYSTEM_DEPENDENCIES
 
+ghc_stage1_MORE_HC_OPTS += -no-hs-main
+ghc_stage2_MORE_HC_OPTS += -no-hs-main
+ghc_stage3_MORE_HC_OPTS += -no-hs-main
+
 ifeq "$(GhcDebugged)" "YES"
 ghc_stage1_MORE_HC_OPTS += -debug
 ghc_stage2_MORE_HC_OPTS += -debug

ghc/hschooks.c

@@ -54,3 +54,15 @@ StackOverflowHook (StgWord stack_size)    /* in bytes */
     fprintf(stderr, "GHC stack-space overflow: current limit is %zu bytes.\nUse the `-K<size>' option to increase it.\n", (size_t)stack_size);
 }
 
+int main (int argc, char *argv[])
+{
+    RtsConfig conf = defaultRtsConfig;
+#if __GLASGOW_HASKELL__ >= 711
+    conf.defaultsHook = defaultsHook;
+    conf.rts_opts_enabled = RtsOptsAll;
+    conf.stackOverflowHook = StackOverflowHook;
+#endif
+    extern StgClosure ZCMain_main_closure;
+
+    hs_main(argc, argv, &ZCMain_main_closure, conf);
+}

includes/Rts.h

@@ -220,7 +220,6 @@ INLINE_HEADER Time fsecondsToTime (double t)
 
 /* Other RTS external APIs */
 #include "rts/Parallel.h"
-#include "rts/Hooks.h"
 #include "rts/Signals.h"
 #include "rts/BlockSignals.h"
 #include "rts/Hpc.h"

includes/RtsAPI.h

@@ -60,9 +60,42 @@ typedef enum {
 // reason for using a struct is extensibility: we can add more
 // fields to this later without breaking existing client code.
 typedef struct {
+
+    // Whether to interpret +RTS options on the command line
     RtsOptsEnabledEnum rts_opts_enabled;
+
+    // additional RTS options
     const char *rts_opts;
+
+    // True if GHC was not passed -no-hs-main
     HsBool rts_hs_main;
+
+    // Called before processing command-line flags, so that default
+    // settings for RtsFlags can be provided.
+    void (* defaultsHook) (void);
+
+    // Called just before exiting
+    void (* onExitHook) (void);
+
+    // Called on a stack overflow, before exiting
+    void (* stackOverflowHook) (W_ stack_size);
+
+    // Called on heap overflow, before exiting
+    void (* outOfHeapHook) (W_ request_size, W_ heap_size);
+
+    // Called when malloc() fails, before exiting
+    void (* mallocFailHook) (W_ request_size /* in bytes */, char *msg);
+
+    // Called for every GC
+    void (* gcDoneHook) (unsigned int gen,
+                         W_ allocated_bytes, /* since last GC */
+                         W_ live_bytes,
+                         W_ copied_bytes,
+                         W_ max_copied_per_thread_bytes,
+                         W_ total_bytes,
+                         W_ slop_bytes,
+                         W_ sync_elapsed_ns, W_ elapsed_ns, W_ cpu_ns);
+
 } RtsConfig;
 
 // Clients should start with defaultRtsConfig and then customise it.

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)                               \

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");
         }

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 */

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();
 

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;
     }

rts/Stats.c

@@ -9,6 +9,7 @@
 #include "PosixSource.h"
 #include "Rts.h"
 
+#include "RtsFlags.h"
 #include "RtsUtils.h"
 #include "Schedule.h"