2 {-# OPTIONS -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
6 -- Copyright : (c) The University of Glasgow, 1994-2002
7 -- License : see libraries/base/LICENSE
9 -- Maintainer : cvs-ghc@haskell.org
10 -- Stability : internal
11 -- Portability : non-portable (GHC extensions)
13 -- Basic concurrency stuff.
15 -----------------------------------------------------------------------------
20 -- Forking and suchlike
21 , myThreadId -- :: IO ThreadId
22 , killThread -- :: ThreadId -> IO ()
23 , throwTo -- :: ThreadId -> Exception -> IO ()
24 , par -- :: a -> b -> b
25 , pseq -- :: a -> b -> b
27 , labelThread -- :: String -> IO ()
28 , forkProcess -- :: IO Int
31 , threadDelay -- :: Int -> IO ()
32 , threadWaitRead -- :: Int -> IO ()
33 , threadWaitWrite -- :: Int -> IO ()
37 , newMVar -- :: a -> IO (MVar a)
38 , newEmptyMVar -- :: IO (MVar a)
39 , takeMVar -- :: MVar a -> IO a
40 , putMVar -- :: MVar a -> a -> IO ()
41 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
42 , tryPutMVar -- :: MVar a -> a -> IO Bool
43 , isEmptyMVar -- :: MVar a -> IO Bool
44 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
51 import GHC.Err ( parError, seqError )
52 import GHC.IOBase ( IO(..), MVar(..) )
53 import GHC.Base ( Int(..) )
54 import GHC.Exception ( Exception(..), AsyncException(..) )
55 import GHC.Pack ( packCString# )
57 infixr 0 `par`, `pseq`
60 %************************************************************************
62 \subsection{@ThreadId@, @par@, and @fork@}
64 %************************************************************************
67 data ThreadId = ThreadId ThreadId#
68 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
69 -- But since ThreadId# is unlifted, the Weak type must use open
72 --forkIO has now been hoisted out into the Concurrent library.
74 killThread :: ThreadId -> IO ()
75 killThread (ThreadId id) = IO $ \ s ->
76 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
78 throwTo :: ThreadId -> Exception -> IO ()
79 throwTo (ThreadId id) ex = IO $ \ s ->
80 case (killThread# id ex s) of s1 -> (# s1, () #)
82 myThreadId :: IO ThreadId
83 myThreadId = IO $ \s ->
84 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
88 case (yield# s) of s1 -> (# s1, () #)
90 labelThread :: String -> IO ()
91 labelThread str = IO $ \ s ->
92 let ps = packCString# str
93 adr = byteArrayContents# ps in
94 case (labelThread# adr s) of s1 -> (# s1, () #)
97 forkProcess = IO $ \s -> case (forkProcess# s) of (# s1, id #) -> (# s1, (I# id) #)
99 -- Nota Bene: 'pseq' used to be 'seq'
100 -- but 'seq' is now defined in PrelGHC
102 -- "pseq" is defined a bit weirdly (see below)
104 -- The reason for the strange "0# -> parError" case is that
105 -- it fools the compiler into thinking that seq is non-strict in
106 -- its second argument (even if it inlines seq at the call site).
107 -- If it thinks seq is strict in "y", then it often evaluates
108 -- "y" before "x", which is totally wrong.
110 -- Just before converting from Core to STG there's a bit of magic
111 -- that recognises the seq# and eliminates the duff case.
115 pseq x y = case (seq# x) of { 0# -> seqError; _ -> y }
119 par x y = case (par# x) of { 0# -> parError; _ -> y }
122 %************************************************************************
124 \subsection[mvars]{M-Structures}
126 %************************************************************************
128 M-Vars are rendezvous points for concurrent threads. They begin
129 empty, and any attempt to read an empty M-Var blocks. When an M-Var
130 is written, a single blocked thread may be freed. Reading an M-Var
131 toggles its state from full back to empty. Therefore, any value
132 written to an M-Var may only be read once. Multiple reads and writes
133 are allowed, but there must be at least one read between any two
137 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
139 newEmptyMVar :: IO (MVar a)
140 newEmptyMVar = IO $ \ s# ->
142 (# s2#, svar# #) -> (# s2#, MVar svar# #)
144 takeMVar :: MVar a -> IO a
145 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
147 putMVar :: MVar a -> a -> IO ()
148 putMVar (MVar mvar#) x = IO $ \ s# ->
149 case putMVar# mvar# x s# of
152 tryPutMVar :: MVar a -> a -> IO Bool
153 tryPutMVar (MVar mvar#) x = IO $ \ s# ->
154 case tryPutMVar# mvar# x s# of
155 (# s, 0# #) -> (# s, False #)
156 (# s, _ #) -> (# s, True #)
158 newMVar :: a -> IO (MVar a)
160 newEmptyMVar >>= \ mvar ->
161 putMVar mvar value >>
164 -- tryTakeMVar is a non-blocking takeMVar
165 tryTakeMVar :: MVar a -> IO (Maybe a)
166 tryTakeMVar (MVar m) = IO $ \ s ->
167 case tryTakeMVar# m s of
168 (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty
169 (# s, _, a #) -> (# s, Just a #) -- MVar is full
172 Low-level op. for checking whether an MVar is filled-in or not.
173 Notice that the boolean value returned is just a snapshot of
174 the state of the MVar. By the time you get to react on its result,
175 the MVar may have been filled (or emptied) - so be extremely
176 careful when using this operation.
178 Use tryTakeMVar instead if possible.
180 If you can re-work your abstractions to avoid having to
181 depend on isEmptyMVar, then you're encouraged to do so,
182 i.e., consider yourself warned about the imprecision in
183 general of isEmptyMVar :-)
185 isEmptyMVar :: MVar a -> IO Bool
186 isEmptyMVar (MVar mv#) = IO $ \ s# ->
187 case isEmptyMVar# mv# s# of
188 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
190 -- Like addForeignPtrFinalizer, but for MVars
191 addMVarFinalizer :: MVar a -> IO () -> IO ()
192 addMVarFinalizer (MVar m) finalizer =
193 IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
197 %************************************************************************
199 \subsection{Thread waiting}
201 %************************************************************************
203 @threadDelay@ delays rescheduling of a thread until the indicated
204 number of microseconds have elapsed. Generally, the microseconds are
205 counted by the context switch timer, which ticks in virtual time;
206 however, when there are no runnable threads, we don't accumulate any
207 virtual time, so we start ticking in real time. (The granularity is
208 the effective resolution of the context switch timer, so it is
209 affected by the RTS -C option.)
211 @threadWaitRead@ delays rescheduling of a thread until input on the
212 specified file descriptor is available for reading (just like select).
213 @threadWaitWrite@ is similar, but for writing on a file descriptor.
216 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
218 threadDelay (I# ms) = IO $ \s -> case delay# ms s of s -> (# s, () #)
219 threadWaitRead (I# fd) = IO $ \s -> case waitRead# fd s of s -> (# s, () #)
220 threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)