ghc/rts/RtsStartup.c

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