X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsStartup.c;h=48ae736a461f88587a8bd29ce90b4ff310e49025;hb=c38093b57a3effcc8156736787958cc6b65e963d;hp=a589b18f1ad89861efdac56267338a7722d8d14f;hpb=1b28d4e1f43185ad8c8e7407c66413e1b358402b;p=ghc-hetmet.git diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index a589b18..48ae736 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.26 2000/01/13 14:34:04 hwloidl Exp $ + * $Id: RtsStartup.c,v 1.42 2000/04/20 13:20:31 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Main function for a standalone Haskell program. * @@ -19,9 +19,12 @@ #include "Itimer.h" #include "Weak.h" #include "Ticky.h" +#include "StgRun.h" +#include "StgStartup.h" +#include "Prelude.h" /* fixupRTStoPreludeRefs */ -#if defined(PROFILING) -# include "ProfRts.h" +#if defined(PROFILING) || defined(DEBUG) +# include "Profiling.h" # include "ProfHeap.h" #endif @@ -46,13 +49,32 @@ static int rts_has_started_up = 0; static ullong startTime = 0; #endif +EXTFUN(__init_Prelude); +static void initModules ( void * ); + void -startupHaskell(int argc, char *argv[]) +setProgArgv(int argc, char *argv[]) { -#ifdef ENABLE_WIN32_DLL_SUPPORT - int i; -#endif + /* Usually this is done by startupHaskell, so we don't need to call this. + However, sometimes Hugs wants to change the arguments which Haskell + getArgs >>= ... will be fed. So you can do that by calling here + _after_ calling startupHaskell. + */ + prog_argc = argc; + prog_argv = argv; +} + +void +getProgArgv(int *argc, char **argv[]) +{ + *argc = prog_argc; + *argv = prog_argv; +} + +void +startupHaskell(int argc, char *argv[], void *init_root) +{ /* To avoid repeated initialisations of the RTS */ if (rts_has_started_up) return; @@ -125,14 +147,21 @@ startupHaskell(int argc, char *argv[]) initStablePtrTable(); #if defined(PROFILING) || defined(DEBUG) - initProfiling(); + initProfiling1(); +#endif + + /* run the per-module initialisation code */ +#if !defined(INTERPRETER) + initModules(init_root); +#endif + +#if defined(PROFILING) || defined(DEBUG) + initProfiling2(); #endif /* start the ticker */ install_vtalrm_handler(); -#if 0 /* tmp--SDM */ initialize_virtual_timer(TICK_MILLISECS); -#endif /* start our haskell execution tasks */ #ifdef SMP @@ -145,34 +174,83 @@ startupHaskell(int argc, char *argv[]) #if !defined(mingw32_TARGET_OS) && !defined(PAR) /* Initialise the user signal handler set */ initUserSignals(); - /* Set up handler to run on SIGINT */ - init_shutdown_handler(); + /* Set up handler to run on SIGINT, etc. */ + init_default_handlers(); #endif - /* When the RTS and Prelude live in separate DLLs, - we need to patch up the char- and int-like tables - that the RTS keep after both DLLs have been loaded, - filling in the tables with references to where the - static info tables have been loaded inside the running - process. +#if !defined(INTERPRETER) + /* Initialise pointers from the RTS to the prelude. + Only for compiled code -- the interpreter + will call this itself later, so don't do so now. */ -#ifdef ENABLE_WIN32_DLL_SUPPORT - for(i=0;i<=255;i++) - (CHARLIKE_closure[i]).header.info = (const StgInfoTable*)&Czh_static_info; - - for(i=0;i<=32;i++) - (INTLIKE_closure[i]).header.info = (const StgInfoTable*)&Izh_static_info; - + fixupRTStoPreludeRefs(NULL); #endif + /* Record initialization times */ end_init(); } -/* +/* ----------------------------------------------------------------------------- + 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 "__init_" in each + module and calls the registration functions in each of the modules + it imports. So, if we call "__init_PrelMain", each reachable module in the + program will be registered (because PrelMain.mainIO calls Main.main). + + 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. + -------------------------------------------------------------------------- */ + +/* The init functions use an explicit stack... + */ +#define INIT_STACK_SIZE (BLOCK_SIZE * 4) +F_ *init_stack = NULL; +nat init_sp = 0; + +#ifndef INTERPRETER +static void +initModules ( void *init_root ) +{ +#ifdef SMP + Capability cap; +#else +#define cap MainRegTable +#endif + + init_sp = 0; + init_stack = (F_ *)allocate(INIT_STACK_SIZE / sizeof(W_)); + init_stack[init_sp++] = (F_)stg_init_ret; + init_stack[init_sp++] = (F_)__init_Prelude; + if (init_root != NULL) { + init_stack[init_sp++] = (F_)init_root; + } + + cap.rSp = (P_)(init_stack + init_sp); + StgRun((StgFunPtr)stg_init, &cap); +} +#endif /* !INTERPRETER */ + +/* ----------------------------------------------------------------------------- * Shutting down the RTS - two ways of doing this, one which * calls exit(), one that doesn't. * * (shutdownHaskellAndExit() is called by System.exitWith). + * ----------------------------------------------------------------------------- */ void shutdownHaskellAndExit(int n) @@ -213,6 +291,10 @@ shutdownHaskell(void) resetNonBlockingFd(1); resetNonBlockingFd(2); +#if defined(PAR) + shutdownParallelSystem(0); +#endif + /* stop timing the shutdown, we're about to print stats */ stat_endExit(); @@ -226,7 +308,7 @@ shutdownHaskell(void) #endif #if defined(PROFILING) - report_ccs_profiling( ); + report_ccs_profiling(); #endif #if defined(TICKY_TICKY) @@ -235,10 +317,6 @@ shutdownHaskell(void) rts_has_started_up=0; -#if defined(PAR) - shutdownParallelSystem(0); -#endif - } /*