module Z.IO.UV.Manager
( UVManager(..)
, getUVManager
, getBlockMVar
, peekBufferSizeTable
, pokeBufferSizeTable
, pokeBufferTable
, withUVManager
, withUVManager'
, getUVSlot
, withUVRequest
, withUVRequest_
, withUVRequest'
, withUVRequestEx
, forkBa
) where
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.IORef
import Data.Bits (shiftL)
import Data.Word
import GHC.Ptr
import Foreign.Storable
import GHC.Conc.Sync (labelThread)
import System.IO.Unsafe
import Z.Data.Array
import Z.Data.PrimRef
import qualified Z.Data.Text.Print as T
import Z.IO.Exception
import Z.IO.Resource
import Z.IO.UV.FFI
data UVManager = UVManager
{ UVManager -> IORef (UnliftedArray (MVar Int))
uvmBlockTable :: {-# UNPACK #-} !(IORef (UnliftedArray (MVar Int)))
, UVManager -> Ptr UVLoop
uvmLoop :: {-# UNPACK #-} !(Ptr UVLoop)
, UVManager -> Ptr UVLoopData
uvmLoopData :: {-# UNPACK #-} !(Ptr UVLoopData)
, UVManager -> MVar Bool
uvmRunning :: {-# UNPACK #-} !(MVar Bool)
, UVManager -> Int
uvmCap :: {-# UNPACK #-} !Int
}
instance Show UVManager where show :: UVManager -> [Char]
show = forall a. Print a => a -> [Char]
T.toString
instance T.Print UVManager where
{-# INLINABLE toUTF8BuilderP #-}
toUTF8BuilderP :: Int -> UVManager -> Builder ()
toUTF8BuilderP Int
p UVManager
uvm = Bool -> Builder () -> Builder ()
T.parenWhen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
Builder ()
"UVManager on capability " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. (Integral a, Bounded a) => a -> Builder ()
T.int (UVManager -> Int
uvmCap UVManager
uvm)
uvManagerArray :: IORef (SmallArray UVManager)
{-# NOINLINE uvManagerArray #-}
uvManagerArray :: IORef (SmallArray UVManager)
uvManagerArray = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Int
numCaps <- IO Int
getNumCapabilities
MArr SmallArray RealWorld UVManager
uvmArray <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
newArr Int
numCaps
QSemN
s <- Int -> IO QSemN
newQSemN Int
0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
numCapsforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
Int -> IO () -> IO ThreadId
forkOn Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (HasCallStack => Int -> Int -> Resource UVManager
initUVManager Int
INIT_LOOP_SIZE Int
i) forall a b. (a -> b) -> a -> b
$ \ UVManager
m -> do
IO ThreadId
myThreadId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ThreadId -> [Char] -> IO ()
`labelThread` ([Char]
"uv manager on " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i))
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr SmallArray RealWorld UVManager
uvmArray Int
i UVManager
m
QSemN -> Int -> IO ()
signalQSemN QSemN
s Int
1
HasCallStack => UVManager -> IO ()
startUVManager UVManager
m
QSemN -> Int -> IO ()
waitQSemN QSemN
s Int
numCaps
SmallArray UVManager
iuvmArray <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr SmallArray RealWorld UVManager
uvmArray
forall a. a -> IO (IORef a)
newIORef SmallArray UVManager
iuvmArray
getUVManager :: IO UVManager
{-# INLINABLE getUVManager #-}
getUVManager :: IO UVManager
getUVManager = do
(Int
cap, Bool
_) <- ThreadId -> IO (Int, Bool)
threadCapability forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ThreadId
myThreadId
SmallArray UVManager
uvmArray <- forall a. IORef a -> IO a
readIORef IORef (SmallArray UVManager)
uvManagerArray
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m, HasCallStack) =>
arr a -> Int -> m a
indexArrM SmallArray UVManager
uvmArray (Int
cap forall a. Integral a => a -> a -> a
`rem` forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr SmallArray UVManager
uvmArray)
getBlockMVar :: UVManager -> UVSlot -> IO (MVar Int)
{-# INLINABLE getBlockMVar #-}
getBlockMVar :: UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot = do
UnliftedArray (MVar Int)
blockTable <- forall a. IORef a -> IO a
readIORef (UVManager -> IORef (UnliftedArray (MVar Int))
uvmBlockTable UVManager
uvm)
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m, HasCallStack) =>
arr a -> Int -> m a
indexArrM UnliftedArray (MVar Int)
blockTable Int
slot
pokeBufferTable :: UVManager
-> UVSlot
-> Ptr Word8
-> Int
-> IO ()
{-# INLINABLE pokeBufferTable #-}
pokeBufferTable :: UVManager -> Int -> Ptr Word8 -> Int -> IO ()
pokeBufferTable UVManager
uvm Int
slot Ptr Word8
buf Int
bufSiz = do
(Ptr (Ptr Word8)
bufTable, Ptr CSsize
bufSizTable) <- Ptr UVLoopData -> IO (Ptr (Ptr Word8), Ptr CSsize)
peekUVBufferTable (UVManager -> Ptr UVLoopData
uvmLoopData UVManager
uvm)
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (Ptr Word8)
bufTable Int
slot Ptr Word8
buf
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CSsize
bufSizTable Int
slot (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSiz)
peekBufferSizeTable :: UVManager -> UVSlot -> IO Int
{-# INLINABLE peekBufferSizeTable #-}
peekBufferSizeTable :: UVManager -> Int -> IO Int
peekBufferSizeTable UVManager
uvm Int
slot = do
(Ptr (Ptr Word8)
_, Ptr CSsize
bufSizTable) <- Ptr UVLoopData -> IO (Ptr (Ptr Word8), Ptr CSsize)
peekUVBufferTable (UVManager -> Ptr UVLoopData
uvmLoopData UVManager
uvm)
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSsize
bufSizTable Int
slot
pokeBufferSizeTable :: UVManager -> UVSlot -> Int -> IO ()
{-# INLINABLE pokeBufferSizeTable #-}
pokeBufferSizeTable :: UVManager -> Int -> Int -> IO ()
pokeBufferSizeTable UVManager
uvm Int
slot Int
bufSiz = do
(Ptr (Ptr Word8)
_, Ptr CSsize
bufSizTable) <- Ptr UVLoopData -> IO (Ptr (Ptr Word8), Ptr CSsize)
peekUVBufferTable (UVManager -> Ptr UVLoopData
uvmLoopData UVManager
uvm)
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CSsize
bufSizTable Int
slot (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSiz)
initUVManager :: HasCallStack => Int -> Int -> Resource UVManager
{-# INLINABLE initUVManager #-}
initUVManager :: HasCallStack => Int -> Int -> Resource UVManager
initUVManager Int
siz Int
cap = do
Ptr UVLoop
loop <- forall a. IO a -> (a -> IO ()) -> Resource a
initResource
(forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr UVLoop)
hs_uv_loop_init (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz))
Ptr UVLoop -> IO ()
hs_uv_loop_close
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
MArr UnliftedArray RealWorld (MVar Int)
mblockTable <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
newArr Int
siz
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
sizforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr UnliftedArray RealWorld (MVar Int)
mblockTable Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO (MVar a)
newEmptyMVar
UnliftedArray (MVar Int)
blockTable <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr UnliftedArray RealWorld (MVar Int)
mblockTable
IORef (UnliftedArray (MVar Int))
blockTableRef <- forall a. a -> IO (IORef a)
newIORef UnliftedArray (MVar Int)
blockTable
Ptr UVLoopData
loopData <- Ptr UVLoop -> IO (Ptr UVLoopData)
peekUVLoopData Ptr UVLoop
loop
MVar Bool
runningLock <- forall a. a -> IO (MVar a)
newMVar Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef (UnliftedArray (MVar Int))
-> Ptr UVLoop -> Ptr UVLoopData -> MVar Bool -> Int -> UVManager
UVManager IORef (UnliftedArray (MVar Int))
blockTableRef Ptr UVLoop
loop Ptr UVLoopData
loopData MVar Bool
runningLock Int
cap)
withUVManager :: HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
{-# INLINABLE withUVManager #-}
withUVManager :: forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager (UVManager IORef (UnliftedArray (MVar Int))
_ Ptr UVLoop
loop Ptr UVLoopData
loopData MVar Bool
runningLock Int
_) Ptr UVLoop -> IO a
f = IO a
go
where
go :: IO a
go = do
Maybe a
r <- forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Bool
runningLock forall a b. (a -> b) -> a -> b
$ \ Bool
running -> do
if Bool
running
then do
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoopData -> IO CInt
hs_uv_wake_up_async Ptr UVLoopData
loopData)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
!a
r <- Ptr UVLoop -> IO a
f Ptr UVLoop
loop
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
r)
case Maybe a
r of
Just a
r' -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r'
Maybe a
_ -> IO ()
yield forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
go
withUVManager' :: HasCallStack => UVManager -> IO a -> IO a
{-# INLINABLE withUVManager' #-}
withUVManager' :: forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm IO a
f = forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm (\ Ptr UVLoop
_ -> IO a
f)
startUVManager :: HasCallStack => UVManager -> IO ()
{-# INLINABLE startUVManager #-}
startUVManager :: HasCallStack => UVManager -> IO ()
startUVManager uvm :: UVManager
uvm@(UVManager IORef (UnliftedArray (MVar Int))
_ Ptr UVLoop
_ Ptr UVLoopData
_ MVar Bool
runningLock Int
_) = IO ()
poll
where
poll :: IO ()
poll = do
Int
e <- forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Bool
runningLock forall a b. (a -> b) -> a -> b
$ \ Bool
_ -> UVManager -> Bool -> IO Int
step UVManager
uvm Bool
False
if Int
e forall a. Ord a => a -> a -> Bool
> Int
0
then IO ()
yield forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
poll
else do
IO ()
yield
Int
e' <- forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Bool
runningLock forall a b. (a -> b) -> a -> b
$ \ Bool
_ -> UVManager -> Bool -> IO Int
step UVManager
uvm Bool
False
if Int
e' forall a. Ord a => a -> a -> Bool
> Int
0 then IO ()
yield forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
poll
else do
Bool
_ <- forall a. MVar a -> a -> IO a
swapMVar MVar Bool
runningLock Bool
True
Int
_ <- UVManager -> Bool -> IO Int
step UVManager
uvm Bool
True
Bool
_ <- forall a. MVar a -> a -> IO a
swapMVar MVar Bool
runningLock Bool
False
IO ()
yield
IO ()
poll
step :: UVManager -> Bool -> IO Int
step :: UVManager -> Bool -> IO Int
step (UVManager IORef (UnliftedArray (MVar Int))
blockTableRef Ptr UVLoop
loop Ptr UVLoopData
loopData MVar Bool
_ Int
_) Bool
block = do
UnliftedArray (MVar Int)
blockTable <- forall a. IORef a -> IO a
readIORef IORef (UnliftedArray (MVar Int))
blockTableRef
Ptr UVLoopData -> IO ()
clearUVEventCounter Ptr UVLoopData
loopData
if Bool
block
then if Bool
rtsSupportsBoundThreads
then forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ forall a b. (a -> b) -> a -> b
$ Ptr UVLoop -> CInt -> IO CInt
uv_run_safe Ptr UVLoop
loop CInt
UV_RUN_ONCE
else do
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoopData -> IO CInt
hs_uv_wake_up_timer Ptr UVLoopData
loopData)
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> CInt -> IO CInt
uv_run Ptr UVLoop
loop CInt
UV_RUN_ONCE)
else forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> CInt -> IO CInt
uv_run Ptr UVLoop
loop CInt
UV_RUN_NOWAIT)
(Int
c, Ptr Int
q) <- Ptr UVLoopData -> IO (Int, Ptr Int)
peekUVEventQueue Ptr UVLoopData
loopData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
cforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
Int
slot <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
q Int
i
MVar Int
lock <- forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m, HasCallStack) =>
arr a -> Int -> m a
indexArrM UnliftedArray (MVar Int)
blockTable Int
slot
!Int
r <- UVManager -> Int -> IO Int
peekBufferSizeTable UVManager
uvm Int
slot
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar Int
lock Int
r
forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO UVSlot
{-# INLINABLE getUVSlot #-}
getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO Int
getUVSlot (UVManager IORef (UnliftedArray (MVar Int))
blockTableRef Ptr UVLoop
_ Ptr UVLoopData
_ MVar Bool
_ Int
_) IO UVSlotUnsafe
f = do
Int
slot <- forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (UVSlotUnsafe -> Int
unsafeGetSlot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UVSlotUnsafe
f)
UnliftedArray (MVar Int)
blockTable <- forall a. IORef a -> IO a
readIORef IORef (UnliftedArray (MVar Int))
blockTableRef
let oldSiz :: Int
oldSiz = forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr UnliftedArray (MVar Int)
blockTable
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
slot forall a. Eq a => a -> a -> Bool
== Int
oldSiz) forall a b. (a -> b) -> a -> b
$ do
let newSiz :: Int
newSiz = Int
oldSiz forall a. Bits a => a -> Int -> a
`shiftL` Int
2
MArr UnliftedArray RealWorld (MVar Int)
blockTable' <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
newArr Int
newSiz
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr UnliftedArray RealWorld (MVar Int)
blockTable' Int
0 UnliftedArray (MVar Int)
blockTable Int
0 Int
oldSiz
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
oldSiz..Int
newSizforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i ->
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr UnliftedArray RealWorld (MVar Int)
blockTable' Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO (MVar a)
newEmptyMVar
!UnliftedArray (MVar Int)
iBlockTable' <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr UnliftedArray RealWorld (MVar Int)
blockTable'
forall a. IORef a -> a -> IO ()
writeIORef IORef (UnliftedArray (MVar Int))
blockTableRef UnliftedArray (MVar Int)
iBlockTable'
forall (m :: * -> *) a. Monad m => a -> m a
return Int
slot
cancelUVReq :: UVManager -> UVSlot -> (Int -> IO ()) -> IO ()
{-# INLINABLE cancelUVReq #-}
cancelUVReq :: UVManager -> Int -> (Int -> IO ()) -> IO ()
cancelUVReq UVManager
uvm Int
slot Int -> IO ()
extra_cleanup = forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> do
MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot
Maybe Int
r <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
case Maybe Int
r of
Just Int
r' -> Int -> IO ()
extra_cleanup Int
r'
Maybe Int
_ -> do
UVManager -> Int -> Ptr Word8 -> Int -> IO ()
pokeBufferTable UVManager
uvm Int
slot forall a. Ptr a
nullPtr Int
0
Ptr UVLoop -> Int -> IO ()
hs_uv_cancel Ptr UVLoop
loop Int
slot
withUVRequest :: HasCallStack
=> UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
{-# INLINABLE withUVRequest #-}
withUVRequest :: HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
withUVRequest UVManager
uvm Ptr UVLoop -> IO UVSlotUnsafe
f = do
(Int
slot, MVar Int
m) <- forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
Int
slot <- HasCallStack => UVManager -> IO UVSlotUnsafe -> IO Int
getUVSlot UVManager
uvm (Ptr UVLoop -> IO UVSlotUnsafe
f Ptr UVLoop
loop)
MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot
Maybe Int
_ <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
slot, MVar Int
m)
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (forall a. MVar a -> IO a
takeMVar MVar Int
m forall a b. IO a -> IO b -> IO a
`onException` UVManager -> Int -> (Int -> IO ()) -> IO ()
cancelUVReq UVManager
uvm Int
slot forall {b}. b -> IO ()
no_extra_cleanup)
where no_extra_cleanup :: b -> IO ()
no_extra_cleanup = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
withUVRequest_ :: HasCallStack
=> UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO ()
{-# INLINABLE withUVRequest_ #-}
withUVRequest_ :: HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO ()
withUVRequest_ UVManager
uvm Ptr UVLoop -> IO UVSlotUnsafe
f = forall (f :: * -> *) a. Functor f => f a -> f ()
void (HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
withUVRequest UVManager
uvm Ptr UVLoop -> IO UVSlotUnsafe
f)
withUVRequest' :: HasCallStack
=> UVManager
-> (Ptr UVLoop -> IO UVSlotUnsafe)
-> (Int -> IO b)
-> IO b
{-# INLINABLE withUVRequest' #-}
withUVRequest' :: forall b.
HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO b) -> IO b
withUVRequest' UVManager
uvm Ptr UVLoop -> IO UVSlotUnsafe
f Int -> IO b
g = do
(Int
slot, MVar Int
m) <- forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
Int
slot <- HasCallStack => UVManager -> IO UVSlotUnsafe -> IO Int
getUVSlot UVManager
uvm (Ptr UVLoop -> IO UVSlotUnsafe
f Ptr UVLoop
loop)
MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot
Maybe Int
_ <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
slot, MVar Int
m)
Int -> IO b
g forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall a. MVar a -> IO a
takeMVar MVar Int
m forall a b. IO a -> IO b -> IO a
`onException` UVManager -> Int -> (Int -> IO ()) -> IO ()
cancelUVReq UVManager
uvm Int
slot forall {b}. b -> IO ()
no_extra_cleanup)
where no_extra_cleanup :: b -> IO ()
no_extra_cleanup = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
withUVRequestEx :: HasCallStack
=> UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int
{-# INLINABLE withUVRequestEx #-}
withUVRequestEx :: HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int
withUVRequestEx UVManager
uvm Ptr UVLoop -> IO UVSlotUnsafe
f Int -> IO ()
extra_cleanup = do
(Int
slot, MVar Int
m) <- forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
Int
slot <- HasCallStack => UVManager -> IO UVSlotUnsafe -> IO Int
getUVSlot UVManager
uvm (Ptr UVLoop -> IO UVSlotUnsafe
f Ptr UVLoop
loop)
MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot
Maybe Int
_ <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
slot, MVar Int
m)
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (forall a. MVar a -> IO a
takeMVar MVar Int
m forall a b. IO a -> IO b -> IO a
`onException` UVManager -> Int -> (Int -> IO ()) -> IO ()
cancelUVReq UVManager
uvm Int
slot Int -> IO ()
extra_cleanup)
forkBa :: IO () -> IO ThreadId
{-# INLINABLE forkBa #-}
forkBa :: IO () -> IO ThreadId
forkBa IO ()
io = do
Int
i <- Counter -> Int -> IO Int
atomicAddCounter Counter
counter Int
1
Int -> IO () -> IO ThreadId
forkOn Int
i IO ()
io
where
counter :: Counter
{-# NOINLINE counter #-}
counter :: Counter
counter = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ Int -> IO Counter
newCounter Int
0