be773132ee91987de2816a2c07ff3becbd58de58
[ghc.git] / libraries / base / GHC / Conc / IO.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP
3 , NoImplicitPrelude
4 , MagicHash
5 , UnboxedTuples
6 #-}
7 {-# OPTIONS_GHC -Wno-missing-signatures #-}
8 {-# OPTIONS_HADDOCK not-home #-}
9
10 -----------------------------------------------------------------------------
11 -- |
12 -- Module : GHC.Conc.IO
13 -- Copyright : (c) The University of Glasgow, 1994-2002
14 -- License : see libraries/base/LICENSE
15 --
16 -- Maintainer : cvs-ghc@haskell.org
17 -- Stability : internal
18 -- Portability : non-portable (GHC extensions)
19 --
20 -- Basic concurrency stuff.
21 --
22 -----------------------------------------------------------------------------
23
24 -- No: #hide, because bits of this module are exposed by the stm package.
25 -- However, we don't want this module to be the home location for the
26 -- bits it exports, we'd rather have Control.Concurrent and the other
27 -- higher level modules be the home. Hence: #not-home
28
29 module GHC.Conc.IO
30 ( ensureIOManagerIsRunning
31 , ioManagerCapabilitiesChanged
32
33 -- * Waiting
34 , threadDelay
35 , registerDelay
36 , threadWaitRead
37 , threadWaitWrite
38 , threadWaitReadSTM
39 , threadWaitWriteSTM
40 , closeFdWith
41
42 #ifdef mingw32_HOST_OS
43 , asyncRead
44 , asyncWrite
45 , asyncDoProc
46
47 , asyncReadBA
48 , asyncWriteBA
49
50 , ConsoleEvent(..)
51 , win32ConsoleHandler
52 , toWin32ConsoleEvent
53 #endif
54 ) where
55
56 import Foreign
57 import GHC.Base
58 import GHC.Conc.Sync as Sync
59 import GHC.Real ( fromIntegral )
60 import System.Posix.Types
61
62 #ifdef mingw32_HOST_OS
63 import qualified GHC.Conc.Windows as Windows
64 import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
65 asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
66 toWin32ConsoleEvent)
67 #else
68 import qualified GHC.Event.Thread as Event
69 #endif
70
71 ensureIOManagerIsRunning :: IO ()
72 #ifndef mingw32_HOST_OS
73 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
74 #else
75 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
76 #endif
77
78 ioManagerCapabilitiesChanged :: IO ()
79 #ifndef mingw32_HOST_OS
80 ioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged
81 #else
82 ioManagerCapabilitiesChanged = return ()
83 #endif
84
85 -- | Block the current thread until data is available to read on the
86 -- given file descriptor (GHC only).
87 --
88 -- This will throw an 'IOError' if the file descriptor was closed
89 -- while this thread was blocked. To safely close a file descriptor
90 -- that has been used with 'threadWaitRead', use 'closeFdWith'.
91 threadWaitRead :: Fd -> IO ()
92 threadWaitRead fd
93 #ifndef mingw32_HOST_OS
94 | threaded = Event.threadWaitRead fd
95 #endif
96 | otherwise = IO $ \s ->
97 case fromIntegral fd of { I# fd# ->
98 case waitRead# fd# s of { s' -> (# s', () #)
99 }}
100
101 -- | Block the current thread until data can be written to the
102 -- given file descriptor (GHC only).
103 --
104 -- This will throw an 'IOError' if the file descriptor was closed
105 -- while this thread was blocked. To safely close a file descriptor
106 -- that has been used with 'threadWaitWrite', use 'closeFdWith'.
107 threadWaitWrite :: Fd -> IO ()
108 threadWaitWrite fd
109 #ifndef mingw32_HOST_OS
110 | threaded = Event.threadWaitWrite fd
111 #endif
112 | otherwise = IO $ \s ->
113 case fromIntegral fd of { I# fd# ->
114 case waitWrite# fd# s of { s' -> (# s', () #)
115 }}
116
117 -- | Returns an STM action that can be used to wait for data
118 -- to read from a file descriptor. The second returned value
119 -- is an IO action that can be used to deregister interest
120 -- in the file descriptor.
121 threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
122 threadWaitReadSTM fd
123 #ifndef mingw32_HOST_OS
124 | threaded = Event.threadWaitReadSTM fd
125 #endif
126 | otherwise = do
127 m <- Sync.newTVarIO False
128 t <- Sync.forkIO $ do
129 threadWaitRead fd
130 Sync.atomically $ Sync.writeTVar m True
131 let waitAction = do b <- Sync.readTVar m
132 if b then return () else retry
133 let killAction = Sync.killThread t
134 return (waitAction, killAction)
135
136 -- | Returns an STM action that can be used to wait until data
137 -- can be written to a file descriptor. The second returned value
138 -- is an IO action that can be used to deregister interest
139 -- in the file descriptor.
140 threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
141 threadWaitWriteSTM fd
142 #ifndef mingw32_HOST_OS
143 | threaded = Event.threadWaitWriteSTM fd
144 #endif
145 | otherwise = do
146 m <- Sync.newTVarIO False
147 t <- Sync.forkIO $ do
148 threadWaitWrite fd
149 Sync.atomically $ Sync.writeTVar m True
150 let waitAction = do b <- Sync.readTVar m
151 if b then return () else retry
152 let killAction = Sync.killThread t
153 return (waitAction, killAction)
154
155 -- | Close a file descriptor in a concurrency-safe way (GHC only). If
156 -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
157 -- blocking I\/O, you /must/ use this function to close file
158 -- descriptors, or blocked threads may not be woken.
159 --
160 -- Any threads that are blocked on the file descriptor via
161 -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
162 -- IO exceptions thrown.
163 closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
164 -> Fd -- ^ File descriptor to close.
165 -> IO ()
166 closeFdWith close fd
167 #ifndef mingw32_HOST_OS
168 | threaded = Event.closeFdWith close fd
169 #endif
170 | otherwise = close fd
171
172 -- | Suspends the current thread for a given number of microseconds
173 -- (GHC only).
174 --
175 -- There is no guarantee that the thread will be rescheduled promptly
176 -- when the delay has expired, but the thread will never continue to
177 -- run /earlier/ than specified.
178 --
179 threadDelay :: Int -> IO ()
180 threadDelay time
181 #ifdef mingw32_HOST_OS
182 | threaded = Windows.threadDelay time
183 #else
184 | threaded = Event.threadDelay time
185 #endif
186 | otherwise = IO $ \s ->
187 case time of { I# time# ->
188 case delay# time# s of { s' -> (# s', () #)
189 }}
190
191 -- | Set the value of returned TVar to True after a given number of
192 -- microseconds. The caveats associated with threadDelay also apply.
193 --
194 registerDelay :: Int -> IO (TVar Bool)
195 registerDelay usecs
196 #ifdef mingw32_HOST_OS
197 | threaded = Windows.registerDelay usecs
198 #else
199 | threaded = Event.registerDelay usecs
200 #endif
201 | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"
202
203 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool