[project @ 2003-07-21 11:06:22 by simonpj]

[ghc-hetmet.git] / ghc / rts / RtsStartup.c

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index def63a5..1c6ab40 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.68 2003/01/28 16:30:06 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.73 2003/04/01 15:05:15 sof Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -17,7 +17,7 @@
 #include "Schedule.h"   /* initScheduler */
 #include "Stats.h"      /* initStats */
 #include "Signals.h"
-#include "Itimer.h"
+#include "Timer.h"      /* startTimer, stopTimer */
 #include "Weak.h"
 #include "Ticky.h"
 #include "StgRun.h"
@@ -50,6 +50,10 @@
 # include "LLC.h"
 #endif
 
+#if defined(mingw32_TARGET_OS)
+#include "win32/AsyncIO.h"
+#endif
+
 #include <stdlib.h>
 
 // Flag Structure
@@ -140,23 +144,23 @@ hs_init(int *argc, char **argv[])
     initProfiling1();
 #endif
 
-#if defined(PROFILING) || defined(DEBUG)
-    initProfiling2();
-#endif
-
     /* start the virtual timer 'subsystem'. */
-    startVirtTimer(TICK_MILLISECS);
+    startTimer(TICK_MILLISECS);
 
     /* Initialise the stats department */
     initStats();
 
-#if !defined(mingw32_TARGET_OS) && !defined(PAR)
+#if defined(RTS_USER_SIGNALS)
     /* Initialise the user signal handler set */
     initUserSignals();
     /* Set up handler to run on SIGINT, etc. */
     initDefaultHandlers();
 #endif
  
+#if defined(mingw32_TARGET_OS)
+    startupAsyncIO();
+#endif
+
 #ifdef RTS_GTK_FRONTPANEL
     if (RtsFlags.GcFlags.frontpanel) {
        initFrontPanel();
@@ -177,9 +181,9 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void))
 
 
 /* -----------------------------------------------------------------------------
-   Getting the program's arguments.
+   Getting/Setting the program's arguments.
 
-   This is used by System.Environment.getArgs.
+   These are used by System.Environment.
    -------------------------------------------------------------------------- */
 
 void
@@ -189,6 +193,18 @@ getProgArgv(int *argc, char **argv[])
     *argv = prog_argv;
 }
 
+void
+setProgArgv(int argc, char *argv[])
+{
+   /* 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;
+}
+
 /* -----------------------------------------------------------------------------
    Per-module initialisation
 
@@ -246,6 +262,12 @@ hs_add_root(void (*init_root)(void))
     StgRun((StgFunPtr)stg_init, &cap.r);
 
     freeGroup(bd);
+
+#if defined(PROFILING) || defined(DEBUG)
+    // This must be done after module initialisation.
+    // ToDo: make this work in the presence of multiple hs_add_root()s.
+    initProfiling2();
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -282,7 +304,7 @@ hs_exit(void)
 #endif
     
     /* stop the ticker */
-    stopVirtTimer();
+    stopTimer();
     
     /* reset the standard file descriptors to blocking mode */
     resetNonBlockingFd(0);
@@ -329,6 +351,10 @@ hs_exit(void)
 #if defined(TICKY_TICKY)
     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
+
+#if defined(mingw32_TARGET_OS)
+    shutdownAsyncIO();
+#endif
 }
 
 // Compatibility interfaces