X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsStartup.c;h=2a288b7d009777fbea62b2bc35da6200a42e54f2;hb=9bffc64eff34148e67a28834aa6597c6027f28d3;hp=1c50c08c4a69fdc0a3ff55f248a465342462c5a7;hpb=d1a47b329fd21ab5a7db1dbe47959a874e8648e6;p=ghc-hetmet.git

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 1c50c08..2a288b7 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,12 +1,13 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.16 1999/07/03 18:39:40 sof Exp $
+ * $Id: RtsStartup.c,v 1.66 2002/08/16 13:29:06 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Main function for a standalone Haskell program.
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsAPI.h"
 #include "RtsUtils.h"
@@ -15,69 +16,108 @@
 #include "StablePriv.h" /* initStablePtrTable */
 #include "Schedule.h"   /* initScheduler */
 #include "Stats.h"      /* initStats */
+#include "Signals.h"
+#include "Itimer.h"
 #include "Weak.h"
 #include "Ticky.h"
+#include "StgRun.h"
+#include "StgStartup.h"
+#include "Prelude.h"		/* fixupRTStoPreludeRefs */
+#include "HsFFI.h"
+#include "Linker.h"
+#include "ThreadLabels.h"
+
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
 
-#if defined(PROFILING)
-# include "ProfRts.h"
-#elif defined(DEBUG)
-# include "DebugProf.h"
+#if defined(PROFILING) || defined(DEBUG)
+# include "Profiling.h"
+# include "ProfHeap.h"
+# include "RetainerProfile.h"
 #endif
 
-#ifdef PAR
-#include "ParInit.h"
-#include "Parallel.h"
-#include "LLC.h"
+#if defined(GRAN)
+# include "GranSimRts.h"
 #endif
 
+#if defined(GRAN) || defined(PAR)
+# include "ParallelRts.h"
+#endif
+
+#if defined(PAR)
+# include "Parallel.h"
+# include "LLC.h"
+#endif
+
+#include <stdlib.h>
+
 /*
  * Flag Structure
  */
 struct RTS_FLAGS RtsFlags;
 
 static int rts_has_started_up = 0;
+#if defined(PAR)
+ullong startTime = 0;
+#endif
+
+EXTFUN(__stginit_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;
+}
 
-    /* To avoid repeated initialisations of the RTS */
-   if (rts_has_started_up)
-     return;
-   else
-     rts_has_started_up=1;
+void
+getProgArgv(int *argc, char **argv[])
+{
+   *argc = prog_argc;
+   *argv = prog_argv;
+}
 
-#if defined(PAR)
-    int nPEs = 0;		    /* Number of PEs */
-#endif
+
+void
+startupHaskell(int argc, char *argv[], void (*init_root)(void))
+{
+   /* To avoid repeated initialisations of the RTS */
+  if (rts_has_started_up) {
+    /* RTS is up and running, so only run the per-module initialisation code */
+    if (init_root) {
+      initModules(init_root);
+    }
+    return;
+  } else {
+    rts_has_started_up=1;
+  }
 
     /* 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.  
- */
-    if (*argv[0] == '-') {     /* Look to see whether we're the Main Thread */
-	IAmMainThread = rtsTrue;
-        argv++; argc--;			/* Strip off flag argument */
-/*	fprintf(stderr, "I am Main Thread\n"); */
+    /*
+     * 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 */
-    SynchroniseSystem();
 #endif
 
     /* Set the RTS flags to default values. */
@@ -91,65 +131,146 @@ startupHaskell(int argc, char *argv[])
     prog_argc = argc;
     prog_argv = argv;
 
-#ifdef PAR
-   /* Initialise the parallel system -- before initHeap! */
-    initParallelSystem();
-   /* And start GranSim profiling if required: omitted for now
-    *if (Rtsflags.ParFlags.granSimStats)
-    *init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
-    */
+#if defined(PAR)
+    /* NB: this really must be done after processing the RTS flags */
+    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
+     * initStorage()).
+     */
+    initScheduler();
+
+#if defined(GRAN)
+    /* And start GranSim profiling if required: */
+    if (RtsFlags.GranFlags.GranSimStats.Full)
+      init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
+#elif defined(PAR)
+    /* And start GUM profiling if required: */
+    if (RtsFlags.ParFlags.ParStats.Full)
+      init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
+#endif	/* PAR || GRAN */
+
     /* initialize the storage manager */
     initStorage();
 
     /* initialise the stable pointer table */
     initStablePtrTable();
 
+    /* initialise thread label table (tso->char*) */
+    initThreadLabelTable();
+
 #if defined(PROFILING) || defined(DEBUG)
-    initProfiling();
+    initProfiling1();
 #endif
 
-    /* Initialise the scheduler */
-    initScheduler();
+    /* run the per-module initialisation code */
+    initModules(init_root);
+
+#if defined(PROFILING) || defined(DEBUG)
+    initProfiling2();
+#endif
+
+    /* start the virtual timer 'subsystem'. */
+    startVirtTimer(TICK_MILLISECS);
 
     /* Initialise the stats department */
     initStats();
 
-#if 0
+#if !defined(mingw32_TARGET_OS) && !defined(PAR)
+    /* Initialise the user signal handler set */
     initUserSignals();
+    /* Set up handler to run on SIGINT, etc. */
+    initDefaultHandlers();
 #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();
 }
 
-/*
+/* -----------------------------------------------------------------------------
+   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 "__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,
+   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_BLOCKS  4
+F_ *init_stack = NULL;
+
+static void
+initModules ( void (*init_root)(void) )
+{
+    bdescr *bd;
+#ifdef SMP
+    Capability cap;
+#else
+#define cap MainCapability
+#endif
+    nat init_sp;
+
+    init_sp = 0;
+    bd = allocGroup(INIT_STACK_BLOCKS);
+    init_stack = (F_ *)bd->start;
+    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.r.rSp = (P_)(init_stack + init_sp);
+    StgRun((StgFunPtr)stg_init, &cap.r);
+
+    freeGroup(bd);
+}
+
+/* -----------------------------------------------------------------------------
  * 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)
 {
+  OnExitHook();
   shutdownHaskell();
+#if defined(PAR)
+  /* really exit (stg_exit() would call shutdownParallelSystem() again) */
+  exit(n);
+#else
   stg_exit(n);
+#endif
 }
 
 void
@@ -157,46 +278,95 @@ shutdownHaskell(void)
 {
   if (!rts_has_started_up)
      return;
+  rts_has_started_up=0;
+  
+  /* start timing the shutdown */
+  stat_startExit();
+
+  /* stop all running tasks */
+  exitScheduler();
 
+#if !defined(GRAN)
   /* Finalize any remaining weak pointers */
   finalizeWeakPointersNow();
+#endif
 
 #if defined(GRAN)
-  #error FixMe.
-  if (!RTSflags.GranFlags.granSimStats_suppressed)
+  /* end_gr_simulation prints global stats if requested -- HWL */
+  if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
     end_gr_simulation();
 #endif
 
-  /* clean up things from the storage manager's point of view */
+  /* stop the ticker */
+  stopVirtTimer();
+  
+  /* reset the standard file descriptors to blocking mode */
+  resetNonBlockingFd(0);
+  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();
+
+  /* clean up things from the storage manager's point of view.
+   * also outputs the stats (+RTS -s) info.
+   */
   exitStorage();
 
+#ifdef RTS_GTK_FRONTPANEL
+    if (RtsFlags.GcFlags.frontpanel) {
+	stopFrontPanel();
+    }
+#endif
+
+#if defined(PROFILING) 
+  reportCCSProfiling();
+#endif
+
 #if defined(PROFILING) || defined(DEBUG)
   endProfiling();
 #endif
 
-#if defined(PROFILING) 
-  report_ccs_profiling( );
+#ifdef PROFILING
+  // Originally, this was in report_ccs_profiling().  Now, retainer
+  // profiling might tack some extra stuff on to the end of this file
+  // during endProfiling().
+  fclose(prof_file);
 #endif
 
 #if defined(TICKY_TICKY)
   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
-
-  rts_has_started_up=0;
 }
 
-
 /* 
- * called from STG-land to exit the program cleanly 
+ * called from STG-land to exit the program
  */
 
+#ifdef PAR
+static int exit_started=rtsFalse;
+#endif
+
 void  
 stg_exit(I_ n)
-{
+{ 
 #ifdef PAR
-  par_exit(n);
-#else
-  OnExitHook();
-  exit(n);
+  /* 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);
 }
+