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