Use explicit language extensions & remove extension fields from base.cabal
[packages/base.git] / GHC / Conc / IO.hs
1 {-# LANGUAGE CPP
2 , NoImplicitPrelude
3 , MagicHash
4 , UnboxedTuples
5 , ForeignFunctionInterface
6 #-}
7 {-# OPTIONS_GHC -fno-warn-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:
28
29 #include "Typeable.h"
30
31 -- #not-home
32 module GHC.Conc.IO
33 ( ensureIOManagerIsRunning
34
35 -- * Waiting
36 , threadDelay -- :: Int -> IO ()
37 , registerDelay -- :: Int -> IO (TVar Bool)
38 , threadWaitRead -- :: Int -> IO ()
39 , threadWaitWrite -- :: Int -> IO ()
40 , closeFdWith -- :: (Fd -> IO ()) -> Fd -> IO ()
41
42 #ifdef mingw32_HOST_OS
43 , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
44 , asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
45 , asyncDoProc -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
46
47 , asyncReadBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
48 , asyncWriteBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
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 System.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 -- | Block the current thread until data is available to read on the
79 -- given file descriptor (GHC only).
80 --
81 -- This will throw an 'IOError' if the file descriptor was closed
82 -- while this thread was blocked. To safely close a file descriptor
83 -- that has been used with 'threadWaitRead', use 'closeFdWith'.
84 threadWaitRead :: Fd -> IO ()
85 threadWaitRead fd
86 #ifndef mingw32_HOST_OS
87 | threaded = Event.threadWaitRead fd
88 #endif
89 | otherwise = IO $ \s ->
90 case fromIntegral fd of { I# fd# ->
91 case waitRead# fd# s of { s' -> (# s', () #)
92 }}
93
94 -- | Block the current thread until data can be written to the
95 -- given file descriptor (GHC only).
96 --
97 -- This will throw an 'IOError' if the file descriptor was closed
98 -- while this thread was blocked. To safely close a file descriptor
99 -- that has been used with 'threadWaitWrite', use 'closeFdWith'.
100 threadWaitWrite :: Fd -> IO ()
101 threadWaitWrite fd
102 #ifndef mingw32_HOST_OS
103 | threaded = Event.threadWaitWrite fd
104 #endif
105 | otherwise = IO $ \s ->
106 case fromIntegral fd of { I# fd# ->
107 case waitWrite# fd# s of { s' -> (# s', () #)
108 }}
109
110 -- | Close a file descriptor in a concurrency-safe way (GHC only). If
111 -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
112 -- blocking I\/O, you /must/ use this function to close file
113 -- descriptors, or blocked threads may not be woken.
114 --
115 -- Any threads that are blocked on the file descriptor via
116 -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
117 -- IO exceptions thrown.
118 closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
119 -> Fd -- ^ File descriptor to close.
120 -> IO ()
121 closeFdWith close fd
122 #ifndef mingw32_HOST_OS
123 | threaded = Event.closeFdWith close fd
124 #endif
125 | otherwise = close fd
126
127 -- | Suspends the current thread for a given number of microseconds
128 -- (GHC only).
129 --
130 -- There is no guarantee that the thread will be rescheduled promptly
131 -- when the delay has expired, but the thread will never continue to
132 -- run /earlier/ than specified.
133 --
134 threadDelay :: Int -> IO ()
135 threadDelay time
136 #ifdef mingw32_HOST_OS
137 | threaded = Windows.threadDelay time
138 #else
139 | threaded = Event.threadDelay time
140 #endif
141 | otherwise = IO $ \s ->
142 case time of { I# time# ->
143 case delay# time# s of { s' -> (# s', () #)
144 }}
145
146 -- | Set the value of returned TVar to True after a given number of
147 -- microseconds. The caveats associated with threadDelay also apply.
148 --
149 registerDelay :: Int -> IO (TVar Bool)
150 registerDelay usecs
151 #ifdef mingw32_HOST_OS
152 | threaded = Windows.registerDelay usecs
153 #else
154 | threaded = Event.registerDelay usecs
155 #endif
156 | otherwise = error "registerDelay: requires -threaded"
157
158 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool