/* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.32 2000/03/09 11:49:34 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.48 2001/02/09 13:09:16 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Main function for a standalone Haskell program.
*
#include "Ticky.h"
#include "StgRun.h"
#include "StgStartup.h"
+#include "Prelude.h" /* fixupRTStoPreludeRefs */
+
+#ifdef GHCI
+#include "HsFFI.h"
+#include "Linker.h"
+#endif
+
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
#if defined(PROFILING) || defined(DEBUG)
-# include "ProfRts.h"
+# include "Profiling.h"
# include "ProfHeap.h"
#endif
static ullong startTime = 0;
#endif
-static void initModules ( void );
+EXTFUN(__init_Prelude);
+static void initModules ( void (*)(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)(void))
+{
/* To avoid repeated initialisations of the RTS */
if (rts_has_started_up)
return;
/* The very first thing we do is grab the start time...just in case we're
* collecting timing statistics.
*/
- start_time();
+ stat_startInit();
#ifdef PAR
/*
/* initialize the storage manager */
initStorage();
+ /* initialise the object linker, if necessary */
+#ifdef GHCI
+ initLinker();
+#endif
+
/* initialise the stable pointer table */
initStablePtrTable();
#endif
/* run the per-module initialisation code */
-#if !defined(INTERPRETER)
- initModules();
-#endif
+ initModules(init_root);
#if defined(PROFILING) || defined(DEBUG)
initProfiling2();
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.
- */
-#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;
-
+#ifdef RTS_GTK_FRONTPANEL
+ if (RtsFlags.GcFlags.frontpanel) {
+ initFrontPanel();
+ }
#endif
+
/* Record initialization times */
- end_init();
+ stat_endInit();
}
/* -----------------------------------------------------------------------------
- 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_<moddule>" in each
+ The code generator inserts a small function "__init_<module>" in each
module and calls the registration functions in each of the modules
- it imports. So, if we call "__init_Main", each reachable module in the
- program will be registered.
+ 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.
-------------------------------------------------------------------------- */
-#ifndef INTERPRETER
-
/* The init functions use an explicit stack...
*/
#define INIT_STACK_SIZE (BLOCK_SIZE * 4)
-F_ *init_stack;
+F_ *init_stack = NULL;
+nat init_sp = 0;
static void
-initModules ( void )
+initModules ( void (*init_root)(void) )
{
- /* this storage will be reclaimed by the garbage collector,
- * as a large block.
- */
- init_stack = (F_ *)allocate(INIT_STACK_SIZE / sizeof(W_));
+#ifdef SMP
+ Capability cap;
+#else
+#define cap MainRegTable
+#endif
- StgRun((StgFunPtr)stg_init, NULL/* no reg table */);
+ 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.
resetNonBlockingFd(1);
resetNonBlockingFd(2);
+#if defined(PAR)
+ shutdownParallelSystem(0);
+#endif
+
/* stop timing the shutdown, we're about to print stats */
stat_endExit();
*/
exitStorage();
+#ifdef RTS_GTK_FRONTPANEL
+ if (RtsFlags.GcFlags.frontpanel) {
+ stopFrontPanel();
+ }
+#endif
+
#if defined(PROFILING) || defined(DEBUG)
endProfiling();
#endif
rts_has_started_up=0;
-#if defined(PAR)
- shutdownParallelSystem(0);
-#endif
-
}
/*
projects / ghc-hetmet.git / blobdiff