X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=70601c3f5686a6c67de7ecd750ea1777b24ec8f7;hb=3a886477def20cfaaacb87a784917b5c6a3238b0;hp=51a8d2a842466069fbed9adbb82bd426cb71198a;hpb=dd56e9ab4544e83d27532a8d9058140bfe81825c;p=ghc-hetmet.git diff --git a/rts/Schedule.c b/rts/Schedule.c index 51a8d2a..70601c3 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -9,34 +9,25 @@ #include "PosixSource.h" #define KEEP_LOCKCLOSURE #include "Rts.h" -#include "SchedAPI.h" + +#include "sm/Storage.h" #include "RtsUtils.h" -#include "RtsFlags.h" -#include "OSThreads.h" -#include "Storage.h" #include "StgRun.h" -#include "Hooks.h" #include "Schedule.h" -#include "StgMiscClosures.h" #include "Interpreter.h" #include "Printer.h" #include "RtsSignals.h" #include "Sanity.h" #include "Stats.h" #include "STM.h" -#include "Timer.h" #include "Prelude.h" #include "ThreadLabels.h" -#include "LdvProfile.h" #include "Updates.h" #include "Proftimer.h" #include "ProfHeap.h" -#include "GC.h" #include "Weak.h" -#include "EventLog.h" - -/* PARALLEL_HASKELL includes go here */ - +#include "eventlog/EventLog.h" +#include "sm/GC.h" // waitForGcThreads, releaseGCThreads, N #include "Sparks.h" #include "Capability.h" #include "Task.h" @@ -47,7 +38,8 @@ #include "Trace.h" #include "RaiseAsync.h" #include "Threads.h" -#include "ThrIOManager.h" +#include "Timer.h" +#include "ThreadPaused.h" #ifdef HAVE_SYS_TYPES_H #include @@ -64,12 +56,6 @@ #include #endif -// Turn off inlining when debugging - it obfuscates things -#ifdef DEBUG -# undef STATIC_INLINE -# define STATIC_INLINE static -#endif - /* ----------------------------------------------------------------------------- * Global variables * -------------------------------------------------------------------------- */ @@ -188,12 +174,12 @@ static void deleteThread_(Capability *cap, StgTSO *tso); #ifdef DEBUG static char *whatNext_strs[] = { - "(unknown)", - "ThreadRunGHC", - "ThreadInterpret", - "ThreadKilled", - "ThreadRelocated", - "ThreadComplete" + [0] = "(unknown)", + [ThreadRunGHC] = "ThreadRunGHC", + [ThreadInterpret] = "ThreadInterpret", + [ThreadKilled] = "ThreadKilled", + [ThreadRelocated] = "ThreadRelocated", + [ThreadComplete] = "ThreadComplete" }; #endif @@ -266,14 +252,6 @@ schedule (Capability *initialCapability, Task *task) "### NEW SCHEDULER LOOP (task: %p, cap: %p)", task, initialCapability); - if (running_finalizers) { - errorBelch("error: a C finalizer called back into Haskell.\n" - " This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n" - " To create finalizers that may call back into Haskll, use\n" - " Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr."); - stg_exit(EXIT_FAILURE); - } - schedulePreLoop(); // ----------------------------------------------------------- @@ -584,7 +562,9 @@ run_thread: schedulePostRunThread(cap,t); - t = threadStackUnderflow(task,t); + if (ret != StackOverflow) { + t = threadStackUnderflow(task,t); + } ready_to_gc = rtsFalse; @@ -1729,7 +1709,6 @@ forkProcess(HsStablePtr *entry } #else /* !FORKPROCESS_PRIMOP_SUPPORTED */ barf("forkProcess#: primop not supported on this platform, sorry!\n"); - return -1; #endif } @@ -2381,7 +2360,9 @@ interruptStgRts(void) { sched_state = SCHED_INTERRUPTING; setContextSwitches(); +#if defined(THREADED_RTS) wakeUpRts(); +#endif } /* ----------------------------------------------------------------------------- @@ -2397,16 +2378,15 @@ interruptStgRts(void) will have interrupted any blocking system call in progress anyway. -------------------------------------------------------------------------- */ -void -wakeUpRts(void) -{ #if defined(THREADED_RTS) +void wakeUpRts(void) +{ // This forces the IO Manager thread to wakeup, which will // in turn ensure that some OS thread wakes up and runs the // scheduler loop, which will cause a GC and deadlock check. ioManagerWakeup(); -#endif } +#endif /* ----------------------------------------------------------------------------- * checkBlackHoles()