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