ghc/rts/Main.c

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