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