ghc/rts/RtsStartup.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsStartup.c,v 1.38 2000/04/03 15:54:50 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   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 "Signals.h"
  19 #include "Itimer.h"
  20 #include "Weak.h"
  21 #include "Ticky.h"
  22 #include "StgRun.h"
  23 #include "StgStartup.h"
  24 #include "Prelude.h"            /* fixupRTStoPreludeRefs */
  25
  26 #if defined(PROFILING) || defined(DEBUG)
  27 # include "Profiling.h"
  28 # include "ProfHeap.h"
  29 #endif
  30
  31 #if defined(GRAN)
  32 #include "GranSimRts.h"
  33 #include "ParallelRts.h"
  34 #endif
  35
  36 #if defined(PAR)
  37 #include "ParInit.h"
  38 #include "Parallel.h"
  39 #include "LLC.h"
  40 #endif
  41
  42 /*
  43  * Flag Structure
  44  */
  45 struct RTS_FLAGS RtsFlags;
  46
  47 static int rts_has_started_up = 0;
  48 #if defined(PAR)
  49 static ullong startTime = 0;
  50 #endif
  51
  52 EXTFUN(__init_Prelude);
  53 static void initModules ( void * );
  54
  55 void
  56 startupHaskell(int argc, char *argv[], void *init_root)
  57 {
  58     /* To avoid repeated initialisations of the RTS */
  59    if (rts_has_started_up)
  60      return;
  61    else
  62      rts_has_started_up=1;
  63
  64     /* The very first thing we do is grab the start time...just in case we're
  65      * collecting timing statistics.
  66      */
  67     start_time();
  68
  69 #ifdef PAR
  70 /*
  71  * The parallel system needs to be initialised and synchronised before
  72  * the program is run.
  73  */
  74     fprintf(stderr, "startupHaskell: argv[0]=%s\n", argv[0]);
  75     if (*argv[0] == '-') {     /* Look to see whether we're the Main Thread */
  76         IAmMainThread = rtsTrue;
  77         argv++; argc--;                 /* Strip off flag argument */
  78         // IF_PAR_DEBUG(verbose,
  79                      fprintf(stderr, "[%x] I am Main Thread\n", mytid);
  80     }
  81     /*
  82      * Grab the number of PEs out of the argument vector, and
  83      * eliminate it from further argument processing.
  84      */
  85     nPEs = atoi(argv[1]);
  86     argv[1] = argv[0];
  87     argv++; argc--;
  88     initEachPEHook();                  /* HWL: hook to be execed on each PE */
  89 #endif
  90
  91     /* Set the RTS flags to default values. */
  92     initRtsFlagsDefaults();
  93
  94     /* Call the user hook to reset defaults, if present */
  95     defaultsHook();
  96
  97     /* Parse the flags, separating the RTS flags from the programs args */
  98     setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
  99     prog_argc = argc;
 100     prog_argv = argv;
 101
 102 #if defined(PAR)
 103     /* NB: this really must be done after processing the RTS flags */
 104     fprintf(stderr, "Synchronising system (%d PEs)\n", nPEs);
 105     SynchroniseSystem();             // calls initParallelSystem etc
 106 #endif  /* PAR */
 107
 108     /* initialise scheduler data structures (needs to be done before
 109      * initStorage()).
 110      */
 111     initScheduler();
 112
 113 #if defined(GRAN)
 114     /* And start GranSim profiling if required: */
 115     if (RtsFlags.GranFlags.GranSimStats.Full)
 116       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 117 #elif defined(PAR)
 118     /* And start GUM profiling if required: */
 119     if (RtsFlags.ParFlags.ParStats.Full)
 120       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 121 #endif  /* PAR || GRAN */
 122
 123     /* initialize the storage manager */
 124     initStorage();
 125
 126     /* initialise the stable pointer table */
 127     initStablePtrTable();
 128
 129 #if defined(PROFILING) || defined(DEBUG)
 130     initProfiling1();
 131 #endif
 132
 133     /* run the per-module initialisation code */
 134 #if !defined(INTERPRETER)
 135     initModules(init_root);
 136 #endif
 137
 138 #if defined(PROFILING) || defined(DEBUG)
 139     initProfiling2();
 140 #endif
 141
 142     /* start the ticker */
 143     install_vtalrm_handler();
 144     initialize_virtual_timer(TICK_MILLISECS);
 145
 146     /* start our haskell execution tasks */
 147 #ifdef SMP
 148     startTasks();
 149 #endif
 150
 151     /* Initialise the stats department */
 152     initStats();
 153
 154 #if !defined(mingw32_TARGET_OS) && !defined(PAR)
 155     /* Initialise the user signal handler set */
 156     initUserSignals();
 157     /* Set up handler to run on SIGINT, etc. */
 158     init_default_handlers();
 159 #endif
 160
 161 #if !defined(INTERPRETER)
 162     /* Initialise pointers from the RTS to the prelude.
 163        Only for compiled code -- the interpreter
 164        will call this itself later, so don't do so now.
 165     */
 166     fixupRTStoPreludeRefs(NULL);
 167 #endif
 168
 169     /* Record initialization times */
 170     end_init();
 171 }
 172
 173 /* -----------------------------------------------------------------------------
 174    Per-module initialisation
 175
 176    This process traverses all the compiled modules in the program
 177    starting with "Main", and performing per-module initialisation for
 178    each one.
 179
 180    So far, two things happen at initialisation time:
 181
 182       - we register stable names for each foreign-exported function
 183         in that module.  This prevents foreign-exported entities, and
 184         things they depend on, from being garbage collected.
 185
 186       - we supply a unique integer to each statically declared cost
 187         centre and cost centre stack in the program.
 188
 189    The code generator inserts a small function "__init_<module>" in each
 190    module and calls the registration functions in each of the modules
 191    it imports.  So, if we call "__init_PrelMain", each reachable module in the
 192    program will be registered (because PrelMain.mainIO calls Main.main).
 193
 194    The init* functions are compiled in the same way as STG code,
 195    i.e. without normal C call/return conventions.  Hence we must use
 196    StgRun to call this stuff.
 197    -------------------------------------------------------------------------- */
 198
 199 #ifndef INTERPRETER
 200
 201 /* The init functions use an explicit stack...
 202  */
 203 #define INIT_STACK_SIZE  (BLOCK_SIZE * 4)
 204 F_ *init_stack = NULL;
 205 nat init_sp = 0;
 206
 207 static void
 208 initModules ( void *init_root )
 209 {
 210   init_sp = 0;
 211   init_stack = (F_ *)allocate(INIT_STACK_SIZE / sizeof(W_));
 212   init_stack[init_sp++] = (F_)stg_init_ret;
 213   init_stack[init_sp++] = (F_)__init_Prelude;
 214   if (init_root != NULL) {
 215     init_stack[init_sp++] = (F_)init_root;
 216   }
 217
 218   MainRegTable.rSp = (P_)(init_stack + init_sp);
 219   StgRun((StgFunPtr)stg_init, NULL/* no reg table */);
 220 }
 221
 222 #endif /* !INTERPRETER */
 223
 224 /* -----------------------------------------------------------------------------
 225  * Shutting down the RTS - two ways of doing this, one which
 226  * calls exit(), one that doesn't.
 227  *
 228  * (shutdownHaskellAndExit() is called by System.exitWith).
 229  * -----------------------------------------------------------------------------
 230  */
 231 void
 232 shutdownHaskellAndExit(int n)
 233 {
 234   OnExitHook();
 235   shutdownHaskell();
 236   stg_exit(n);
 237 }
 238
 239 void
 240 shutdownHaskell(void)
 241 {
 242   if (!rts_has_started_up)
 243      return;
 244
 245   /* start timing the shutdown */
 246   stat_startExit();
 247
 248 #if !defined(GRAN)
 249   /* Finalize any remaining weak pointers */
 250   finalizeWeakPointersNow();
 251 #endif
 252
 253 #if defined(GRAN)
 254   /* end_gr_simulation prints global stats if requested -- HWL */
 255   if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
 256     end_gr_simulation();
 257 #endif
 258
 259   /* stop all running tasks */
 260   exitScheduler();
 261
 262   /* stop the ticker */
 263   initialize_virtual_timer(0);
 264
 265   /* reset the standard file descriptors to blocking mode */
 266   resetNonBlockingFd(0);
 267   resetNonBlockingFd(1);
 268   resetNonBlockingFd(2);
 269
 270 #if defined(PAR)
 271   shutdownParallelSystem(0);
 272 #endif
 273
 274   /* stop timing the shutdown, we're about to print stats */
 275   stat_endExit();
 276
 277   /* clean up things from the storage manager's point of view.
 278    * also outputs the stats (+RTS -s) info.
 279    */
 280   exitStorage();
 281
 282 #if defined(PROFILING) || defined(DEBUG)
 283   endProfiling();
 284 #endif
 285
 286 #if defined(PROFILING)
 287   report_ccs_profiling();
 288 #endif
 289
 290 #if defined(TICKY_TICKY)
 291   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 292 #endif
 293
 294   rts_has_started_up=0;
 295
 296 }
 297
 298 /*
 299  * called from STG-land to exit the program
 300  */
 301
 302 void
 303 stg_exit(I_ n)
 304 {
 305 #if 0 /* def PAR */
 306   par_exit(n);
 307 #else
 308   exit(n);
 309 #endif
 310 }
 311