X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsStartup.c;h=f992f1bd239d9f37415500490fc021b6c62d398d;hb=c850515d5daff53759eb04fea5f9bb42e2046da3;hp=7439a78099284abc6e160c8b5699a68d1c7f906a;hpb=462bf5bab1e61d48cc3d0efc81decead27ea11bd;p=ghc-hetmet.git

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 7439a78..f992f1b 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.29 2000/02/17 17:19:42 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.43 2000/10/06 15:35:47 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Main function for a standalone Haskell program.
  *
@@ -19,9 +19,17 @@
 #include "Itimer.h"
 #include "Weak.h"
 #include "Ticky.h"
+#include "StgRun.h"
+#include "StgStartup.h"
+#include "Prelude.h"		/* fixupRTStoPreludeRefs */
+
+#ifdef GHCI
+#include "HsFFI.h"
+#include "Linker.h"
+#endif
 
 #if defined(PROFILING) || defined(DEBUG)
-# include "ProfRts.h"
+# include "Profiling.h"
 # include "ProfHeap.h"
 #endif
 
@@ -46,13 +54,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;
@@ -121,11 +148,25 @@ startupHaskell(int argc, char *argv[])
     /* initialize the storage manager */
     initStorage();
 
+    /* initialise the object linker, if necessary */
+#ifdef GHCI
+    initLinker();
+#endif
+
     /* initialise the stable pointer table */
     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 */
@@ -143,34 +184,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_<module>" 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)
@@ -211,6 +301,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();
 
@@ -233,10 +327,6 @@ shutdownHaskell(void)
 
   rts_has_started_up=0;
 
-#if defined(PAR)
-  shutdownParallelSystem(0);
-#endif
-
 }
 
 /*