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)
  53     startupHaskell(argc,argv,__stginit_ZCMain);
  54 #else
  55     startupHaskell(argc,argv,NULL);
  56 #endif
  57
  58     /* Register this thread as a task, so we can get timing stats about it */
  59 #if defined(RTS_SUPPORTS_THREADS)
  60     threadIsTask(osThreadId());
  61 #endif
  62
  63     /* kick off the computation by creating the main thread with a pointer
  64        to mainIO_closure representing the computation of the overall program;
  65        then enter the scheduler with this thread and off we go;
  66
  67        the same for GranSim (we have only one instance of this code)
  68
  69        in a parallel setup, where we have many instances of this code
  70        running on different PEs, we should do this only for the main PE
  71        (IAmMainThread is set in startupHaskell)
  72     */
  73
  74 #  if defined(PAR)
  75
  76 #   if defined(DEBUG)
  77     { /* a wait loop to allow attachment of gdb to UNIX threads */
  78       nat i, j, s;
  79
  80       for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
  81         for (j=0; j<1000000; j++)
  82           s += j % 65536;
  83     }
  84     IF_PAR_DEBUG(verbose,
  85                  belch("Passed wait loop"));
  86 #   endif
  87
  88     if (IAmMainThread == rtsTrue) {
  89       IF_PAR_DEBUG(verbose,
  90                    debugBelch("==== [%x] Main Thread Started ...\n", mytid));
  91
  92       /* ToDo: Dump event for the main thread */
  93       status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
  94     } else {
  95       /* Just to show we're alive */
  96       IF_PAR_DEBUG(verbose,
  97                    debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
  98                            mytid));
  99
 100       /* all non-main threads enter the scheduler without work */
 101       taskStart();
 102       status = Success;  // declare victory (see shutdownParallelSystem)
 103     }
 104
 105 #  elif defined(GRAN)
 106
 107     /* ToDo: Dump event for the main thread */
 108     status = rts_mainLazyIO(mainIO_closure, NULL);
 109
 110 #  else /* !PAR && !GRAN */
 111
 112     /* ToDo: want to start with a larger stack size */
 113     rts_lock();
 114     status = rts_evalLazyIO((HaskellObj)mainIO_closure, NULL);
 115     rts_unlock();
 116
 117 #  endif /* !PAR && !GRAN */
 118
 119     /* check the status of the entire Haskell computation */
 120     switch (status) {
 121     case Killed:
 122       errorBelch("main thread exited (uncaught exception)");
 123       exit_status = EXIT_KILLED;
 124       break;
 125     case Interrupted:
 126       errorBelch("interrupted");
 127       exit_status = EXIT_INTERRUPTED;
 128       break;
 129     case Success:
 130       exit_status = EXIT_SUCCESS;
 131       break;
 132 #if defined(PAR)
 133     case NoStatus:
 134       errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
 135       exit_status = EXIT_KILLED;
 136       break;
 137 #endif
 138     default:
 139       barf("main thread completed with invalid status");
 140     }
 141     shutdownHaskellAndExit(exit_status);
 142     return 0; /* never reached, keep gcc -Wall happy */
 143 }
 144 # endif /* BATCH_MODE */