X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRtsStartup.c;h=c115701d6ccc5a65079df0d356719aaad1a9d772;hp=a363c133f40908ddc735ff9de4640d1c2c638a34;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=8bac478832e0cf9fa7ad1cfc81c08b0b9f13938e diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index a363c13..c115701 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -7,68 +7,59 @@ * ---------------------------------------------------------------------------*/ // PAPI uses caddr_t, which is not POSIX -// #include "PosixSource.h" +#ifndef USE_PAPI +#include "PosixSource.h" +#endif #include "Rts.h" #include "RtsAPI.h" +#include "HsFFI.h" + +#include "sm/Storage.h" +#include "RtsFlags.h" #include "RtsUtils.h" -#include "RtsFlags.h" -#include "OSThreads.h" +#include "Prelude.h" #include "Schedule.h" /* initScheduler */ #include "Stats.h" /* initStats */ #include "STM.h" /* initSTM */ -#include "Signals.h" #include "RtsSignals.h" -#include "ThrIOManager.h" -#include "Timer.h" /* startTimer, stopTimer */ #include "Weak.h" #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ -#include "HsFFI.h" -#include "Linker.h" #include "ThreadLabels.h" -#include "BlockAlloc.h" +#include "sm/BlockAlloc.h" #include "Trace.h" -#include "RtsTypeable.h" #include "Stable.h" -#include "Hpc.h" +#include "Hash.h" +#include "Profiling.h" +#include "Timer.h" +#include "Globals.h" +void exitLinker( void ); // there is no Linker.h file to include #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" #endif -# include "Profiling.h" - #if defined(PROFILING) # include "ProfHeap.h" # include "RetainerProfile.h" #endif -#if defined(GRAN) -# include "GranSimRts.h" -#endif - -#if defined(GRAN) || defined(PAR) -# include "ParallelRts.h" -#endif - -#if defined(PAR) -# include "Parallel.h" -# include "LLC.h" -#endif - #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS) #include "win32/AsyncIO.h" #endif -#include +#if !defined(mingw32_HOST_OS) +#include "posix/TTY.h" +#include "posix/FileLock.h" +#endif -#ifdef HAVE_TERMIOS_H -#include +#ifdef HAVE_UNISTD_H +#include #endif -#ifdef HAVE_SIGNAL_H -#include +#ifdef HAVE_LOCALE_H +#include #endif #if USE_PAPI @@ -78,29 +69,9 @@ // Count of how many outstanding hs_init()s there have been. static int hs_init_count = 0; -// Here we save the terminal settings on the standard file -// descriptors, if we need to change them (eg. to support NoBuffering -// input). -static void *saved_termios[3] = {NULL,NULL,NULL}; - -void* -__hscore_get_saved_termios(int fd) -{ - return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ? - saved_termios[fd] : NULL; -} - -void -__hscore_set_saved_termios(int fd, void* ts) -{ - if (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) { - saved_termios[fd] = ts; - } -} - /* ----------------------------------------------------------------------------- - Initialise floating point unit on x86 (currently disabled. why?) - (see comment in ghc/compiler/nativeGen/MachInstrs.lhs). + Initialise floating point unit on x86 (currently disabled; See Note + [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs) -------------------------------------------------------------------------- */ #define X86_INIT_FPU 0 @@ -139,57 +110,16 @@ 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 + setlocale(LC_CTYPE,""); + + /* 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(); -#ifdef PAR - /* - * The parallel system needs to be initialised and synchronised before - * the program is run. - */ - startupParallelSystem(argv); - - if (*argv[0] == '-') { /* Strip off mainPE flag argument */ - argv++; - argc--; - } - - argv[1] = argv[0]; /* ignore the nPEs argument */ - 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(); @@ -200,34 +130,31 @@ hs_init(int *argc, char **argv[]) /* Parse the flags, separating the RTS flags from the programs args */ if (argc != NULL && argv != NULL) { setFullProgArgv(*argc,*argv); - setupRtsFlags(argc, *argv, &rts_argc, rts_argv); - setProgArgv(*argc,*argv); + setupRtsFlags(argc, *argv); } + /* Initialise the stats department, phase 1 */ + initStats1(); + +#ifdef USE_PAPI + papi_init(); +#endif + /* initTracing must be after setupRtsFlags() */ +#ifdef TRACING initTracing(); - -#if defined(PAR) - /* NB: this really must be done after processing the RTS flags */ - IF_PAR_DEBUG(verbose, - debugBelch("==== Synchronising system (%d PEs)\n", nPEs)); - synchroniseSystem(); // calls initParallelSystem etc -#endif /* PAR */ +#endif + /* Trace the startup event + */ + traceEventStartup(); /* initialise scheduler data structures (needs to be done before * initStorage()). */ initScheduler(); -#if defined(GRAN) - /* And start GranSim profiling if required: */ - if (RtsFlags.GranFlags.GranSimStats.Full) - init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv); -#elif defined(PAR) - /* And start GUM profiling if required: */ - if (RtsFlags.ParFlags.ParStats.Full) - init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv); -#endif /* PAR || GRAN */ + /* Trace some basic information about the process */ + traceOSProcessInfo(); /* initialize the storage manager */ initStorage(); @@ -235,8 +162,36 @@ 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)runIO_closure); + getStablePtr((StgPtr)runNonIO_closure); + + getStablePtr((StgPtr)runFinalizerBatch_closure); + + getStablePtr((StgPtr)stackOverflow_closure); + getStablePtr((StgPtr)heapOverflow_closure); + getStablePtr((StgPtr)unpackCString_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure); + getStablePtr((StgPtr)nonTermination_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); + getStablePtr((StgPtr)nestedAtomically_closure); + + getStablePtr((StgPtr)runSparks_closure); + getStablePtr((StgPtr)ensureIOManagerIsRunning_closure); +#ifndef mingw32_HOST_OS + getStablePtr((StgPtr)runHandlers_closure); +#endif + /* initialise the shared Typeable store */ - initTypeableStore(); + initGlobalStore(); + + /* initialise file locking, if necessary */ +#if !defined(mingw32_HOST_OS) + initFileLocking(); +#endif #if defined(DEBUG) /* initialise thread label table (tso->char*) */ @@ -246,11 +201,9 @@ hs_init(int *argc, char **argv[]) initProfiling1(); /* start the virtual timer 'subsystem'. */ + initTimer(); startTimer(); - /* Initialise the stats department */ - initStats(); - #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { /* Initialise the user signal handler set */ @@ -274,6 +227,13 @@ hs_init(int *argc, char **argv[]) x86_init_fpu(); #endif + startupHpc(); + + // This must be done after module initialisation. + // ToDo: make this work in the presence of multiple hs_add_root()s. + initProfiling2(); + + // ditto. #if defined(THREADED_RTS) ioManagerStart(); #endif @@ -284,83 +244,41 @@ hs_init(int *argc, char **argv[]) // Compatibility interface void -startupHaskell(int argc, char *argv[], void (*init_root)(void)) +startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED) { hs_init(&argc, &argv); - if(init_root) - hs_add_root(init_root); } /* ----------------------------------------------------------------------------- - Per-module initialisation - - This process traverses all the compiled modules in the program - starting with "Main", and performing per-module initialisation for - each one. - - So far, two things happen at initialisation time: - - - we register stable names for each foreign-exported function - in that module. This prevents foreign-exported entities, and - things they depend on, from being garbage collected. - - - we supply a unique integer to each statically declared cost - centre and cost centre stack in the program. - - The code generator inserts a small function "__stginit_" in each - module and calls the registration functions in each of the modules it - imports. - - The init* functions are compiled in the same way as STG code, - i.e. without normal C call/return conventions. Hence we must use - StgRun to call this stuff. + hs_add_root: backwards compatibility. (see #3252) -------------------------------------------------------------------------- */ -/* The init functions use an explicit stack... - */ -#define INIT_STACK_BLOCKS 4 -static F_ *init_stack = NULL; - void -hs_add_root(void (*init_root)(void)) +hs_add_root(void (*init_root)(void) STG_UNUSED) { - bdescr *bd; - nat init_sp; - Capability *cap = &MainCapability; - - if (hs_init_count <= 0) { - barf("hs_add_root() must be called after hs_init()"); - } - - /* The initialisation stack grows downward, with sp pointing - to the last occupied word */ - init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W; - bd = allocGroup_lock(INIT_STACK_BLOCKS); - init_stack = (F_ *)bd->start; - init_stack[--init_sp] = (F_)stg_init_finish; - if (init_root != NULL) { - init_stack[--init_sp] = (F_)init_root; - } - - cap->r.rSp = (P_)(init_stack + init_sp); - StgRun((StgFunPtr)stg_init, &cap->r); - - freeGroup_lock(bd); - - startupHpc(); - - // This must be done after module initialisation. - // ToDo: make this work in the presence of multiple hs_add_root()s. - initProfiling2(); + /* nothing */ } -/* ----------------------------------------------------------------------------- - Shutting down the RTS - -------------------------------------------------------------------------- */ +/* ---------------------------------------------------------------------------- + * Shutting down the RTS + * + * The wait_foreign parameter means: + * True ==> wait for any threads doing foreign calls now. + * False ==> threads doing foreign calls may return in the + * future, but will immediately block on a mutex. + * (capability->lock). + * + * If this RTS is a DLL that we're about to unload, then you want + * safe=True, otherwise the thread might return to code that has been + * unloaded. If this is a standalone program that is about to exit, + * then you can get away with safe=False, which is better because we + * won't hang on exit if there is a blocked foreign call outstanding. + * + ------------------------------------------------------------------------- */ -void -hs_exit(void) +static void +hs_exit_(rtsBool wait_foreign) { if (hs_init_count <= 0) { errorBelch("warning: too many hs_exit()s"); @@ -375,10 +293,11 @@ hs_exit(void) /* start timing the shutdown */ stat_startExit(); -#if defined(RTS_USER_SIGNALS) - if (RtsFlags.MiscFlags.install_signal_handlers) { - freeSignalHandlers(); - } + OnExitHook(); + + // sanity check +#if defined(DEBUG) + checkFPUStack(); #endif #if defined(THREADED_RTS) @@ -386,50 +305,28 @@ hs_exit(void) #endif /* stop all running tasks */ - exitScheduler(); + exitScheduler(wait_foreign); + + /* run C finalizers for all active weak pointers */ + runAllCFinalizers(weak_ptr_list); -#if defined(GRAN) - /* end_gr_simulation prints global stats if requested -- HWL */ - if (!RtsFlags.GranFlags.GranSimStats.Suppressed) - end_gr_simulation(); +#if defined(RTS_USER_SIGNALS) + if (RtsFlags.MiscFlags.install_signal_handlers) { + freeSignalHandlers(); + } #endif - + /* stop the ticker */ stopTimer(); + exitTimer(wait_foreign); - /* reset the standard file descriptors to blocking mode */ - resetNonBlockingFd(0); - resetNonBlockingFd(1); - resetNonBlockingFd(2); - -#if HAVE_TERMIOS_H - // Reset the terminal settings on the standard file descriptors, - // if we changed them. See System.Posix.Internals.tcSetAttr for - // more details, including the reason we termporarily disable - // SIGTTOU here. - { - int fd; - sigset_t sigset, old_sigset; - sigemptyset(&sigset); - sigaddset(&sigset, SIGTTOU); - sigprocmask(SIG_BLOCK, &sigset, &old_sigset); - for (fd = 0; fd <= 2; fd++) { - struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd); - if (ts != NULL) { - tcsetattr(fd,TCSANOW,ts); - } - } - sigprocmask(SIG_SETMASK, &old_sigset, NULL); - } + // set the terminal settings back to what they were +#if !defined(mingw32_HOST_OS) + resetTerminalSettings(); #endif -#if defined(PAR) - /* controlled exit; good thread! */ - shutdownParallelSystem(0); - - /* global statistics in parallel system */ - PAR_TICKY_PAR_END(); -#endif + // uninstall signal handlers + resetDefaultHandlers(); /* stop timing the shutdown, we're about to print stats */ stat_endExit(); @@ -445,13 +342,19 @@ hs_exit(void) freeScheduler(); /* free shared Typeable store */ - exitTypeableStore(); + exitGlobalStore(); + + /* free linker data */ + exitLinker(); + + /* free file locking tables, if necessary */ +#if !defined(mingw32_HOST_OS) + freeFileLocking(); +#endif /* free the stable pointer table */ exitStablePtrTable(); - freeProfiling1(); - #if defined(DEBUG) /* free the thread label table */ freeThreadLabelTable(); @@ -468,12 +371,18 @@ hs_exit(void) #endif endProfiling(); + freeProfiling(); #ifdef PROFILING // 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 + +#ifdef TRACING + endTracing(); + freeTracing(); #endif #if defined(TICKY_TICKY) @@ -481,20 +390,28 @@ hs_exit(void) #endif #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS) - shutdownAsyncIO(); + shutdownAsyncIO(wait_foreign); #endif /* free hash table storage */ exitHashTable(); - // Finally, free all our storage - freeStorage(); + // Finally, free all our storage. However, we only free the heap + // memory if we have waited for foreign calls to complete; + // otherwise a foreign call in progress may still be referencing + // heap memory (e.g. by being passed a ByteArray#). + freeStorage(wait_foreign); -#if defined(DEBUG) - /* and shut down the allocator debugging */ - shutdownAllocator(); -#endif + // Free the various argvs + freeRtsArgs(); +} +// The real hs_exit(): +void +hs_exit(void) +{ + hs_exit_(rtsTrue); + // be safe; this might be a DLL } // Compatibility interfaces @@ -507,40 +424,32 @@ shutdownHaskell(void) void shutdownHaskellAndExit(int n) { - if (hs_init_count == 1) { - OnExitHook(); - hs_exit(); -#if defined(PAR) - /* really exit (stg_exit() would call shutdownParallelSystem() again) */ - exit(n); -#else + // we're about to exit(), no need to wait for foreign calls to return. + hs_exit_(rtsFalse); + + if (hs_init_count == 0) { stg_exit(n); -#endif } } +#ifndef mingw32_HOST_OS +void +shutdownHaskellAndSignal(int sig) +{ + hs_exit_(rtsFalse); + kill(getpid(),sig); +} +#endif + /* * called from STG-land to exit the program */ -#ifdef PAR -static int exit_started=rtsFalse; -#endif - void (*exitFn)(int) = 0; void stg_exit(int n) { -#ifdef PAR - /* HACK: avoid a loop when exiting due to a stupid error */ - if (exit_started) - return; - exit_started=rtsTrue; - - IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid)); - shutdownParallelSystem(n); -#endif if (exitFn) (*exitFn)(n); exit(n);