X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsStartup.c;h=5d6e44638889b934e806c83f9f0215bd1d2500a8;hb=fb7a723bfd7650a705cb226e07c5b08b7a8e9279;hp=62258f22dec9b53f7ca0762e593ed7427c30dbbd;hpb=c108d3f61b1a5fefa8e15aa6ada4ff547bcbb4e5;p=ghc-hetmet.git

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 62258f2..5d6e446 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.36 2000/03/30 12:03:30 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.53 2001/09/04 18:29:21 ken Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -7,6 +7,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsAPI.h"
 #include "RtsUtils.h"
@@ -22,21 +23,29 @@
 #include "StgRun.h"
 #include "StgStartup.h"
 #include "Prelude.h"		/* fixupRTStoPreludeRefs */
+#include "HsFFI.h"
+#include "Linker.h"
+
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
 
 #if defined(PROFILING) || defined(DEBUG)
-# include "ProfRts.h"
+# include "Profiling.h"
 # include "ProfHeap.h"
 #endif
 
 #if defined(GRAN)
-#include "GranSimRts.h"
-#include "ParallelRts.h"
+# include "GranSimRts.h"
+#endif
+
+#if defined(GRAN) || defined(PAR)
+# include "ParallelRts.h"
 #endif
 
 #if defined(PAR)
-#include "ParInit.h"
-#include "Parallel.h"
-#include "LLC.h"
+# include "Parallel.h"
+# include "LLC.h"
 #endif
 
 /*
@@ -46,14 +55,34 @@ struct RTS_FLAGS RtsFlags;
 
 static int rts_has_started_up = 0;
 #if defined(PAR)
-static ullong startTime = 0;
+ullong startTime = 0;
 #endif
 
-EXTFUN(__init_Prelude);
-static void initModules ( void * );
+EXTFUN(__stginit_Prelude);
+static void initModules ( void (*)(void) );
+
+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;
+}
+
+void
+getProgArgv(int *argc, char **argv[])
+{
+   *argc = prog_argc;
+   *argv = prog_argv;
+}
+
 
 void
-startupHaskell(int argc, char *argv[], void *init_root)
+startupHaskell(int argc, char *argv[], void (*init_root)(void))
 {
     /* To avoid repeated initialisations of the RTS */
    if (rts_has_started_up)
@@ -64,28 +93,22 @@ startupHaskell(int argc, char *argv[], void *init_root)
     /* 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
-/*
- * The parallel system needs to be initialised and synchronised before
- * the program is run.  
- */
-    fprintf(stderr, "startupHaskell: argv[0]=%s\n", argv[0]);
-    if (*argv[0] == '-') {     /* Look to see whether we're the Main Thread */
-	IAmMainThread = rtsTrue;
-        argv++; argc--;			/* Strip off flag argument */
-	// IF_PAR_DEBUG(verbose,
-		     fprintf(stderr, "[%x] I am Main Thread\n", mytid);
+    /*
+     * 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--;			
     }
-    /* 
-     * Grab the number of PEs out of the argument vector, and
-     * eliminate it from further argument processing.
-     */
-    nPEs = atoi(argv[1]);
-    argv[1] = argv[0];
+
+    argv[1] = argv[0];   /* ignore the nPEs argument */
     argv++; argc--;
-    initEachPEHook();                  /* HWL: hook to be execed on each PE */
 #endif
 
     /* Set the RTS flags to default values. */
@@ -101,8 +124,9 @@ startupHaskell(int argc, char *argv[], void *init_root)
 
 #if defined(PAR)
     /* NB: this really must be done after processing the RTS flags */
-    fprintf(stderr, "Synchronising system (%d PEs)\n", nPEs);
-    SynchroniseSystem();             // calls initParallelSystem etc
+    IF_PAR_DEBUG(verbose,
+                 fprintf(stderr, "==== Synchronising system (%d PEs)\n", nPEs));
+    synchroniseSystem();             // calls initParallelSystem etc
 #endif	/* PAR */
 
     /* initialise scheduler data structures (needs to be done before
@@ -131,9 +155,7 @@ startupHaskell(int argc, char *argv[], void *init_root)
 #endif
 
     /* run the per-module initialisation code */
-#if !defined(INTERPRETER)
     initModules(init_root);
-#endif
 
 #if defined(PROFILING) || defined(DEBUG)
     initProfiling2();
@@ -158,16 +180,14 @@ startupHaskell(int argc, char *argv[], void *init_root)
     init_default_handlers();
 #endif
  
-#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.
-    */
-    fixupRTStoPreludeRefs(NULL);
+#ifdef RTS_GTK_FRONTPANEL
+    if (RtsFlags.GcFlags.frontpanel) {
+	initFrontPanel();
+    }
 #endif
 
     /* Record initialization times */
-    end_init();
+    stat_endInit();
 }
 
 /* -----------------------------------------------------------------------------
@@ -186,9 +206,9 @@ startupHaskell(int argc, char *argv[], void *init_root)
       - 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
+   The code generator inserts a small function "__stginit_<module>" in each
+   module and calls the registration functions in each of the modules it
+   imports.  So, if we call "__stginit_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,
@@ -196,8 +216,6 @@ startupHaskell(int argc, char *argv[], void *init_root)
    StgRun to call this stuff.
    -------------------------------------------------------------------------- */
 
-#ifndef INTERPRETER
-
 /* The init functions use an explicit stack... 
  */
 #define INIT_STACK_SIZE  (BLOCK_SIZE * 4)
@@ -205,21 +223,25 @@ F_ *init_stack = NULL;
 nat init_sp = 0;
 
 static void
-initModules ( void *init_root )
+initModules ( void (*init_root)(void) )
 {
-  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;
-  }
-
-  MainRegTable.rSp = (P_)(init_stack + init_sp);
-  StgRun((StgFunPtr)stg_init, NULL/* no reg table */);
-}
+#ifdef SMP
+    Capability cap;
+#else
+#define cap MainRegTable
+#endif
 
-#endif /* !INTERPRETER */
+    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_)__stginit_Prelude;
+    if (init_root != NULL) {
+	init_stack[init_sp++] = (F_)init_root;
+    }
+    
+    cap.rSp = (P_)(init_stack + init_sp);
+    StgRun((StgFunPtr)stg_init, &cap);
+}
 
 /* -----------------------------------------------------------------------------
  * Shutting down the RTS - two ways of doing this, one which
@@ -233,7 +255,12 @@ shutdownHaskellAndExit(int n)
 {
   OnExitHook();
   shutdownHaskell();
+#if defined(PAR)
+  /* really exit (stg_exit() would call shutdownParallelSystem() again) */
+  exit(n);
+#else
   stg_exit(n);
+#endif
 }
 
 void
@@ -267,6 +294,14 @@ shutdownHaskell(void)
   resetNonBlockingFd(1);
   resetNonBlockingFd(2);
 
+#if defined(PAR)
+  /* controlled exit; good thread! */
+  shutdownParallelSystem(0);
+
+  /* global statistics in parallel system */
+  PAR_TICKY_PAR_END();
+#endif
+
   /* stop timing the shutdown, we're about to print stats */
   stat_endExit();
 
@@ -275,6 +310,12 @@ shutdownHaskell(void)
    */
   exitStorage();
 
+#ifdef RTS_GTK_FRONTPANEL
+    if (RtsFlags.GcFlags.frontpanel) {
+	stopFrontPanel();
+    }
+#endif
+
 #if defined(PROFILING) || defined(DEBUG)
   endProfiling();
 #endif
@@ -288,24 +329,28 @@ shutdownHaskell(void)
 #endif
 
   rts_has_started_up=0;
-
-#if defined(PAR)
-  shutdownParallelSystem(0);
-#endif
-
 }
 
 /* 
  * called from STG-land to exit the program
  */
 
+#ifdef PAR
+static int exit_started=rtsFalse;
+#endif
+
 void  
 stg_exit(I_ n)
-{
-#if 0 /* def PAR */
-  par_exit(n);
-#else
-  exit(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, fprintf(stderr,"==-- stg_exit %d on [%x]...", n, mytid));
+  shutdownParallelSystem(n);
 #endif
+  exit(n);
 }