GHC/Conc/IO.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   2 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   3 {-# OPTIONS_HADDOCK not-home #-}
   4 -----------------------------------------------------------------------------
   5 -- |
   6 -- Module      :  GHC.Conc.IO
   7 -- Copyright   :  (c) The University of Glasgow, 1994-2002
   8 -- License     :  see libraries/base/LICENSE
   9 --
  10 -- Maintainer  :  cvs-ghc@haskell.org
  11 -- Stability   :  internal
  12 -- Portability :  non-portable (GHC extensions)
  13 --
  14 -- Basic concurrency stuff.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 -- No: #hide, because bits of this module are exposed by the stm package.
  19 -- However, we don't want this module to be the home location for the
  20 -- bits it exports, we'd rather have Control.Concurrent and the other
  21 -- higher level modules be the home.  Hence:
  22
  23 #include "Typeable.h"
  24
  25 -- #not-home
  26 module GHC.Conc.IO
  27         ( ensureIOManagerIsRunning
  28
  29         -- * Waiting
  30         , threadDelay           -- :: Int -> IO ()
  31         , registerDelay         -- :: Int -> IO (TVar Bool)
  32         , threadWaitRead        -- :: Int -> IO ()
  33         , threadWaitWrite       -- :: Int -> IO ()
  34         , closeFdWith           -- :: (Fd -> IO ()) -> Fd -> IO ()
  35
  36 #ifdef mingw32_HOST_OS
  37         , asyncRead     -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
  38         , asyncWrite    -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
  39         , asyncDoProc   -- :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
  40
  41         , asyncReadBA   -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
  42         , asyncWriteBA  -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
  43
  44         , ConsoleEvent(..)
  45         , win32ConsoleHandler
  46         , toWin32ConsoleEvent
  47 #endif
  48         ) where
  49
  50 import Foreign
  51 import GHC.Base
  52 import GHC.Conc.Sync as Sync
  53 import GHC.Real ( fromIntegral )
  54 import System.Posix.Types
  55
  56 #ifdef mingw32_HOST_OS
  57 import qualified GHC.Conc.Windows as Windows
  58 import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
  59                          asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
  60                          toWin32ConsoleEvent)
  61 #else
  62 import qualified System.Event.Thread as Event
  63 #endif
  64
  65 ensureIOManagerIsRunning :: IO ()
  66 #ifndef mingw32_HOST_OS
  67 ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
  68 #else
  69 ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
  70 #endif
  71
  72 -- | Block the current thread until data is available to read on the
  73 -- given file descriptor (GHC only).
  74 --
  75 -- This will throw an 'IOError' if the file descriptor was closed
  76 -- while this thread was blocked.  To safely close a file descriptor
  77 -- that has been used with 'threadWaitRead', use 'closeFdWith'.
  78 threadWaitRead :: Fd -> IO ()
  79 threadWaitRead fd
  80 #ifndef mingw32_HOST_OS
  81   | threaded  = Event.threadWaitRead fd
  82 #endif
  83   | otherwise = IO $ \s ->
  84         case fromIntegral fd of { I# fd# ->
  85         case waitRead# fd# s of { s' -> (# s', () #)
  86         }}
  87
  88 -- | Block the current thread until data can be written to the
  89 -- given file descriptor (GHC only).
  90 --
  91 -- This will throw an 'IOError' if the file descriptor was closed
  92 -- while this thread was blocked.  To safely close a file descriptor
  93 -- that has been used with 'threadWaitWrite', use 'closeFdWith'.
  94 threadWaitWrite :: Fd -> IO ()
  95 threadWaitWrite fd
  96 #ifndef mingw32_HOST_OS
  97   | threaded  = Event.threadWaitWrite fd
  98 #endif
  99   | otherwise = IO $ \s ->
 100         case fromIntegral fd of { I# fd# ->
 101         case waitWrite# fd# s of { s' -> (# s', () #)
 102         }}
 103
 104 -- | Close a file descriptor in a concurrency-safe way (GHC only).  If
 105 -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
 106 -- blocking I\/O, you /must/ use this function to close file
 107 -- descriptors, or blocked threads may not be woken.
 108 --
 109 -- Any threads that are blocked on the file descriptor via
 110 -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
 111 -- IO exceptions thrown.
 112 closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
 113             -> Fd            -- ^ File descriptor to close.
 114             -> IO ()
 115 closeFdWith close fd
 116 #ifndef mingw32_HOST_OS
 117   | threaded  = Event.closeFdWith close fd
 118 #endif
 119   | otherwise = close fd
 120
 121 -- | Suspends the current thread for a given number of microseconds
 122 -- (GHC only).
 123 --
 124 -- There is no guarantee that the thread will be rescheduled promptly
 125 -- when the delay has expired, but the thread will never continue to
 126 -- run /earlier/ than specified.
 127 --
 128 threadDelay :: Int -> IO ()
 129 threadDelay time
 130 #ifdef mingw32_HOST_OS
 131   | threaded  = Windows.threadDelay time
 132 #else
 133   | threaded  = Event.threadDelay time
 134 #endif
 135   | otherwise = IO $ \s ->
 136         case time of { I# time# ->
 137         case delay# time# s of { s' -> (# s', () #)
 138         }}
 139
 140 -- | Set the value of returned TVar to True after a given number of
 141 -- microseconds. The caveats associated with threadDelay also apply.
 142 --
 143 registerDelay :: Int -> IO (TVar Bool)
 144 registerDelay usecs
 145 #ifdef mingw32_HOST_OS
 146   | threaded = Windows.registerDelay usecs
 147 #else
 148   | threaded = Event.registerDelay usecs
 149 #endif
 150   | otherwise = error "registerDelay: requires -threaded"
 151
 152 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool