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 #if defined(mingw32_HOST_OS)
  20 #include "win32/seh_excn.h"
  21 #endif
  22 #include <stdlib.h>
  23
  24 #ifdef DEBUG
  25 # include "Printer.h"   /* for printing        */
  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 __stginit_ZCMain(void);
  43
  44 static int progargc;
  45 static char **progargv;
  46
  47 /* Hack: we assume that we're building a batch-mode system unless
  48  * INTERPRETER is set
  49  */
  50 #ifndef INTERPRETER /* Hack */
  51 static void real_main(void)
  52 {
  53     int exit_status;
  54     SchedulerStatus status;
  55     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
  56
  57     startupHaskell(progargc,progargv,__stginit_ZCMain);
  58
  59     /* kick off the computation by creating the main thread with a pointer
  60        to mainIO_closure representing the computation of the overall program;
  61        then enter the scheduler with this thread and off we go;
  62
  63        the same for GranSim (we have only one instance of this code)
  64
  65        in a parallel setup, where we have many instances of this code
  66        running on different PEs, we should do this only for the main PE
  67        (IAmMainThread is set in startupHaskell)
  68     */
  69
  70 #  if defined(PAR)
  71
  72 #   if defined(DEBUG)
  73     { /* a wait loop to allow attachment of gdb to UNIX threads */
  74       nat i, j, s;
  75
  76       for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
  77         for (j=0; j<1000000; j++)
  78           s += j % 65536;
  79     }
  80     IF_PAR_DEBUG(verbose,
  81                  belch("Passed wait loop"));
  82 #   endif
  83
  84     if (IAmMainThread == rtsTrue) {
  85       IF_PAR_DEBUG(verbose,
  86                    debugBelch("==== [%x] Main Thread Started ...\n", mytid));
  87
  88       /* ToDo: Dump event for the main thread */
  89       status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
  90     } else {
  91       /* Just to show we're alive */
  92       IF_PAR_DEBUG(verbose,
  93                    debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
  94                            mytid));
  95
  96       /* all non-main threads enter the scheduler without work */
  97       taskStart();
  98       status = Success;  // declare victory (see shutdownParallelSystem)
  99     }
 100
 101 #  elif defined(GRAN)
 102
 103     /* ToDo: Dump event for the main thread */
 104     status = rts_mainLazyIO(mainIO_closure, NULL);
 105
 106 #  else /* !PAR && !GRAN */
 107
 108     /* ToDo: want to start with a larger stack size */
 109     {
 110         Capability *cap = rts_lock();
 111         cap = rts_evalLazyIO(cap,(HaskellObj)(void *)mainIO_closure, NULL);
 112         status = rts_getSchedStatus(cap);
 113         taskTimeStamp(myTask());
 114         rts_unlock(cap);
 115     }
 116
 117 #  endif /* !PAR && !GRAN */
 118
 119     /* check the status of the entire Haskell computation */
 120     switch (status) {
 121     case Killed:
 122       errorBelch("main thread exited (uncaught exception)");
 123       exit_status = EXIT_KILLED;
 124       break;
 125     case Interrupted:
 126       errorBelch("interrupted");
 127       exit_status = EXIT_INTERRUPTED;
 128       break;
 129     case HeapExhausted:
 130       exit_status = EXIT_HEAPOVERFLOW;
 131       break;
 132     case Success:
 133       exit_status = EXIT_SUCCESS;
 134       break;
 135 #if defined(PAR)
 136     case NoStatus:
 137       errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
 138       exit_status = EXIT_KILLED;
 139       break;
 140 #endif
 141     default:
 142       barf("main thread completed with invalid status");
 143     }
 144     shutdownHaskellAndExit(exit_status);
 145 }
 146 int main(int argc, char *argv[])
 147 {
 148     /* We do this dance with argc and argv as otherwise the SEH exception
 149        stuff (the BEGIN/END CATCH below) on Windows gets confused */
 150     progargc = argc;
 151     progargv = argv;
 152
 153 #if defined(mingw32_HOST_OS)
 154     BEGIN_CATCH
 155 #endif
 156     real_main();
 157 #if defined(mingw32_HOST_OS)
 158     END_CATCH
 159 #endif
 160     return 0; /* not reached, but keeps gcc -Wall happy */
 161 }
 162 # endif /* BATCH_MODE */