ghc/rts/RtsStartup.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsStartup.c,v 1.13 1999/05/21 14:28:32 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Main function for a standalone Haskell program.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsAPI.h"
  12 #include "RtsUtils.h"
  13 #include "RtsFlags.h"
  14 #include "Storage.h"    /* initStorage, exitStorage */
  15 #include "StablePriv.h" /* initStablePtrTable */
  16 #include "Schedule.h"   /* initScheduler */
  17 #include "Stats.h"      /* initStats */
  18 #include "Weak.h"
  19 #include "Ticky.h"
  20
  21 #if defined(PROFILING)
  22 # include "ProfRts.h"
  23 #elif defined(DEBUG)
  24 # include "DebugProf.h"
  25 #endif
  26
  27 #ifdef PAR
  28 #include "ParInit.h"
  29 #include "Parallel.h"
  30 #include "LLC.h"
  31 #endif
  32
  33 /*
  34  * Flag Structure
  35  */
  36 struct RTS_FLAGS RtsFlags;
  37
  38 static int rts_has_started_up = 0;
  39
  40 void
  41 startupHaskell(int argc, char *argv[])
  42 {
  43     int i;
  44
  45     /* To avoid repeated initialisations of the RTS */
  46    if (rts_has_started_up)
  47      return;
  48    else
  49      rts_has_started_up=1;
  50
  51 #if defined(PAR)
  52     int nPEs = 0;                   /* Number of PEs */
  53 #endif
  54
  55     /* The very first thing we do is grab the start time...just in case we're
  56      * collecting timing statistics.
  57      */
  58     start_time();
  59
  60 #ifdef PAR
  61 /*
  62  *The parallel system needs to be initialised and synchronised before
  63  *the program is run.
  64  */
  65     if (*argv[0] == '-') {     /* Look to see whether we're the Main Thread */
  66         IAmMainThread = rtsTrue;
  67         argv++; argc--;                 /* Strip off flag argument */
  68 /*      fprintf(stderr, "I am Main Thread\n"); */
  69     }
  70     /*
  71      * Grab the number of PEs out of the argument vector, and
  72      * eliminate it from further argument processing.
  73      */
  74     nPEs = atoi(argv[1]);
  75     argv[1] = argv[0];
  76     argv++; argc--;
  77     initEachPEHook();                  /* HWL: hook to be execed on each PE */
  78     SynchroniseSystem();
  79 #endif
  80
  81     /* Set the RTS flags to default values. */
  82     initRtsFlagsDefaults();
  83
  84     /* Call the user hook to reset defaults, if present */
  85     defaultsHook();
  86
  87     /* Parse the flags, separating the RTS flags from the programs args */
  88     setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
  89     prog_argc = argc;
  90     prog_argv = argv;
  91
  92 #ifdef PAR
  93    /* Initialise the parallel system -- before initHeap! */
  94     initParallelSystem();
  95    /* And start GranSim profiling if required: omitted for now
  96     *if (Rtsflags.ParFlags.granSimStats)
  97     *init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
  98     */
  99 #endif  /* PAR */
 100
 101     /* initialize the storage manager */
 102     initStorage();
 103
 104     /* initialise the stable pointer table */
 105     initStablePtrTable();
 106
 107 #if defined(PROFILING) || defined(DEBUG)
 108     initProfiling();
 109 #endif
 110
 111     /* Initialise the scheduler */
 112     initScheduler();
 113
 114     /* Initialise the stats department */
 115     initStats();
 116
 117 #if 0
 118     initUserSignals();
 119 #endif
 120
 121     /* When the RTS and Prelude live in separate DLLs,
 122        we need to patch up the char- and int-like tables
 123        that the RTS keep after both DLLs have been loaded,
 124        filling in the tables with references to where the
 125        static info tables have been loaded inside the running
 126        process.
 127     */
 128 #ifdef ENABLE_WIN32_DLL_SUPPORT
 129     for(i=0;i<=255;i++)
 130        (CHARLIKE_closure[i]).header.info = (const StgInfoTable*)&Czh_static_info;
 131
 132     for(i=0;i<=32;i++)
 133        (INTLIKE_closure[i]).header.info = (const StgInfoTable*)&Izh_static_info;
 134
 135 #endif
 136     /* Record initialization times */
 137     end_init();
 138 }
 139
 140 void
 141 shutdownHaskell(void)
 142 {
 143   if (!rts_has_started_up)
 144      return;
 145
 146   /* Finalize any remaining weak pointers */
 147   finalizeWeakPointersNow();
 148
 149 #if defined(GRAN)
 150   #error FixMe.
 151   if (!RTSflags.GranFlags.granSimStats_suppressed)
 152     end_gr_simulation();
 153 #endif
 154
 155   /* clean up things from the storage manager's point of view */
 156   exitStorage();
 157
 158 #if defined(PROFILING) || defined(DEBUG)
 159   endProfiling();
 160 #endif
 161
 162 #if defined(PROFILING)
 163   report_ccs_profiling( );
 164 #endif
 165
 166 #if defined(TICKY_TICKY)
 167   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 168 #endif
 169
 170   /*
 171     This fflush is important, because: if "main" just returns,
 172     then we will end up in pre-supplied exit code that will close
 173     streams and flush buffers.  In particular we have seen: it
 174     will close fd 0 (stdin), then flush fd 1 (stdout), then <who
 175     cares>...
 176
 177     But if you're playing with sockets, that "close fd 0" might
 178     suggest to the daemon that all is over, only to be presented
 179     with more stuff on "fd 1" at the flush.
 180
 181     The fflush avoids this sad possibility.
 182    */
 183   fflush(stdout);
 184
 185   rts_has_started_up=0;
 186 }
 187
 188
 189 /*
 190  * called from STG-land to exit the program cleanly
 191  */
 192
 193 void
 194 stg_exit(I_ n)
 195 {
 196 #ifdef PAR
 197   par_exit(n);
 198 #else
 199   OnExitHook();
 200   exit(n);
 201 #endif
 202 }