ghc/rts/RtsStartup.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsStartup.c,v 1.75 2003/08/22 22:24:15 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-2002
   5  *
   6  * Main function for a standalone Haskell program.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "PosixSource.h"
  11 #include "Rts.h"
  12 #include "RtsAPI.h"
  13 #include "RtsUtils.h"
  14 #include "RtsFlags.h"
  15 #include "Storage.h"    /* initStorage, exitStorage */
  16 #include "StablePriv.h" /* initStablePtrTable */
  17 #include "Schedule.h"   /* initScheduler */
  18 #include "Stats.h"      /* initStats */
  19 #include "Signals.h"
  20 #include "Timer.h"      /* startTimer, stopTimer */
  21 #include "Weak.h"
  22 #include "Ticky.h"
  23 #include "StgRun.h"
  24 #include "StgStartup.h"
  25 #include "Prelude.h"            /* fixupRTStoPreludeRefs */
  26 #include "HsFFI.h"
  27 #include "Linker.h"
  28 #include "ThreadLabels.h"
  29
  30 #if defined(RTS_GTK_FRONTPANEL)
  31 #include "FrontPanel.h"
  32 #endif
  33
  34 #if defined(PROFILING) || defined(DEBUG)
  35 # include "Profiling.h"
  36 # include "ProfHeap.h"
  37 # include "RetainerProfile.h"
  38 #endif
  39
  40 #if defined(GRAN)
  41 # include "GranSimRts.h"
  42 #endif
  43
  44 #if defined(GRAN) || defined(PAR)
  45 # include "ParallelRts.h"
  46 #endif
  47
  48 #if defined(PAR)
  49 # include "Parallel.h"
  50 # include "LLC.h"
  51 #endif
  52
  53 #if defined(mingw32_TARGET_OS)
  54 #include "win32/AsyncIO.h"
  55 #endif
  56
  57 #include <stdlib.h>
  58
  59 #ifdef HAVE_LOCALE_H
  60 #include <locale.h>
  61 #endif
  62
  63 // Flag Structure
  64 struct RTS_FLAGS RtsFlags;
  65
  66 // Count of how many outstanding hs_init()s there have been.
  67 static int hs_init_count = 0;
  68
  69 /* -----------------------------------------------------------------------------
  70    Starting up the RTS
  71    -------------------------------------------------------------------------- */
  72
  73 void
  74 hs_init(int *argc, char **argv[])
  75 {
  76     hs_init_count++;
  77     if (hs_init_count > 1) {
  78         // second and subsequent inits are ignored
  79         return;
  80     }
  81
  82     /* The very first thing we do is grab the start time...just in case we're
  83      * collecting timing statistics.
  84      */
  85     stat_startInit();
  86
  87 #ifdef PAR
  88     /*
  89      * The parallel system needs to be initialised and synchronised before
  90      * the program is run.
  91      */
  92     startupParallelSystem(argv);
  93
  94     if (*argv[0] == '-') { /* Strip off mainPE flag argument */
  95       argv++;
  96       argc--;
  97     }
  98
  99     argv[1] = argv[0];   /* ignore the nPEs argument */
 100     argv++; argc--;
 101 #endif
 102
 103     /* Set the RTS flags to default values. */
 104     initRtsFlagsDefaults();
 105
 106     /* Call the user hook to reset defaults, if present */
 107     defaultsHook();
 108
 109     /* Parse the flags, separating the RTS flags from the programs args */
 110     if (argc != NULL && argv != NULL) {
 111         setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
 112         prog_argc = *argc;
 113         prog_argv = *argv;
 114     }
 115
 116 #if defined(PAR)
 117     /* NB: this really must be done after processing the RTS flags */
 118     IF_PAR_DEBUG(verbose,
 119                  fprintf(stderr, "==== Synchronising system (%d PEs)\n", nPEs));
 120     synchroniseSystem();             // calls initParallelSystem etc
 121 #endif  /* PAR */
 122
 123     /* initialise scheduler data structures (needs to be done before
 124      * initStorage()).
 125      */
 126     initScheduler();
 127
 128 #if defined(GRAN)
 129     /* And start GranSim profiling if required: */
 130     if (RtsFlags.GranFlags.GranSimStats.Full)
 131       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 132 #elif defined(PAR)
 133     /* And start GUM profiling if required: */
 134     if (RtsFlags.ParFlags.ParStats.Full)
 135       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 136 #endif  /* PAR || GRAN */
 137
 138     /* initialize the storage manager */
 139     initStorage();
 140
 141     /* initialise the stable pointer table */
 142     initStablePtrTable();
 143
 144     /* initialise thread label table (tso->char*) */
 145     initThreadLabelTable();
 146
 147 #if defined(PROFILING) || defined(DEBUG)
 148     initProfiling1();
 149 #endif
 150
 151     /* start the virtual timer 'subsystem'. */
 152     startTimer(TICK_MILLISECS);
 153
 154     /* Initialise the stats department */
 155     initStats();
 156
 157 #if defined(RTS_USER_SIGNALS)
 158     /* Initialise the user signal handler set */
 159     initUserSignals();
 160     /* Set up handler to run on SIGINT, etc. */
 161     initDefaultHandlers();
 162 #endif
 163
 164 #if defined(mingw32_TARGET_OS)
 165     startupAsyncIO();
 166 #endif
 167
 168 #ifdef RTS_GTK_FRONTPANEL
 169     if (RtsFlags.GcFlags.frontpanel) {
 170         initFrontPanel();
 171     }
 172 #endif
 173
 174 #ifdef HAVE_LOCALE_H
 175     setlocale(LC_ALL,"");
 176 #endif
 177
 178     /* Record initialization times */
 179     stat_endInit();
 180 }
 181
 182 // Compatibility interface
 183 void
 184 startupHaskell(int argc, char *argv[], void (*init_root)(void))
 185 {
 186     hs_init(&argc, &argv);
 187     hs_add_root(init_root);
 188 }
 189
 190
 191 /* -----------------------------------------------------------------------------
 192    Getting/Setting the program's arguments.
 193
 194    These are used by System.Environment.
 195    -------------------------------------------------------------------------- */
 196
 197 void
 198 getProgArgv(int *argc, char **argv[])
 199 {
 200     if (argc) { *argc = prog_argc; }
 201     if (argv) { *argv = prog_argv; }
 202 }
 203
 204 void
 205 setProgArgv(int argc, char *argv[])
 206 {
 207    /* Usually this is done by startupHaskell, so we don't need to call this.
 208       However, sometimes Hugs wants to change the arguments which Haskell
 209       getArgs >>= ... will be fed.  So you can do that by calling here
 210       _after_ calling startupHaskell.
 211    */
 212    prog_argc = argc;
 213    prog_argv = argv;
 214 }
 215
 216 /* -----------------------------------------------------------------------------
 217    Per-module initialisation
 218
 219    This process traverses all the compiled modules in the program
 220    starting with "Main", and performing per-module initialisation for
 221    each one.
 222
 223    So far, two things happen at initialisation time:
 224
 225       - we register stable names for each foreign-exported function
 226         in that module.  This prevents foreign-exported entities, and
 227         things they depend on, from being garbage collected.
 228
 229       - we supply a unique integer to each statically declared cost
 230         centre and cost centre stack in the program.
 231
 232    The code generator inserts a small function "__stginit_<module>" in each
 233    module and calls the registration functions in each of the modules it
 234    imports.
 235
 236    The init* functions are compiled in the same way as STG code,
 237    i.e. without normal C call/return conventions.  Hence we must use
 238    StgRun to call this stuff.
 239    -------------------------------------------------------------------------- */
 240
 241 /* The init functions use an explicit stack...
 242  */
 243 #define INIT_STACK_BLOCKS  4
 244 static F_ *init_stack = NULL;
 245
 246 void
 247 hs_add_root(void (*init_root)(void))
 248 {
 249     bdescr *bd;
 250 #ifdef SMP
 251     Capability cap;
 252 #else
 253 #define cap MainCapability
 254 #endif
 255     nat init_sp;
 256
 257     if (hs_init_count <= 0) {
 258         barf("hs_add_root() must be called after hs_init()");
 259     }
 260
 261     init_sp = 0;
 262     bd = allocGroup(INIT_STACK_BLOCKS);
 263     init_stack = (F_ *)bd->start;
 264     init_stack[init_sp++] = (F_)stg_init_ret;
 265     if (init_root != NULL) {
 266         init_stack[init_sp++] = (F_)init_root;
 267     }
 268
 269     cap.r.rSp = (P_)(init_stack + init_sp);
 270     StgRun((StgFunPtr)stg_init, &cap.r);
 271
 272     freeGroup(bd);
 273
 274 #if defined(PROFILING) || defined(DEBUG)
 275     // This must be done after module initialisation.
 276     // ToDo: make this work in the presence of multiple hs_add_root()s.
 277     initProfiling2();
 278 #endif
 279 }
 280
 281 /* -----------------------------------------------------------------------------
 282    Shutting down the RTS
 283    -------------------------------------------------------------------------- */
 284
 285 void
 286 hs_exit(void)
 287 {
 288     if (hs_init_count <= 0) {
 289         barf("too many hs_exit()s");
 290     }
 291     hs_init_count--;
 292     if (hs_init_count > 0) {
 293         // ignore until it's the last one
 294         return;
 295     }
 296
 297     /* start timing the shutdown */
 298     stat_startExit();
 299
 300     /* stop all running tasks */
 301     exitScheduler();
 302
 303 #if !defined(GRAN)
 304     /* Finalize any remaining weak pointers */
 305     finalizeWeakPointersNow();
 306 #endif
 307
 308 #if defined(GRAN)
 309     /* end_gr_simulation prints global stats if requested -- HWL */
 310     if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
 311         end_gr_simulation();
 312 #endif
 313
 314     /* stop the ticker */
 315     stopTimer();
 316
 317     /* reset the standard file descriptors to blocking mode */
 318     resetNonBlockingFd(0);
 319     resetNonBlockingFd(1);
 320     resetNonBlockingFd(2);
 321
 322 #if defined(PAR)
 323     /* controlled exit; good thread! */
 324     shutdownParallelSystem(0);
 325
 326     /* global statistics in parallel system */
 327     PAR_TICKY_PAR_END();
 328 #endif
 329
 330     /* stop timing the shutdown, we're about to print stats */
 331     stat_endExit();
 332
 333     /* clean up things from the storage manager's point of view.
 334      * also outputs the stats (+RTS -s) info.
 335      */
 336     exitStorage();
 337
 338 #ifdef RTS_GTK_FRONTPANEL
 339     if (RtsFlags.GcFlags.frontpanel) {
 340         stopFrontPanel();
 341     }
 342 #endif
 343
 344 #if defined(PROFILING)
 345     reportCCSProfiling();
 346 #endif
 347
 348 #if defined(PROFILING) || defined(DEBUG)
 349     endProfiling();
 350 #endif
 351
 352 #ifdef PROFILING
 353     // Originally, this was in report_ccs_profiling().  Now, retainer
 354     // profiling might tack some extra stuff on to the end of this file
 355     // during endProfiling().
 356     fclose(prof_file);
 357 #endif
 358
 359 #if defined(TICKY_TICKY)
 360     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 361 #endif
 362
 363 #if defined(mingw32_TARGET_OS)
 364     shutdownAsyncIO();
 365 #endif
 366 }
 367
 368 // Compatibility interfaces
 369 void
 370 shutdownHaskell(void)
 371 {
 372     hs_exit();
 373 }
 374
 375 void
 376 shutdownHaskellAndExit(int n)
 377 {
 378     if (hs_init_count == 1) {
 379         OnExitHook();
 380         hs_exit();
 381 #if defined(PAR)
 382         /* really exit (stg_exit() would call shutdownParallelSystem() again) */
 383         exit(n);
 384 #else
 385         stg_exit(n);
 386 #endif
 387     }
 388 }
 389
 390 /*
 391  * called from STG-land to exit the program
 392  */
 393
 394 #ifdef PAR
 395 static int exit_started=rtsFalse;
 396 #endif
 397
 398 void
 399 stg_exit(int n)
 400 {
 401 #ifdef PAR
 402   /* HACK: avoid a loop when exiting due to a stupid error */
 403   if (exit_started)
 404     return;
 405   exit_started=rtsTrue;
 406
 407   IF_PAR_DEBUG(verbose, fprintf(stderr,"==-- stg_exit %d on [%x]...", n, mytid));
 408   shutdownParallelSystem(n);
 409 #endif
 410   exit(n);
 411 }
 412