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