ghc/rts/RtsStartup.c

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