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 "RtsFlags.h"
  16 #include "RtsUtils.h"
  17 #include "Prelude.h"
  18 #include "Task.h"
  19 #include "seh_excn.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     BEGIN_CATCH
  53     startupHaskell(argc,argv,__stginit_ZCMain);
  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                    debugBelch("==== [%x] Main Thread Started ...\n", mytid));
  83
  84       /* ToDo: Dump event for the main thread */
  85       status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
  86     } else {
  87       /* Just to show we're alive */
  88       IF_PAR_DEBUG(verbose,
  89                    debugBelch("== [%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_mainLazyIO(mainIO_closure, NULL);
 101
 102 #  else /* !PAR && !GRAN */
 103
 104     /* ToDo: want to start with a larger stack size */
 105     {
 106         Capability *cap = rts_lock();
 107         cap = rts_evalLazyIO(cap,(HaskellObj)(void *)mainIO_closure, NULL);
 108         status = rts_getSchedStatus(cap);
 109         taskTimeStamp(myTask());
 110         rts_unlock(cap);
 111     }
 112
 113 #  endif /* !PAR && !GRAN */
 114
 115     /* check the status of the entire Haskell computation */
 116     switch (status) {
 117     case Killed:
 118       errorBelch("main thread exited (uncaught exception)");
 119       exit_status = EXIT_KILLED;
 120       break;
 121     case Interrupted:
 122       errorBelch("interrupted");
 123       exit_status = EXIT_INTERRUPTED;
 124       break;
 125     case Success:
 126       exit_status = EXIT_SUCCESS;
 127       break;
 128 #if defined(PAR)
 129     case NoStatus:
 130       errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
 131       exit_status = EXIT_KILLED;
 132       break;
 133 #endif
 134     default:
 135       barf("main thread completed with invalid status");
 136     }
 137     shutdownHaskellAndExit(exit_status);
 138     END_CATCH
 139     return 0; /* not reached unless a Windows exception happens,
 140                  also keeps gcc -Wall happy */
 141 }
 142 # endif /* BATCH_MODE */