Copyright | (c) Dong Han 2017-2018 |
---|---|
License | BSD |
Maintainer | winterland1989@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This is an internal module provides IO manager which bridge libuv's async interface with ghc's lightweight thread.
The main procedures for doing event IO is:
- Allocate uv_handle in C side, get its slot number with
getUVSlot
, or allocate uv_request withwithUVRequest
. - Prepare you IO buffer with
pokeBufferTable
(read or write). - Call C side IO functions with predefined callbacks.
- Block your thread with the
MVar
fromgetBlockMVar
. - In predefined callbacks, push slot number to uv_loop's queue.
- IO polling finishes, IO manager thread will unblock blocking IO threads by filling the
MVar
with current value from buffer size table. - Slot is freed on C side, either via callbacks, or when handle is closed.
Usually slots are cache in the IO device so that you don't have to allocate new one before each IO operation. Check Z.IO.Network.TCP as an example.
Synopsis
- data UVManager = UVManager {
- uvmBlockTable :: !(IORef (UnliftedArray (MVar Int)))
- uvmLoop :: !(Ptr UVLoop)
- uvmLoopData :: !(Ptr UVLoopData)
- uvmRunning :: !(MVar Bool)
- uvmCap :: !Int
- getUVManager :: IO UVManager
- getBlockMVar :: UVManager -> UVSlot -> IO (MVar Int)
- peekBufferSizeTable :: UVManager -> UVSlot -> IO Int
- pokeBufferSizeTable :: UVManager -> UVSlot -> Int -> IO ()
- pokeBufferTable :: UVManager -> UVSlot -> Ptr Word8 -> Int -> IO ()
- withUVManager :: HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
- withUVManager' :: HasCallStack => UVManager -> IO a -> IO a
- getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO UVSlot
- withUVRequest :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
- withUVRequest_ :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO ()
- withUVRequest' :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO b) -> IO b
- withUVRequestEx :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int
- forkBa :: IO () -> IO ThreadId
Documentation
UVManager | |
|
getBlockMVar :: UVManager -> UVSlot -> IO (MVar Int) Source #
Get MVar
from blocking table with given slot.
peekBufferSizeTable :: UVManager -> UVSlot -> IO Int Source #
Peek buffer size table
The notes on pokeBufferTable
apply here too.
pokeBufferSizeTable :: UVManager -> UVSlot -> Int -> IO () Source #
Poke buffer size table
The notes on pokeBufferTable
apply here too.
Poke a prepared buffer and size into loop data under given slot.
NOTE, this action is not protected with withUVManager
for effcient reason, you should merge this action
with other uv action and put them together inside a withUVManager
or 'withUVManager''. for example:
... withUVManager' uvm $ do pokeBufferTable uvm slot buf len uvReadStart handle ...
withUVManager :: HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a Source #
Lock an uv mananger, so that we can safely mutate its uv_loop's state.
libuv is not thread safe, use this function to perform any action which will mutate uv_loop's state.
withUVManager' :: HasCallStack => UVManager -> IO a -> IO a Source #
Lock an uv mananger, so that we can safely mutate its uv_loop's state.
Some action did not request uv_loop pointer explicitly, but will mutate uv_loop underhood, for example:
uv_read_start
. These actions have to be protected by locking the uv_loop.
In fact most of the libuv's functions are not thread safe, so watch out!
getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO UVSlot Source #
Run a libuv FFI to get a UVSlotUnsafe
(which may exceed block table size),
resize the block table in that case, so that the returned slot always has an
accompanying MVar
in block table.
Always use this function to turn an UVSlotUnsafe
into UVSlot
, so that the block
table size synchronize with libuv side's slot table.
request based async function helper
withUVRequest :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int Source #
Exception safe uv request helper
This helper will run a libuv's async function, which will return a
libuv side's slot, then we will accommodate a MVar
in block table and
wait on that MVar
, until the async function finished or an exception
is received, in later case we will call cancelUVReq
to cancel the on-going
async function with best efforts,
withUVRequest_ :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO () Source #
Same with withUVRequest
but disgard the result.
:: HasCallStack | |
=> UVManager | |
-> (Ptr UVLoop -> IO UVSlotUnsafe) | |
-> (Int -> IO b) | convert function |
-> IO b |
Same with withUVRequest
but apply an convert function to result.
The convert function have all access to the returned value including negative ones, it's convert funtions's responsiblity to throw an exception if appropriate.
withUVRequestEx :: HasCallStack => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int Source #
Same with withUVRequest
, but will also run an extra cleanup function
if async exception hit this thread but the async action is already successfully performed,
e.g. release result memory.
concurrent helpers
forkBa :: IO () -> IO ThreadId Source #
Fork a new GHC thread with active load-balancing.
Using libuv based IO solution has a disadvantage that file handlers are bound to certain uv_loop, thus certain uv mananger/capability. Worker threads that migrate to other capability will lead contention since various APIs here is protected by manager's lock, this makes GHC's work-stealing strategy unsuitable for certain workload, such as a webserver. we solve this problem with simple round-robin load-balancing: forkBa will automatically distribute new threads to all capabilities in round-robin manner. Thus its name forkBa(lance).