ghc/rts/Main.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2000
   4  *
   5  * Main function for a standalone Haskell program.
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 #define COMPILING_RTS_MAIN
  10
  11 #include "PosixSource.h"
  12 #include "Rts.h"
  13 #include "RtsAPI.h"
  14 #include "SchedAPI.h"
  15 #include "Schedule.h"
  16 #include "RtsFlags.h"
  17 #include "RtsUtils.h"
  18 #include "Prelude.h"
  19 #include "Task.h"
  20 #include <stdlib.h>
  21
  22 #ifdef DEBUG
  23 # include "Printer.h"   /* for printing        */
  24 #endif
  25
  26 #ifdef PAR
  27 # include "Parallel.h"
  28 # include "ParallelRts.h"
  29 # include "LLC.h"
  30 #endif
  31
  32 #if defined(GRAN) || defined(PAR)
  33 # include "GranSimRts.h"
  34 #endif
  35
  36 #ifdef HAVE_WINDOWS_H
  37 # include <windows.h>
  38 #endif
  39
  40 extern void __stginit_ZCMain(void);
  41
  42 /* Hack: we assume that we're building a batch-mode system unless
  43  * INTERPRETER is set
  44  */
  45 #ifndef INTERPRETER /* Hack */
  46 int main(int argc, char *argv[])
  47 {
  48     int exit_status;
  49     SchedulerStatus status;
  50     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
  51
  52 #if defined(PROFILING) || defined(mingw32_HOST_OS)
  53     /* mingw32 and PROFILING (still) define __stginits in .text */
  54     startupHaskell(argc,argv,__stginit_ZCMain);
  55 #else
  56     startupHaskell(argc,argv,NULL);
  57 #endif
  58
  59     /* Register this thread as a task, so we can get timing stats about it */
  60 #if defined(RTS_SUPPORTS_THREADS)
  61     threadIsTask(osThreadId());
  62 #endif
  63
  64     /* kick off the computation by creating the main thread with a pointer
  65        to mainIO_closure representing the computation of the overall program;
  66        then enter the scheduler with this thread and off we go;
  67
  68        the same for GranSim (we have only one instance of this code)
  69
  70        in a parallel setup, where we have many instances of this code
  71        running on different PEs, we should do this only for the main PE
  72        (IAmMainThread is set in startupHaskell)
  73     */
  74
  75 #  if defined(PAR)
  76
  77 #   if defined(DEBUG)
  78     { /* a wait loop to allow attachment of gdb to UNIX threads */
  79       nat i, j, s;
  80
  81       for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
  82         for (j=0; j<1000000; j++)
  83           s += j % 65536;
  84     }
  85     IF_PAR_DEBUG(verbose,
  86                  belch("Passed wait loop"));
  87 #   endif
  88
  89     if (IAmMainThread == rtsTrue) {
  90       IF_PAR_DEBUG(verbose,
  91                    debugBelch("==== [%x] Main Thread Started ...\n", mytid));
  92
  93       /* ToDo: Dump event for the main thread */
  94       status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
  95     } else {
  96       /* Just to show we're alive */
  97       IF_PAR_DEBUG(verbose,
  98                    debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
  99                            mytid));
 100
 101       /* all non-main threads enter the scheduler without work */
 102       taskStart();
 103       status = Success;  // declare victory (see shutdownParallelSystem)
 104     }
 105
 106 #  elif defined(GRAN)
 107
 108     /* ToDo: Dump event for the main thread */
 109     status = rts_mainLazyIO(mainIO_closure, NULL);
 110
 111 #  else /* !PAR && !GRAN */
 112
 113     /* ToDo: want to start with a larger stack size */
 114     rts_lock();
 115     status = rts_evalLazyIO((HaskellObj)mainIO_closure, NULL);
 116     rts_unlock();
 117
 118 #  endif /* !PAR && !GRAN */
 119
 120     /* check the status of the entire Haskell computation */
 121     switch (status) {
 122     case Killed:
 123       errorBelch("main thread exited (uncaught exception)");
 124       exit_status = EXIT_KILLED;
 125       break;
 126     case Interrupted:
 127       errorBelch("interrupted");
 128       exit_status = EXIT_INTERRUPTED;
 129       break;
 130     case Success:
 131       exit_status = EXIT_SUCCESS;
 132       break;
 133 #if defined(PAR)
 134     case NoStatus:
 135       errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
 136       exit_status = EXIT_KILLED;
 137       break;
 138 #endif
 139     default:
 140       barf("main thread completed with invalid status");
 141     }
 142     shutdownHaskellAndExit(exit_status);
 143     return 0; /* never reached, keep gcc -Wall happy */
 144 }
 145 # endif /* BATCH_MODE */