ghc/rts/Main.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Main.c,v 1.28 2001/07/26 03:20:52 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 #ifdef HAVE_TIME_H
  42 # include <time.h>
  43 #endif
  44
  45 extern void __init_PrelMain(void);
  46
  47 /* Hack: we assume that we're building a batch-mode system unless
  48  * INTERPRETER is set
  49  */
  50 #ifndef INTERPRETER /* Hack */
  51 int main(int argc, char *argv[])
  52 {
  53     int exit_status;
  54     SchedulerStatus status;
  55     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
  56
  57     /*
  58      * Believe it or not, calling tzset() at startup seems to get rid of
  59      * a scheduler-related Heisenbug on alpha-dec-osf3.  The symptom of
  60      * the bug is that, when the load on the machine is high or when
  61      * there are many threads, the variable "Capability *cap" in the
  62      * function "schedule" in the file "Schedule.c" magically becomes
  63      * null before the line "t = cap->rCurrentTSO;".  Why, and why does
  64      * calling tzset() here seem to fix it?  Excellent questions!
  65      */
  66     tzset();
  67
  68     startupHaskell(argc,argv,__init_PrelMain);
  69
  70     /* kick off the computation by creating the main thread with a pointer
  71        to mainIO_closure representing the computation of the overall program;
  72        then enter the scheduler with this thread and off we go;
  73
  74        the same for GranSim (we have only one instance of this code)
  75
  76        in a parallel setup, where we have many instances of this code
  77        running on different PEs, we should do this only for the main PE
  78        (IAmMainThread is set in startupHaskell)
  79     */
  80
  81 #  if defined(PAR)
  82
  83 #   if defined(DEBUG)
  84     { /* a wait loop to allow attachment of gdb to UNIX threads */
  85       nat i, j, s;
  86
  87       for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
  88         for (j=0; j<1000000; j++)
  89           s += j % 65536;
  90     }
  91     IF_PAR_DEBUG(verbose,
  92                  belch("Passed wait loop"));
  93 #   endif
  94
  95     if (IAmMainThread == rtsTrue) {
  96       IF_PAR_DEBUG(verbose,
  97                    fprintf(stderr, "==== [%x] Main Thread Started ...\n", mytid));
  98
  99       /* ToDo: Dump event for the main thread */
 100       status = rts_evalIO((HaskellObj)mainIO_closure, NULL);
 101     } else {
 102       /* Just to show we're alive */
 103       IF_PAR_DEBUG(verbose,
 104                    fprintf(stderr, "== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
 105                            mytid));
 106
 107       /* all non-main threads enter the scheduler without work */
 108       taskStart();
 109       status = Success;  // declare victory (see shutdownParallelSystem)
 110     }
 111
 112 #  elif defined(GRAN)
 113
 114     /* ToDo: Dump event for the main thread */
 115     status = rts_evalIO(mainIO_closure, NULL);
 116
 117 #  else /* !PAR && !GRAN */
 118
 119     /* ToDo: want to start with a larger stack size */
 120     status = rts_evalIO((HaskellObj)mainIO_closure, NULL);
 121
 122 #  endif /* !PAR && !GRAN */
 123
 124     /* check the status of the entire Haskell computation */
 125     switch (status) {
 126     case Deadlock:
 127       prog_belch("no threads to run:  infinite loop or deadlock?");
 128       exit_status = EXIT_DEADLOCK;
 129       break;
 130     case Killed:
 131       prog_belch("main thread exited (uncaught exception)");
 132       exit_status = EXIT_KILLED;
 133       break;
 134     case Interrupted:
 135       prog_belch("interrupted");
 136       exit_status = EXIT_INTERRUPTED;
 137       break;
 138     case Success:
 139       exit_status = EXIT_SUCCESS;
 140       break;
 141 #if defined(PAR)
 142     case NoStatus:
 143       prog_belch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
 144       exit_status = EXIT_KILLED;
 145       break;
 146 #endif
 147     default:
 148       barf("main thread completed with invalid status");
 149     }
 150     shutdownHaskellAndExit(exit_status);
 151     return 0; /* never reached, keep gcc -Wall happy */
 152 }
 153 # endif /* BATCH_MODE */