{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Conc.Windows
-- Copyright   :  (c) The University of Glasgow, 1994-2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  ghc-devs@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC extensions)
--
-- Windows I/O manager interfaces. Depending on which I/O Subsystem is used
-- requests will be routed to different places.
--
-----------------------------------------------------------------------------

-- #not-home
module GHC.Internal.Conc.Windows
#if defined(javascript_HOST_ARCH)
       () where
#else
       ( ensureIOManagerIsRunning
       , interruptIOManager

       -- * Waiting
       , threadDelay
       , registerDelay

       -- * Miscellaneous
       , asyncRead
       , asyncWrite
       , asyncDoProc

       , asyncReadBA
       , asyncWriteBA

       -- * Console event handler
       , module GHC.Internal.Event.Windows.ConsoleEvent
       ) where

import GHC.Internal.Base
import GHC.Internal.Conc.Sync
import qualified GHC.Internal.Conc.POSIX as POSIX
import qualified GHC.Internal.Event.Windows.Thread as WINIO
import GHC.Internal.Event.Windows.ConsoleEvent
import GHC.Internal.IO.SubSystem ((<!>))
import GHC.Internal.Ptr

-- ----------------------------------------------------------------------------
-- Thread waiting

-- Note: threadWaitRead and threadWaitWrite aren't really functional
-- on Win32, but left in there because lib code (still) uses them (the manner
-- in which they're used doesn't cause problems on a Win32 platform though.)

asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncRead :: forall a. Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncRead  (I# Int#
fd) (I# Int#
isSock) (I# Int#
len) (Ptr Addr#
buf) =
  (State# RealWorld -> (# State# RealWorld, (Int, Int) #))
-> IO (Int, Int)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, (Int, Int) #))
 -> IO (Int, Int))
-> (State# RealWorld -> (# State# RealWorld, (Int, Int) #))
-> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Int#
-> Int#
-> Int#
-> Addr#
-> State# RealWorld
-> (# State# RealWorld, Int#, Int# #)
asyncRead# Int#
fd Int#
isSock Int#
len Addr#
buf State# RealWorld
s of
               (# State# RealWorld
s', Int#
len#, Int#
err# #) -> (# State# RealWorld
s', (Int# -> Int
I# Int#
len#, Int# -> Int
I# Int#
err#) #)

asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncWrite :: forall a. Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncWrite  (I# Int#
fd) (I# Int#
isSock) (I# Int#
len) (Ptr Addr#
buf) =
  (State# RealWorld -> (# State# RealWorld, (Int, Int) #))
-> IO (Int, Int)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, (Int, Int) #))
 -> IO (Int, Int))
-> (State# RealWorld -> (# State# RealWorld, (Int, Int) #))
-> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Int#
-> Int#
-> Int#
-> Addr#
-> State# RealWorld
-> (# State# RealWorld, Int#, Int# #)
asyncWrite# Int#
fd Int#
isSock Int#
len Addr#
buf State# RealWorld
s of
               (# State# RealWorld
s', Int#
len#, Int#
err# #) -> (# State# RealWorld
s', (Int# -> Int
I# Int#
len#, Int# -> Int
I# Int#
err#) #)

asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
asyncDoProc :: forall a. FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
asyncDoProc (FunPtr Addr#
proc) (Ptr Addr#
param) =
    -- the 'length' value is ignored; simplifies implementation of
    -- the async*# primops to have them all return the same result.
  (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Addr# -> State# RealWorld -> (# State# RealWorld, Int#, Int# #)
asyncDoProc# Addr#
proc Addr#
param State# RealWorld
s  of
               (# State# RealWorld
s', Int#
_len#, Int#
err# #) -> (# State# RealWorld
s', Int# -> Int
I# Int#
err# #)

-- to aid the use of these primops by the IO Handle implementation,
-- provide the following convenience funs:

-- this better be a pinned byte array!
asyncReadBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)
asyncReadBA :: Int
-> Int
-> Int
-> Int
-> MutableByteArray# RealWorld
-> IO (Int, Int)
asyncReadBA Int
fd Int
isSock Int
len Int
off MutableByteArray# RealWorld
bufB =
  Int -> Int -> Int -> Ptr (ZonkAny 2) -> IO (Int, Int)
forall a. Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncRead Int
fd Int
isSock Int
len ((Addr# -> Ptr (ZonkAny 3)
forall a. Addr# -> Ptr a
Ptr (MutableByteArray# RealWorld -> Addr#
forall d. MutableByteArray# d -> Addr#
mutableByteArrayContents# MutableByteArray# RealWorld
bufB)) Ptr (ZonkAny 3) -> Int -> Ptr (ZonkAny 2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)

asyncWriteBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)
asyncWriteBA :: Int
-> Int
-> Int
-> Int
-> MutableByteArray# RealWorld
-> IO (Int, Int)
asyncWriteBA Int
fd Int
isSock Int
len Int
off MutableByteArray# RealWorld
bufB =
  Int -> Int -> Int -> Ptr (ZonkAny 0) -> IO (Int, Int)
forall a. Int -> Int -> Int -> Ptr a -> IO (Int, Int)
asyncWrite Int
fd Int
isSock Int
len ((Addr# -> Ptr (ZonkAny 1)
forall a. Addr# -> Ptr a
Ptr (MutableByteArray# RealWorld -> Addr#
forall d. MutableByteArray# d -> Addr#
mutableByteArrayContents# MutableByteArray# RealWorld
bufB)) Ptr (ZonkAny 1) -> Int -> Ptr (ZonkAny 0)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)

-- ----------------------------------------------------------------------------
-- Threaded RTS implementation of threadDelay

-- | Suspends the current thread for a given number of microseconds
-- (GHC only).
--
-- There is no guarantee that the thread will be rescheduled promptly
-- when the delay has expired, but the thread will never continue to
-- run /earlier/ than specified.
--
-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
-- 2147483647 μs, less than 36 minutes.
--
threadDelay :: Int -> IO ()
threadDelay :: Int -> IO ()
threadDelay = Int -> IO ()
POSIX.threadDelay (Int -> IO ()) -> (Int -> IO ()) -> Int -> IO ()
forall a. a -> a -> a
<!> Int -> IO ()
WINIO.threadDelay

-- | Set the value of returned TVar to True after a given number of
-- microseconds. The caveats associated with threadDelay also apply.
--
-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
-- 2147483647 μs, less than 36 minutes.
--
registerDelay :: Int -> IO (TVar Bool)
registerDelay :: Int -> IO (TVar Bool)
registerDelay = Int -> IO (TVar Bool)
POSIX.registerDelay (Int -> IO (TVar Bool))
-> (Int -> IO (TVar Bool)) -> Int -> IO (TVar Bool)
forall a. a -> a -> a
<!> Int -> IO (TVar Bool)
WINIO.registerDelay

ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning =  IO ()
POSIX.ensureIOManagerIsRunning
                        IO () -> IO () -> IO ()
forall a. a -> a -> a
<!> IO ()
WINIO.ensureIOManagerIsRunning

interruptIOManager :: IO ()
interruptIOManager :: IO ()
interruptIOManager = IO ()
POSIX.interruptIOManager IO () -> IO () -> IO ()
forall a. a -> a -> a
<!> IO ()
WINIO.interruptIOManager

#endif