X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FMain.c;h=6aef280e256b1476e30422678ad70e7e5618d302;hb=45252b35151fc55aa19fb6770df5ed8267639083;hp=8dc044aed673d610527139789a3949e2beca65cc;hpb=80e3fcf33425c5bc9164694df2dec7c79730f076;p=ghc-hetmet.git diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c index 8dc044a..6aef280 100644 --- a/ghc/rts/Main.c +++ b/ghc/rts/Main.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Main.c,v 1.15 2000/01/14 13:17:16 hwloidl Exp $ * - * (c) The GHC Team 1998-1999 + * (c) The GHC Team 1998-2000 * * Main function for a standalone Haskell program. * @@ -9,23 +8,24 @@ #define COMPILING_RTS_MAIN +#include "PosixSource.h" #include "Rts.h" #include "RtsAPI.h" #include "SchedAPI.h" +#include "Schedule.h" #include "RtsFlags.h" #include "RtsUtils.h" +#include "Prelude.h" +#include "Task.h" +#include #ifdef DEBUG # include "Printer.h" /* for printing */ #endif -#ifdef INTERPRETER -# include "Assembler.h" -#endif - #ifdef PAR -# include "ParInit.h" # include "Parallel.h" +# include "ParallelRts.h" # include "LLC.h" #endif @@ -37,18 +37,19 @@ # include #endif +extern void __stginit_ZCMain(void); /* Hack: we assume that we're building a batch-mode system unless * INTERPRETER is set */ -# ifndef INTERPRETER /* Hack */ +#ifndef INTERPRETER /* Hack */ int main(int argc, char *argv[]) { int exit_status; SchedulerStatus status; /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */ - startupHaskell(argc,argv); + startupHaskell(argc,argv,__stginit_ZCMain); /* kick off the computation by creating the main thread with a pointer to mainIO_closure representing the computation of the overall program; @@ -63,7 +64,7 @@ int main(int argc, char *argv[]) # if defined(PAR) -# if DEBUG +# if defined(DEBUG) { /* a wait loop to allow attachment of gdb to UNIX threads */ nat i, j, s; @@ -76,53 +77,62 @@ int main(int argc, char *argv[]) # endif if (IAmMainThread == rtsTrue) { - fprintf(stderr, "Main Thread Started ...\n"); + IF_PAR_DEBUG(verbose, + debugBelch("==== [%x] Main Thread Started ...\n", mytid)); /* ToDo: Dump event for the main thread */ - status = rts_evalIO((StgClosure *)&mainIO_closure, NULL); + status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL); } else { /* Just to show we're alive */ IF_PAR_DEBUG(verbose, - fprintf(stderr, "== [%x] Non-Main PE enters scheduler without work ...\n", + debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n", mytid)); /* all non-main threads enter the scheduler without work */ - status = schedule( /* nothing */ ); + taskStart(); + status = Success; // declare victory (see shutdownParallelSystem) } # elif defined(GRAN) /* ToDo: Dump event for the main thread */ - status = rts_evalIO((StgClosure *)&mainIO_closure, NULL); + status = rts_mainLazyIO(mainIO_closure, NULL); # else /* !PAR && !GRAN */ /* ToDo: want to start with a larger stack size */ - status = rts_evalIO((StgClosure *)&mainIO_closure, NULL); + { + void *cap = rts_lock(); + cap = rts_evalLazyIO(cap,(HaskellObj)(void *)mainIO_closure, NULL); + status = rts_getSchedStatus(cap); + rts_unlock(cap); + } # endif /* !PAR && !GRAN */ - // ToDo: update for parallel execution /* check the status of the entire Haskell computation */ switch (status) { - case Deadlock: - prog_belch("no threads to run: infinite loop or deadlock?"); - exit_status = EXIT_DEADLOCK; - break; case Killed: - prog_belch("main thread killed"); + errorBelch("main thread exited (uncaught exception)"); exit_status = EXIT_KILLED; break; case Interrupted: - prog_belch("interrupted"); + errorBelch("interrupted"); exit_status = EXIT_INTERRUPTED; break; case Success: exit_status = EXIT_SUCCESS; break; +#if defined(PAR) case NoStatus: - barf("main thread completed with no status"); + errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); + exit_status = EXIT_KILLED; + break; +#endif + default: + barf("main thread completed with invalid status"); } shutdownHaskellAndExit(exit_status); + return 0; /* never reached, keep gcc -Wall happy */ } # endif /* BATCH_MODE */