ghc/rts/RtsStartup.c

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