X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRtsStartup.c;h=fbebdb9c41d2513a12a3163a0a627cc74b0885d0;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=4f42823d4ae5f7dc946022b877b896c5118c6835;hpb=50c4d03919a9d5c37c14004e964083251f655e93;p=ghc-hetmet.git diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 4f42823..fbebdb9 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -71,6 +71,9 @@ #ifdef HAVE_SIGNAL_H #include #endif +#ifdef HAVE_UNISTD_H +#include +#endif #if USE_PAPI #include "Papi.h" @@ -140,17 +143,20 @@ hs_init(int *argc, char **argv[]) return; } -#if defined(DEBUG) - /* Start off by initialising the allocator debugging so we can - * use it anywhere */ - initAllocator(); -#endif + /* Initialise the stats department, phase 0 */ + initStats0(); /* Next we do is grab the start time...just in case we're * collecting timing statistics. */ stat_startInit(); +#if defined(DEBUG) + /* Start off by initialising the allocator debugging so we can + * use it anywhere */ + initAllocator(); +#endif + #ifdef PAR /* * The parallel system needs to be initialised and synchronised before @@ -167,30 +173,6 @@ hs_init(int *argc, char **argv[]) argv++; argc--; #endif - /* Initialise the performance tracking library */ -#ifdef USE_PAPI - { - int ver; - if ((ver = PAPI_library_init(PAPI_VER_CURRENT)) != PAPI_VER_CURRENT) { - if (ver > 0) { - errorBelch("PAPI_library_init: wrong version: %x", ver); - stg_exit(EXIT_FAILURE); - } else { - sysErrorBelch("PAPI_library_init"); - stg_exit(EXIT_FAILURE); - } - } - } -#ifdef THREADED_RTS - { - int err; - if ((err = PAPI_thread_init(osThreadId)) < 0) { - barf("PAPI_thread_init: %d",err); - } - } -#endif -#endif - /* Set the RTS flags to default values. */ initRtsFlagsDefaults(); @@ -205,6 +187,13 @@ hs_init(int *argc, char **argv[]) setProgArgv(*argc,*argv); } + /* Initialise the stats department, phase 1 */ + initStats1(); + +#ifdef USE_PAPI + papi_init(); +#endif + /* initTracing must be after setupRtsFlags() */ initTracing(); @@ -236,6 +225,20 @@ hs_init(int *argc, char **argv[]) /* initialise the stable pointer table */ initStablePtrTable(); + /* Add some GC roots for things in the base package that the RTS + * knows about. We don't know whether these turn out to be CAFs + * or refer to CAFs, but we have to assume that they might. + */ + getStablePtr((StgPtr)base_GHCziTopHandler_runIO_closure); + getStablePtr((StgPtr)base_GHCziTopHandler_runNonIO_closure); + getStablePtr((StgPtr)stackOverflow_closure); + getStablePtr((StgPtr)heapOverflow_closure); + getStablePtr((StgPtr)runFinalizerBatch_closure); + getStablePtr((StgPtr)unpackCString_closure); + getStablePtr((StgPtr)blockedOnDeadMVar_closure); + getStablePtr((StgPtr)nonTermination_closure); + getStablePtr((StgPtr)blockedIndefinitely_closure); + /* initialise the shared Typeable store */ initTypeableStore(); @@ -255,9 +258,6 @@ hs_init(int *argc, char **argv[]) initTimer(); startTimer(); - /* Initialise the stats department */ - initStats(); - #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { /* Initialise the user signal handler set */ @@ -330,7 +330,9 @@ hs_add_root(void (*init_root)(void)) { bdescr *bd; nat init_sp; - Capability *cap = &MainCapability; + Capability *cap; + + cap = rts_lock(); if (hs_init_count <= 0) { barf("hs_add_root() must be called after hs_init()"); @@ -357,6 +359,8 @@ hs_add_root(void (*init_root)(void)) // ToDo: make this work in the presence of multiple hs_add_root()s. initProfiling2(); + rts_unlock(cap); + // ditto. #if defined(THREADED_RTS) ioManagerStart(); @@ -396,6 +400,8 @@ hs_exit_(rtsBool wait_foreign) /* start timing the shutdown */ stat_startExit(); + OnExitHook(); + #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { freeSignalHandlers(); @@ -453,6 +459,9 @@ hs_exit_(rtsBool wait_foreign) PAR_TICKY_PAR_END(); #endif + // uninstall signal handlers + resetDefaultHandlers(); + /* stop timing the shutdown, we're about to print stats */ stat_endExit(); @@ -499,7 +508,7 @@ hs_exit_(rtsBool wait_foreign) // Originally, this was in report_ccs_profiling(). Now, retainer // profiling might tack some extra stuff on to the end of this file // during endProfiling(). - fclose(prof_file); + if (prof_file != NULL) fclose(prof_file); #endif #if defined(TICKY_TICKY) @@ -541,10 +550,10 @@ shutdownHaskell(void) void shutdownHaskellAndExit(int n) { - if (hs_init_count == 1) { - OnExitHook(); - hs_exit_(rtsFalse); - // we're about to exit(), no need to wait for foreign calls to return. + // we're about to exit(), no need to wait for foreign calls to return. + hs_exit_(rtsFalse); + + if (hs_init_count == 0) { #if defined(PAR) /* really exit (stg_exit() would call shutdownParallelSystem() again) */ exit(n); @@ -554,6 +563,15 @@ shutdownHaskellAndExit(int n) } } +#ifndef mingw32_HOST_OS +void +shutdownHaskellAndSignal(int sig) +{ + hs_exit_(rtsFalse); + kill(getpid(),sig); +} +#endif + /* * called from STG-land to exit the program */