X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FMain.c;h=182f589af053dc58c3bcf518c53ff39936670285;hb=eab7055a9512b150681156f146ee76ad8f67b72f;hp=582a932447ba0a9c6e7665b2bfc85983f3ba6e3b;hpb=a1b48d4cadca3a113abd33e65531f250186ea469;p=ghc-hetmet.git diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c index 582a932..182f589 100644 --- a/ghc/rts/Main.c +++ b/ghc/rts/Main.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: Main.c,v 1.28 2001/07/26 03:20:52 ken Exp $ * * (c) The GHC Team 1998-2000 * @@ -9,21 +8,21 @@ #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 "Parallel.h" # include "ParallelRts.h" @@ -38,11 +37,7 @@ # include #endif -#ifdef HAVE_TIME_H -# include -#endif - -extern void __init_PrelMain(void); +extern void __stginit_ZCMain(void); /* Hack: we assume that we're building a batch-mode system unless * INTERPRETER is set @@ -54,18 +49,16 @@ int main(int argc, char *argv[]) SchedulerStatus status; /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */ - /* - * Believe it or not, calling tzset() at startup seems to get rid of - * a scheduler-related Heisenbug on alpha-dec-osf3. The symptom of - * the bug is that, when the load on the machine is high or when - * there are many threads, the variable "Capability *cap" in the - * function "schedule" in the file "Schedule.c" magically becomes - * null before the line "t = cap->rCurrentTSO;". Why, and why does - * calling tzset() here seem to fix it? Excellent questions! - */ - tzset(); +#if defined(PROFILING) + startupHaskell(argc,argv,__stginit_ZCMain); +#else + startupHaskell(argc,argv,NULL); +#endif - startupHaskell(argc,argv,__init_PrelMain); + /* Register this thread as a task, so we can get timing stats about it */ +#if defined(RTS_SUPPORTS_THREADS) + threadIsTask(osThreadId()); +#endif /* kick off the computation by creating the main thread with a pointer to mainIO_closure representing the computation of the overall program; @@ -94,14 +87,14 @@ int main(int argc, char *argv[]) if (IAmMainThread == rtsTrue) { IF_PAR_DEBUG(verbose, - fprintf(stderr, "==== [%x] Main Thread Started ...\n", mytid)); + debugBelch("==== [%x] Main Thread Started ...\n", mytid)); /* ToDo: Dump event for the main thread */ - status = rts_evalIO((HaskellObj)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 via taskStart() 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 */ @@ -112,27 +105,25 @@ int main(int argc, char *argv[]) # elif defined(GRAN) /* ToDo: Dump event for the main thread */ - status = rts_evalIO(mainIO_closure, NULL); + status = rts_mainLazyIO(mainIO_closure, NULL); # else /* !PAR && !GRAN */ /* ToDo: want to start with a larger stack size */ - status = rts_evalIO((HaskellObj)mainIO_closure, NULL); + rts_lock(); + status = rts_evalLazyIO((HaskellObj)mainIO_closure, NULL); + rts_unlock(); # endif /* !PAR && !GRAN */ /* 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 exited (uncaught exception)"); + 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: @@ -140,7 +131,7 @@ int main(int argc, char *argv[]) break; #if defined(PAR) case NoStatus: - prog_belch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); + errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); exit_status = EXIT_KILLED; break; #endif