| ... |
... |
@@ -30,16 +30,22 @@ foreign import ccall unsafe "has_local_stop_after_return" |
|
30
|
30
|
main :: IO ()
|
|
31
|
31
|
main = do
|
|
32
|
32
|
setNumCapabilities 2
|
|
33
|
|
- checkFlag
|
|
34
|
|
- "TSO_STOP_NEXT_BREAKPOINT"
|
|
35
|
|
- rts_enableStopNextBreakpoint
|
|
36
|
|
- rts_disableStopNextBreakpoint
|
|
37
|
|
- c_hasLocalStopNextBreakpoint
|
|
38
|
|
- checkFlag
|
|
39
|
|
- "TSO_STOP_AFTER_RETURN"
|
|
40
|
|
- rts_enableStopAfterReturn
|
|
41
|
|
- rts_disableStopAfterReturn
|
|
42
|
|
- c_hasLocalStopAfterReturn
|
|
|
33
|
+ -- Bind to capability 0 so it can't float between capabilities while the
|
|
|
34
|
+ -- target thread runs on capability 1.
|
|
|
35
|
+ doneVar <- newEmptyMVar
|
|
|
36
|
+ _ <- forkOn 0 $ do
|
|
|
37
|
+ checkFlag
|
|
|
38
|
+ "TSO_STOP_NEXT_BREAKPOINT"
|
|
|
39
|
+ rts_enableStopNextBreakpoint
|
|
|
40
|
+ rts_disableStopNextBreakpoint
|
|
|
41
|
+ c_hasLocalStopNextBreakpoint
|
|
|
42
|
+ checkFlag
|
|
|
43
|
+ "TSO_STOP_AFTER_RETURN"
|
|
|
44
|
+ rts_enableStopAfterReturn
|
|
|
45
|
+ rts_disableStopAfterReturn
|
|
|
46
|
+ c_hasLocalStopAfterReturn
|
|
|
47
|
+ putMVar doneVar ()
|
|
|
48
|
+ takeMVar doneVar
|
|
43
|
49
|
|
|
44
|
50
|
checkFlag
|
|
45
|
51
|
:: String
|
| ... |
... |
@@ -58,6 +64,7 @@ checkFlag label enable disable isMyThreadFlagSet = do |
|
58
|
64
|
ThreadId tid# <- forkOn 1 $ do
|
|
59
|
65
|
replicateM_ 2 $ do
|
|
60
|
66
|
replyVar <- takeMVar targetCheckVar
|
|
|
67
|
+ yield -- make sure we reprocess the mailbox
|
|
61
|
68
|
isSet <- (/= 0) <$> isMyThreadFlagSet
|
|
62
|
69
|
putMVar replyVar isSet
|
|
63
|
70
|
|