diff options
| author | Simon Marlow <simonmar@microsoft.com> | 2006-06-16 11:19:37 +0000 |
|---|---|---|
| committer | Simon Marlow <simonmar@microsoft.com> | 2006-06-16 11:19:37 +0000 |
| commit | 9c4abbc0c2d4373eb7c63b1110821dfcb0077661 (patch) | |
| tree | 050653f5b7f509584168f3f34111ba310f77046b /rts/RaiseAsync.c | |
| parent | 135a717c69397ab2f575191254f71faf805042de (diff) | |
| download | haskell-9c4abbc0c2d4373eb7c63b1110821dfcb0077661.tar.gz | |
add STM support to the new throwTo mechanism
Diffstat (limited to 'rts/RaiseAsync.c')
| -rw-r--r-- | rts/RaiseAsync.c | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index 9041c06cb2..b0c7064540 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -401,7 +401,23 @@ check_target: } case BlockedOnSTM: - barf("ToDo"); + lockTSO(target); + // Unblocking BlockedOnSTM threads requires the TSO to be + // locked; see STM.c:unpark_tso(). + if (target->why_blocked != BlockedOnSTM) { + goto retry; + } + if ((target->flags & TSO_BLOCKEX) && + ((target->flags & TSO_INTERRUPTIBLE) == 0)) { + blockedThrowTo(source,target); + *out = target; + return THROWTO_BLOCKED; + } else { + raiseAsync(cap, target, exception, rtsFalse, NULL); + unblockOne(cap, target); + unlockTSO(target); + return THROWTO_SUCCESS; + } case BlockedOnCCall: case BlockedOnCCall_NoUnblockExc: |