summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
Diffstat (limited to 'rts')
-rw-r--r--rts/PrimOps.cmm6
-rw-r--r--rts/RaiseAsync.c7
-rw-r--r--rts/Schedule.c31
-rw-r--r--rts/Threads.c3
-rw-r--r--rts/Trace.c1
-rw-r--r--rts/TraverseHeap.c1
-rw-r--r--rts/include/rts/Constants.h8
-rw-r--r--rts/include/rts/storage/TSO.h1
-rw-r--r--rts/sm/Compact.c1
-rw-r--r--rts/sm/Sanity.c1
-rw-r--r--rts/sm/Scav.c1
-rw-r--r--rts/win32/AsyncWinIO.c9
12 files changed, 61 insertions, 9 deletions
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 15f9e949b0..edbd435702 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2222,7 +2222,7 @@ stg_readIOPortzh ( P_ ioport /* :: IOPort a */ )
StgMVar_head(ioport) = q;
StgTSO__link(CurrentTSO) = q;
StgTSO_block_info(CurrentTSO) = ioport;
- StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
+ StgTSO_why_blocked(CurrentTSO) = BlockedOnIOCompletion::I16;
//Unlocks the closure as well
jump stg_block_readmvar(ioport);
@@ -2328,8 +2328,8 @@ loop:
// at this point.
//Either there was no reader queued, or he must have been
- //blocked on BlockedOnMVar
- ASSERT(why_blocked == BlockedOnMVar);
+ //blocked on BlockedOnIOCompletion
+ ASSERT(why_blocked == BlockedOnIOCompletion);
unlockClosure(ioport, info);
return (1);
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 39f39a22b4..a0719024b4 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -175,7 +175,7 @@ throwToSelf (Capability *cap, StgTSO *tso, StgClosure *exception)
- or it is masking exceptions (TSO_BLOCKEX)
Currently, if the target is BlockedOnMVar, BlockedOnSTM,
- or BlockedOnBlackHole then we acquire ownership of the
+ BlockedOnIOCompletion or BlockedOnBlackHole then we acquire ownership of the
TSO by locking its parent container (e.g. the MVar) and then raise the
exception. We might change these cases to be more message-passing-like in
the future.
@@ -344,6 +344,7 @@ check_target:
case BlockedOnMVar:
case BlockedOnMVarRead:
+ case BlockedOnIOCompletion:
{
/*
To establish ownership of this TSO, we need to acquire a
@@ -369,7 +370,8 @@ check_target:
// we have the MVar, let's check whether the thread
// is still blocked on the same MVar.
if ((target->why_blocked != BlockedOnMVar
- && target->why_blocked != BlockedOnMVarRead)
+ && target->why_blocked != BlockedOnMVarRead
+ && target->why_blocked != BlockedOnIOCompletion)
|| (StgMVar *)target->block_info.closure != mvar) {
unlockClosure((StgClosure *)mvar, info);
goto retry;
@@ -682,6 +684,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
case BlockedOnMVar:
case BlockedOnMVarRead:
+ case BlockedOnIOCompletion:
removeFromMVarBlockedQueue(tso);
goto done;
diff --git a/rts/Schedule.c b/rts/Schedule.c
index b9b15811c9..4fe18fa769 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -942,6 +942,7 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
*/
if (SEQ_CST_LOAD(&recent_activity) != ACTIVITY_INACTIVE) return;
#endif
+ if (task->incall->tso && task->incall->tso->why_blocked == BlockedOnIOCompletion) return;
debugTrace(DEBUG_sched, "deadlocked, forcing major GC...");
@@ -979,6 +980,31 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
return;
}
#endif
+
+#if !defined(THREADED_RTS)
+ /* Probably a real deadlock. Send the current main thread the
+ * Deadlock exception.
+ */
+ if (task->incall->tso) {
+ switch (task->incall->tso->why_blocked) {
+ case BlockedOnSTM:
+ case BlockedOnBlackHole:
+ case BlockedOnMsgThrowTo:
+ case BlockedOnMVar:
+ case BlockedOnMVarRead:
+ throwToSingleThreaded(cap, task->incall->tso,
+ (StgClosure *)nonTermination_closure);
+ return;
+ case BlockedOnIOCompletion:
+ /* We're blocked waiting for an external I/O call, let's just
+ chill for a bit. */
+ return;
+ default:
+ barf("deadlock: main thread blocked in a strange way");
+ }
+ }
+ return;
+#endif
}
}
@@ -3192,6 +3218,11 @@ resurrectThreads (StgTSO *threads)
throwToSingleThreaded(cap, tso,
(StgClosure *)blockedIndefinitelyOnSTM_closure);
break;
+ case BlockedOnIOCompletion:
+ /* I/O Ports may not be reachable by the GC as they may be getting
+ * notified by the RTS. As such this call should be treated as if
+ * it is masking the exception. */
+ continue;
case NotBlocked:
/* This might happen if the thread was blocked on a black hole
* belonging to a thread that we've just woken up (raiseAsync
diff --git a/rts/Threads.c b/rts/Threads.c
index ab7af2e52c..b9f753234f 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -286,6 +286,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
switch (tso->why_blocked)
{
+ case BlockedOnIOCompletion:
case BlockedOnMVar:
case BlockedOnMVarRead:
{
@@ -887,6 +888,8 @@ printThreadBlockage(StgTSO *tso)
case BlockedOnMVarRead:
debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.closure);
break;
+ case BlockedOnIOCompletion:
+ debugBelch("is blocked on I/O Completion port @ %p", tso->block_info.closure);
break;
case BlockedOnBlackHole:
debugBelch("is blocked on a black hole %p",
diff --git a/rts/Trace.c b/rts/Trace.c
index f68a72cf2a..9edac3565e 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -183,6 +183,7 @@ static char *thread_stop_reasons[] = {
[6 + BlockedOnSTM] = "blocked on STM",
[6 + BlockedOnDoProc] = "blocked on asyncDoProc",
[6 + BlockedOnCCall] = "blocked on a foreign call",
+ [6 + BlockedOnIOCompletion] = "blocked on I/O Completion port",
[6 + BlockedOnCCall_Interruptible] = "blocked on a foreign call (interruptible)",
[6 + BlockedOnMsgThrowTo] = "blocked on throwTo",
[6 + ThreadMigrating] = "migrating"
diff --git a/rts/TraverseHeap.c b/rts/TraverseHeap.c
index 3b92bb9f98..2285a93b6f 100644
--- a/rts/TraverseHeap.c
+++ b/rts/TraverseHeap.c
@@ -1239,6 +1239,7 @@ inner_loop:
traversePushClosure(ts, (StgClosure *) tso->trec, c, sep, child_data);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnMVarRead
+ || tso->why_blocked == BlockedOnIOCompletion
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnMsgThrowTo
) {
diff --git a/rts/include/rts/Constants.h b/rts/include/rts/Constants.h
index b601999f88..9cbe47752e 100644
--- a/rts/include/rts/Constants.h
+++ b/rts/include/rts/Constants.h
@@ -256,7 +256,13 @@
by tryWakeupThread() */
#define ThreadMigrating 13
-/* Next number is 15. */
+/* Lightweight non-deadlock checked version of MVar. Used for the why_blocked
+ field of a TSO. Threads blocked for this reason are not forcibly release by
+ the GC, as we expect them to be unblocked in the future based on outstanding
+ IO events. */
+#define BlockedOnIOCompletion 15
+
+/* Next number is 16. */
/*
* These constants are returned to the scheduler by a thread that has
diff --git a/rts/include/rts/storage/TSO.h b/rts/include/rts/storage/TSO.h
index a6bd9e9087..fcbf7f7ab1 100644
--- a/rts/include/rts/storage/TSO.h
+++ b/rts/include/rts/storage/TSO.h
@@ -304,6 +304,7 @@ void dirty_STACK (Capability *cap, StgStack *stack);
BlockedOnBlackHole MessageBlackHole * TSO->bq
BlockedOnMVar the MVAR the MVAR's queue
+ BlockedOnIOCompletion the PortEVent the IOCP's queue
BlockedOnSTM END_TSO_QUEUE STM wait queue(s)
BlockedOnSTM STM_AWOKEN run queue
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 3e71c30d35..43867343fc 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -461,6 +461,7 @@ thread_TSO (StgTSO *tso)
|| tso->why_blocked == BlockedOnMVarRead
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnMsgThrowTo
+ || tso->why_blocked == BlockedOnIOCompletion
|| tso->why_blocked == NotBlocked
) {
thread_(&tso->block_info.closure);
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index cf4e2dfea6..63ef9732dd 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -729,6 +729,7 @@ checkTSO(StgTSO *tso)
|| tso->why_blocked == BlockedOnMVarRead
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnMsgThrowTo
+ || tso->why_blocked == BlockedOnIOCompletion
|| tso->why_blocked == NotBlocked
) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index a36ebbb331..9316f395a8 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -131,6 +131,7 @@ scavengeTSO (StgTSO *tso)
|| tso->why_blocked == BlockedOnMVarRead
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnMsgThrowTo
+ || tso->why_blocked == BlockedOnIOCompletion
|| tso->why_blocked == NotBlocked
) {
evacuate(&tso->block_info.closure);
diff --git a/rts/win32/AsyncWinIO.c b/rts/win32/AsyncWinIO.c
index fa397c343d..5f61f815f3 100644
--- a/rts/win32/AsyncWinIO.c
+++ b/rts/win32/AsyncWinIO.c
@@ -24,7 +24,6 @@
#include <stdio.h>
/* Note [Non-Threaded WINIO design]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Compared to Async MIO, Async WINIO does all of the heavy processing at the
Haskell side of things. The same code as the threaded WINIO is re-used for
the Non-threaded version. Of course since we are in a non-threaded rts we
@@ -123,8 +122,10 @@
See also Note [WINIO Manager design].
- Note [Notifying the RTS/Haskell of completed events]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ Note [Notifying the RTS/Haskell of completed events]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
The C side runner can't directly create a haskell thread.
With the current API of the haskell runtime this would be terrible
unsound. In particular the GC assumes no heap objects are generated,
@@ -136,8 +137,10 @@
ensures there is only one OS thread at a time making use of the haskell
heap.
- Note [Non-Threaded IO Manager startup sequence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ Note [Non-Threaded IO Manager startup sequence]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
Under the new IO Manager we run a bit of initialization under
hs_init(). The first call into actual IO manager code is a
invocation of startupAsyncWinIO();
View Lorry Controller Status