ghc/rts/Main.c

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