rts/RtsStartup.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2002
   4  *
   5  * Main function for a standalone Haskell program.
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 // PAPI uses caddr_t, which is not POSIX
  10 // #include "PosixSource.h"
  11
  12 #include "Rts.h"
  13 #include "RtsAPI.h"
  14 #include "RtsUtils.h"
  15 #include "RtsFlags.h"
  16 #include "OSThreads.h"
  17 #include "Schedule.h"   /* initScheduler */
  18 #include "Stats.h"      /* initStats */
  19 #include "STM.h"        /* initSTM */
  20 #include "Signals.h"
  21 #include "RtsSignals.h"
  22 #include "ThrIOManager.h"
  23 #include "Timer.h"      /* startTimer, stopTimer */
  24 #include "Weak.h"
  25 #include "Ticky.h"
  26 #include "StgRun.h"
  27 #include "Prelude.h"            /* fixupRTStoPreludeRefs */
  28 #include "HsFFI.h"
  29 #include "Linker.h"
  30 #include "ThreadLabels.h"
  31 #include "BlockAlloc.h"
  32 #include "Trace.h"
  33 #include "RtsGlobals.h"
  34 #include "Stable.h"
  35 #include "Hpc.h"
  36 #include "FileLock.h"
  37 #include "EventLog.h"
  38
  39 #if defined(RTS_GTK_FRONTPANEL)
  40 #include "FrontPanel.h"
  41 #endif
  42
  43 # include "Profiling.h"
  44
  45 #if defined(PROFILING)
  46 # include "ProfHeap.h"
  47 # include "RetainerProfile.h"
  48 #endif
  49
  50 #if defined(GRAN)
  51 # include "GranSimRts.h"
  52 #endif
  53
  54 #if defined(GRAN) || defined(PAR)
  55 # include "ParallelRts.h"
  56 #endif
  57
  58 #if defined(PAR)
  59 # include "Parallel.h"
  60 # include "LLC.h"
  61 #endif
  62
  63 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
  64 #include "win32/AsyncIO.h"
  65 #endif
  66
  67 #include <stdlib.h>
  68
  69 #ifdef HAVE_TERMIOS_H
  70 #include <termios.h>
  71 #endif
  72 #ifdef HAVE_SIGNAL_H
  73 #include <signal.h>
  74 #endif
  75 #ifdef HAVE_UNISTD_H
  76 #include <unistd.h>
  77 #endif
  78
  79 #if USE_PAPI
  80 #include "Papi.h"
  81 #endif
  82
  83 // Count of how many outstanding hs_init()s there have been.
  84 static int hs_init_count = 0;
  85
  86 // Here we save the terminal settings on the standard file
  87 // descriptors, if we need to change them (eg. to support NoBuffering
  88 // input).
  89 static void *saved_termios[3] = {NULL,NULL,NULL};
  90
  91 void*
  92 __hscore_get_saved_termios(int fd)
  93 {
  94   return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
  95     saved_termios[fd] : NULL;
  96 }
  97
  98 void
  99 __hscore_set_saved_termios(int fd, void* ts)
 100 {
 101   if (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) {
 102     saved_termios[fd] = ts;
 103   }
 104 }
 105
 106 /* -----------------------------------------------------------------------------
 107    Initialise floating point unit on x86 (currently disabled. why?)
 108    (see comment in ghc/compiler/nativeGen/MachInstrs.lhs).
 109    -------------------------------------------------------------------------- */
 110
 111 #define X86_INIT_FPU 0
 112
 113 #if X86_INIT_FPU
 114 static void
 115 x86_init_fpu ( void )
 116 {
 117   __volatile unsigned short int fpu_cw;
 118
 119   // Grab the control word
 120   __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
 121
 122 #if 0
 123   printf("fpu_cw: %x\n", fpu_cw);
 124 #endif
 125
 126   // Set bits 8-9 to 10 (64-bit precision).
 127   fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
 128
 129   // Store the new control word back
 130   __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
 131 }
 132 #endif
 133
 134 /* -----------------------------------------------------------------------------
 135    Starting up the RTS
 136    -------------------------------------------------------------------------- */
 137
 138 void
 139 hs_init(int *argc, char **argv[])
 140 {
 141     hs_init_count++;
 142     if (hs_init_count > 1) {
 143         // second and subsequent inits are ignored
 144         return;
 145     }
 146
 147     /* Initialise the stats department, phase 0 */
 148     initStats0();
 149
 150     /* Next we do is grab the start time...just in case we're
 151      * collecting timing statistics.
 152      */
 153     stat_startInit();
 154
 155 #if defined(DEBUG)
 156     /* Start off by initialising the allocator debugging so we can
 157      * use it anywhere */
 158     initAllocator();
 159 #endif
 160
 161 #ifdef PAR
 162     /*
 163      * The parallel system needs to be initialised and synchronised before
 164      * the program is run.
 165      */
 166     startupParallelSystem(argv);
 167
 168     if (*argv[0] == '-') { /* Strip off mainPE flag argument */
 169       argv++;
 170       argc--;
 171     }
 172
 173     argv[1] = argv[0];   /* ignore the nPEs argument */
 174     argv++; argc--;
 175 #endif
 176
 177     /* Set the RTS flags to default values. */
 178
 179     initRtsFlagsDefaults();
 180
 181     /* Call the user hook to reset defaults, if present */
 182     defaultsHook();
 183
 184     /* Parse the flags, separating the RTS flags from the programs args */
 185     if (argc != NULL && argv != NULL) {
 186         setFullProgArgv(*argc,*argv);
 187         setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
 188         setProgArgv(*argc,*argv);
 189     }
 190
 191     /* Initialise the stats department, phase 1 */
 192     initStats1();
 193
 194 #ifdef USE_PAPI
 195     papi_init();
 196 #endif
 197
 198     /* initTracing must be after setupRtsFlags() */
 199 #ifdef DEBUG
 200     initTracing();
 201 #endif
 202
 203 #if defined(PAR)
 204     /* NB: this really must be done after processing the RTS flags */
 205     IF_PAR_DEBUG(verbose,
 206                  debugBelch("==== Synchronising system (%d PEs)\n", nPEs));
 207     synchroniseSystem();             // calls initParallelSystem etc
 208 #endif  /* PAR */
 209
 210     /* initialise scheduler data structures (needs to be done before
 211      * initStorage()).
 212      */
 213     initScheduler();
 214
 215 #if defined(GRAN)
 216     /* And start GranSim profiling if required: */
 217     if (RtsFlags.GranFlags.GranSimStats.Full)
 218       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 219 #elif defined(PAR)
 220     /* And start GUM profiling if required: */
 221     if (RtsFlags.ParFlags.ParStats.Full)
 222       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
 223 #endif  /* PAR || GRAN */
 224
 225     /* initialize the storage manager */
 226     initStorage();
 227
 228     /* initialise the stable pointer table */
 229     initStablePtrTable();
 230
 231     /* Add some GC roots for things in the base package that the RTS
 232      * knows about.  We don't know whether these turn out to be CAFs
 233      * or refer to CAFs, but we have to assume that they might.
 234      */
 235     getStablePtr((StgPtr)base_GHCziTopHandler_runIO_closure);
 236     getStablePtr((StgPtr)base_GHCziTopHandler_runNonIO_closure);
 237     getStablePtr((StgPtr)stackOverflow_closure);
 238     getStablePtr((StgPtr)heapOverflow_closure);
 239     getStablePtr((StgPtr)runFinalizerBatch_closure);
 240     getStablePtr((StgPtr)unpackCString_closure);
 241     getStablePtr((StgPtr)blockedOnDeadMVar_closure);
 242     getStablePtr((StgPtr)nonTermination_closure);
 243     getStablePtr((StgPtr)blockedIndefinitely_closure);
 244
 245     /* initialise the shared Typeable store */
 246     initGlobalStore();
 247
 248     /* initialise file locking, if necessary */
 249 #if !defined(mingw32_HOST_OS)
 250     initFileLocking();
 251 #endif
 252
 253 #if defined(DEBUG)
 254     /* initialise thread label table (tso->char*) */
 255     initThreadLabelTable();
 256 #endif
 257
 258     initProfiling1();
 259
 260 #ifdef EVENTLOG
 261     if (RtsFlags.EventLogFlags.doEventLogging) {
 262         initEventLogging();
 263     }
 264 #endif
 265
 266     /* start the virtual timer 'subsystem'. */
 267     initTimer();
 268     startTimer();
 269
 270 #if defined(RTS_USER_SIGNALS)
 271     if (RtsFlags.MiscFlags.install_signal_handlers) {
 272         /* Initialise the user signal handler set */
 273         initUserSignals();
 274         /* Set up handler to run on SIGINT, etc. */
 275         initDefaultHandlers();
 276     }
 277 #endif
 278
 279 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
 280     startupAsyncIO();
 281 #endif
 282
 283 #ifdef RTS_GTK_FRONTPANEL
 284     if (RtsFlags.GcFlags.frontpanel) {
 285         initFrontPanel();
 286     }
 287 #endif
 288
 289 #if X86_INIT_FPU
 290     x86_init_fpu();
 291 #endif
 292
 293     /* Record initialization times */
 294     stat_endInit();
 295 }
 296
 297 // Compatibility interface
 298 void
 299 startupHaskell(int argc, char *argv[], void (*init_root)(void))
 300 {
 301     hs_init(&argc, &argv);
 302     if(init_root)
 303         hs_add_root(init_root);
 304 }
 305
 306
 307 /* -----------------------------------------------------------------------------
 308    Per-module initialisation
 309
 310    This process traverses all the compiled modules in the program
 311    starting with "Main", and performing per-module initialisation for
 312    each one.
 313
 314    So far, two things happen at initialisation time:
 315
 316       - we register stable names for each foreign-exported function
 317         in that module.  This prevents foreign-exported entities, and
 318         things they depend on, from being garbage collected.
 319
 320       - we supply a unique integer to each statically declared cost
 321         centre and cost centre stack in the program.
 322
 323    The code generator inserts a small function "__stginit_<module>" in each
 324    module and calls the registration functions in each of the modules it
 325    imports.
 326
 327    The init* functions are compiled in the same way as STG code,
 328    i.e. without normal C call/return conventions.  Hence we must use
 329    StgRun to call this stuff.
 330    -------------------------------------------------------------------------- */
 331
 332 /* The init functions use an explicit stack...
 333  */
 334 #define INIT_STACK_BLOCKS  4
 335 static F_ *init_stack = NULL;
 336
 337 void
 338 hs_add_root(void (*init_root)(void))
 339 {
 340     bdescr *bd;
 341     nat init_sp;
 342     Capability *cap;
 343
 344     cap = rts_lock();
 345
 346     if (hs_init_count <= 0) {
 347         barf("hs_add_root() must be called after hs_init()");
 348     }
 349
 350     /* The initialisation stack grows downward, with sp pointing
 351        to the last occupied word */
 352     init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
 353     bd = allocGroup_lock(INIT_STACK_BLOCKS);
 354     init_stack = (F_ *)bd->start;
 355     init_stack[--init_sp] = (F_)stg_init_finish;
 356     if (init_root != NULL) {
 357         init_stack[--init_sp] = (F_)init_root;
 358     }
 359
 360     cap->r.rSp = (P_)(init_stack + init_sp);
 361     StgRun((StgFunPtr)stg_init, &cap->r);
 362
 363     freeGroup_lock(bd);
 364
 365     startupHpc();
 366
 367     // This must be done after module initialisation.
 368     // ToDo: make this work in the presence of multiple hs_add_root()s.
 369     initProfiling2();
 370
 371     rts_unlock(cap);
 372
 373     // ditto.
 374 #if defined(THREADED_RTS)
 375     ioManagerStart();
 376 #endif
 377 }
 378
 379 /* ----------------------------------------------------------------------------
 380  * Shutting down the RTS
 381  *
 382  * The wait_foreign parameter means:
 383  *       True  ==> wait for any threads doing foreign calls now.
 384  *       False ==> threads doing foreign calls may return in the
 385  *                 future, but will immediately block on a mutex.
 386  *                 (capability->lock).
 387  *
 388  * If this RTS is a DLL that we're about to unload, then you want
 389  * safe=True, otherwise the thread might return to code that has been
 390  * unloaded.  If this is a standalone program that is about to exit,
 391  * then you can get away with safe=False, which is better because we
 392  * won't hang on exit if there is a blocked foreign call outstanding.
 393  *
 394  ------------------------------------------------------------------------- */
 395
 396 static void
 397 hs_exit_(rtsBool wait_foreign)
 398 {
 399     if (hs_init_count <= 0) {
 400         errorBelch("warning: too many hs_exit()s");
 401         return;
 402     }
 403     hs_init_count--;
 404     if (hs_init_count > 0) {
 405         // ignore until it's the last one
 406         return;
 407     }
 408
 409     /* start timing the shutdown */
 410     stat_startExit();
 411
 412     OnExitHook();
 413
 414 #if defined(THREADED_RTS)
 415     ioManagerDie();
 416 #endif
 417
 418     /* stop all running tasks */
 419     exitScheduler(wait_foreign);
 420
 421     /* run C finalizers for all active weak pointers */
 422     runAllCFinalizers(weak_ptr_list);
 423
 424 #if defined(RTS_USER_SIGNALS)
 425     if (RtsFlags.MiscFlags.install_signal_handlers) {
 426         freeSignalHandlers();
 427     }
 428 #endif
 429
 430 #if defined(GRAN)
 431     /* end_gr_simulation prints global stats if requested -- HWL */
 432     if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
 433         end_gr_simulation();
 434 #endif
 435
 436     /* stop the ticker */
 437     stopTimer();
 438     exitTimer();
 439
 440     /* reset the standard file descriptors to blocking mode */
 441     resetNonBlockingFd(0);
 442     resetNonBlockingFd(1);
 443     resetNonBlockingFd(2);
 444
 445 #if HAVE_TERMIOS_H
 446     // Reset the terminal settings on the standard file descriptors,
 447     // if we changed them.  See System.Posix.Internals.tcSetAttr for
 448     // more details, including the reason we termporarily disable
 449     // SIGTTOU here.
 450     {
 451         int fd;
 452         sigset_t sigset, old_sigset;
 453         sigemptyset(&sigset);
 454         sigaddset(&sigset, SIGTTOU);
 455         sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
 456         for (fd = 0; fd <= 2; fd++) {
 457             struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd);
 458             if (ts != NULL) {
 459                 tcsetattr(fd,TCSANOW,ts);
 460             }
 461         }
 462         sigprocmask(SIG_SETMASK, &old_sigset, NULL);
 463     }
 464 #endif
 465
 466 #if defined(PAR)
 467     /* controlled exit; good thread! */
 468     shutdownParallelSystem(0);
 469
 470     /* global statistics in parallel system */
 471     PAR_TICKY_PAR_END();
 472 #endif
 473
 474     // uninstall signal handlers
 475     resetDefaultHandlers();
 476
 477     /* stop timing the shutdown, we're about to print stats */
 478     stat_endExit();
 479
 480     /* shutdown the hpc support (if needed) */
 481     exitHpc();
 482
 483     // clean up things from the storage manager's point of view.
 484     // also outputs the stats (+RTS -s) info.
 485     exitStorage();
 486
 487     /* free the tasks */
 488     freeScheduler();
 489
 490     /* free shared Typeable store */
 491     exitGlobalStore();
 492
 493     /* free file locking tables, if necessary */
 494 #if !defined(mingw32_HOST_OS)
 495     freeFileLocking();
 496 #endif
 497
 498     /* free the stable pointer table */
 499     exitStablePtrTable();
 500
 501 #if defined(DEBUG)
 502     /* free the thread label table */
 503     freeThreadLabelTable();
 504 #endif
 505
 506 #ifdef RTS_GTK_FRONTPANEL
 507     if (RtsFlags.GcFlags.frontpanel) {
 508         stopFrontPanel();
 509     }
 510 #endif
 511
 512 #if defined(PROFILING)
 513     reportCCSProfiling();
 514 #endif
 515
 516     endProfiling();
 517     freeProfiling1();
 518
 519 #ifdef PROFILING
 520     // Originally, this was in report_ccs_profiling().  Now, retainer
 521     // profiling might tack some extra stuff on to the end of this file
 522     // during endProfiling().
 523     if (prof_file != NULL) fclose(prof_file);
 524 #endif
 525
 526 #ifdef EVENTLOG
 527     if (RtsFlags.EventLogFlags.doEventLogging) {
 528         endEventLogging();
 529         freeEventLogging();
 530     }
 531 #endif
 532
 533 #if defined(TICKY_TICKY)
 534     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 535 #endif
 536
 537 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
 538     shutdownAsyncIO(wait_foreign);
 539 #endif
 540
 541     /* free hash table storage */
 542     exitHashTable();
 543
 544     // Finally, free all our storage
 545     freeStorage();
 546
 547 #if defined(DEBUG)
 548     /* and shut down the allocator debugging */
 549     shutdownAllocator();
 550 #endif
 551
 552 }
 553
 554 // The real hs_exit():
 555 void
 556 hs_exit(void)
 557 {
 558     hs_exit_(rtsTrue);
 559     // be safe; this might be a DLL
 560 }
 561
 562 // Compatibility interfaces
 563 void
 564 shutdownHaskell(void)
 565 {
 566     hs_exit();
 567 }
 568
 569 void
 570 shutdownHaskellAndExit(int n)
 571 {
 572     // we're about to exit(), no need to wait for foreign calls to return.
 573     hs_exit_(rtsFalse);
 574
 575     if (hs_init_count == 0) {
 576 #if defined(PAR)
 577         /* really exit (stg_exit() would call shutdownParallelSystem() again) */
 578         exit(n);
 579 #else
 580         stg_exit(n);
 581 #endif
 582     }
 583 }
 584
 585 #ifndef mingw32_HOST_OS
 586 void
 587 shutdownHaskellAndSignal(int sig)
 588 {
 589     hs_exit_(rtsFalse);
 590     kill(getpid(),sig);
 591 }
 592 #endif
 593
 594 /*
 595  * called from STG-land to exit the program
 596  */
 597
 598 #ifdef PAR
 599 static int exit_started=rtsFalse;
 600 #endif
 601
 602 void (*exitFn)(int) = 0;
 603
 604 void
 605 stg_exit(int n)
 606 {
 607 #ifdef PAR
 608   /* HACK: avoid a loop when exiting due to a stupid error */
 609   if (exit_started)
 610     return;
 611   exit_started=rtsTrue;
 612
 613   IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid));
 614   shutdownParallelSystem(n);
 615 #endif
 616   if (exitFn)
 617     (*exitFn)(n);
 618   exit(n);
 619 }