ghc/rts/RtsStartup.c

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