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         , closeFd               -- :: (Int -> IO ()) -> Int -> 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 threadWaitRead :: Fd -> IO ()
  75 threadWaitRead fd
  76 #ifndef mingw32_HOST_OS
  77   | threaded  = Event.threadWaitRead fd
  78 #endif
  79   | otherwise = IO $ \s ->
  80         case fromIntegral fd of { I# fd# ->
  81         case waitRead# fd# s of { s' -> (# s', () #)
  82         }}
  83
  84 -- | Block the current thread until data can be written to the
  85 -- given file descriptor (GHC only).
  86 --
  87 -- This will throw an 'IOError' if the file descriptor was closed
  88 -- while this thread was blocked.
  89 threadWaitWrite :: Fd -> IO ()
  90 threadWaitWrite fd
  91 #ifndef mingw32_HOST_OS
  92   | threaded  = Event.threadWaitWrite fd
  93 #endif
  94   | otherwise = IO $ \s ->
  95         case fromIntegral fd of { I# fd# ->
  96         case waitWrite# fd# s of { s' -> (# s', () #)
  97         }}
  98
  99 -- | Close a file descriptor in a concurrency-safe way (GHC only).  If
 100 -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
 101 -- blocking I\/O, you /must/ use this function to close file
 102 -- descriptors, or blocked threads may not be woken.
 103 --
 104 -- Any threads that are blocked on the file descriptor via
 105 -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
 106 -- IO exceptions thrown.
 107 closeFd :: (Fd -> IO ())        -- ^ Low-level action that performs the real close.
 108         -> Fd                   -- ^ File descriptor to close.
 109         -> IO ()
 110 closeFd close fd
 111 #ifndef mingw32_HOST_OS
 112   | threaded  = Event.closeFd close fd
 113 #endif
 114   | otherwise = close fd
 115
 116 -- | Suspends the current thread for a given number of microseconds
 117 -- (GHC only).
 118 --
 119 -- There is no guarantee that the thread will be rescheduled promptly
 120 -- when the delay has expired, but the thread will never continue to
 121 -- run /earlier/ than specified.
 122 --
 123 threadDelay :: Int -> IO ()
 124 threadDelay time
 125 #ifdef mingw32_HOST_OS
 126   | threaded  = Windows.threadDelay time
 127 #else
 128   | threaded  = Event.threadDelay time
 129 #endif
 130   | otherwise = IO $ \s ->
 131         case time of { I# time# ->
 132         case delay# time# s of { s' -> (# s', () #)
 133         }}
 134
 135 -- | Set the value of returned TVar to True after a given number of
 136 -- microseconds. The caveats associated with threadDelay also apply.
 137 --
 138 registerDelay :: Int -> IO (TVar Bool)
 139 registerDelay usecs
 140 #ifdef mingw32_HOST_OS
 141   | threaded = Windows.registerDelay usecs
 142 #else
 143   | threaded = Event.registerDelay usecs
 144 #endif
 145   | otherwise = error "registerDelay: requires -threaded"
 146
 147 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool