ghc/rts/Main.c

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