Commit a7ab1616 authored by Simon Marlow's avatar Simon Marlow

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
parent 72092904
......@@ -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
......
......@@ -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
......
......@@ -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);
}
......@@ -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"
......
......@@ -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.
......
......@@ -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) \
......
......@@ -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");
}
......
......@@ -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 */
......@@ -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();
......
......@@ -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;
}
......
......@@ -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));