X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRtsStartup.c;h=c9edeace8e3c94fb2257b720c30885a8831176bd;hb=34cc75e1a62638f2833815746ebce0a9114dc26b;hp=c55fdfb537c5007678946e6cd0935da0d66bca8b;hpb=1663532f26ae2e68f04d067b11bd177d307637b1;p=ghc-hetmet.git diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index c55fdfb..c9edeac 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -30,10 +30,11 @@ #include "ThreadLabels.h" #include "BlockAlloc.h" #include "Trace.h" -#include "RtsTypeable.h" +#include "RtsGlobals.h" #include "Stable.h" #include "Hpc.h" #include "FileLock.h" +#include "EventLog.h" #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" @@ -71,6 +72,9 @@ #ifdef HAVE_SIGNAL_H #include #endif +#ifdef HAVE_UNISTD_H +#include +#endif #if USE_PAPI #include "Papi.h" @@ -192,7 +196,9 @@ hs_init(int *argc, char **argv[]) #endif /* initTracing must be after setupRtsFlags() */ +#ifdef DEBUG initTracing(); +#endif #if defined(PAR) /* NB: this really must be done after processing the RTS flags */ @@ -222,8 +228,22 @@ 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(); + initGlobalStore(); /* initialise file locking, if necessary */ #if !defined(mingw32_HOST_OS) @@ -237,6 +257,12 @@ hs_init(int *argc, char **argv[]) initProfiling1(); +#ifdef EVENTLOG + if (RtsFlags.EventLogFlags.doEventLogging) { + initEventLogging(); + } +#endif + /* start the virtual timer 'subsystem'. */ initTimer(); startTimer(); @@ -383,11 +409,7 @@ hs_exit_(rtsBool wait_foreign) /* start timing the shutdown */ stat_startExit(); -#if defined(RTS_USER_SIGNALS) - if (RtsFlags.MiscFlags.install_signal_handlers) { - freeSignalHandlers(); - } -#endif + OnExitHook(); #if defined(THREADED_RTS) ioManagerDie(); @@ -395,7 +417,16 @@ hs_exit_(rtsBool wait_foreign) /* stop all running tasks */ exitScheduler(wait_foreign); + + /* run C finalizers for all active weak pointers */ + runAllCFinalizers(weak_ptr_list); +#if defined(RTS_USER_SIGNALS) + if (RtsFlags.MiscFlags.install_signal_handlers) { + freeSignalHandlers(); + } +#endif + #if defined(GRAN) /* end_gr_simulation prints global stats if requested -- HWL */ if (!RtsFlags.GranFlags.GranSimStats.Suppressed) @@ -440,6 +471,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(); @@ -454,7 +488,7 @@ hs_exit_(rtsBool wait_foreign) freeScheduler(); /* free shared Typeable store */ - exitTypeableStore(); + exitGlobalStore(); /* free file locking tables, if necessary */ #if !defined(mingw32_HOST_OS) @@ -489,6 +523,13 @@ hs_exit_(rtsBool wait_foreign) if (prof_file != NULL) fclose(prof_file); #endif +#ifdef EVENTLOG + if (RtsFlags.EventLogFlags.doEventLogging) { + endEventLogging(); + freeEventLogging(); + } +#endif + #if defined(TICKY_TICKY) if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif @@ -528,10 +569,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); @@ -541,6 +582,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 */