packages feed

posix-api 0.6.1.0 → 0.7.0.0

raw patch · 5 files changed

+216/−151 lines, 5 filesdep ~basedep ~primitive-unlifted

Dependency ranges changed: base, primitive-unlifted

Files

CHANGELOG.md view
@@ -7,6 +7,14 @@  This project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.7.0.0] - 2023-08-30++- For now, remove all of the functions that work on UnliftedArray. These+  will be added back later once hackage starts using GHC 9.4. They are+  now guarded by CPP, so if anyone was using them, build this library+  with the `UNLIFTEDARRAYFUNCTIONS` flag to get them back.+- Add `uninterruptibleConnectPtr` for better compatibility with `network`.+ ## [0.6.1.0] - 2023-08-14  - Add `uninterruptibleWriteBytesCompletelyErrno`
posix-api.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: posix-api-version: 0.6.1.0+version: 0.7.0.0 synopsis: posix bindings description:   This library provides a very thin wrapper around POSIX APIs. It can be@@ -76,6 +76,13 @@   description: Extra run-time invariant checking    default: False +-- This only exists to help get this library to build on hackage.+-- Whenever hackage moves to GHC 9.4, remove this.+flag unliftedarrayfunctions+  manual: True+  description: Build and export functions using unlifted arrays+  default: False+ library   exposed-modules:     Foreign.C.String.Managed@@ -102,15 +109,16 @@     Posix.Socket.Types     Assertion   build-depends:-    , base >=4.17.1 && <5+    , base >=4.16.3 && <5     , byte-order >= 0.1.2 && <0.2     , byteslice >= 0.2.10 && <0.3     , primitive >= 0.7 && <0.10     , primitive-addr >= 0.1 && <0.2     , primitive-offset >= 0.2 && <0.3-    , primitive-unlifted >= 2.0 && <2.2     , run-st >= 0.1.1 && <0.2     , text-short >=0.1.5+  if flag(unliftedarrayfunctions)+    build-depends: primitive-unlifted >=2.1 && <2.2   hs-source-dirs: src   if flag(assertions)     hs-source-dirs: src-assertions
src/Linux/Socket.hs view
@@ -1,4 +1,5 @@ {-# language BangPatterns #-}+{-# language CPP #-} {-# language DataKinds #-} {-# language MagicHash #-} {-# language ScopedTypeVariables #-}@@ -7,12 +8,14 @@  module Linux.Socket   ( -- * Functions-    uninterruptibleReceiveMultipleMessageA+    uninterruptibleAccept4+  , uninterruptibleAccept4_+#if defined(UNLIFTEDARRAYFUNCTIONS)+  , uninterruptibleReceiveMultipleMessageA   , uninterruptibleReceiveMultipleMessageB   , uninterruptibleReceiveMultipleMessageC   , uninterruptibleReceiveMultipleMessageD-  , uninterruptibleAccept4-  , uninterruptibleAccept4_+#endif     -- * Types   , SocketFlags(..)     -- * Option Names@@ -52,9 +55,11 @@ import Data.Bits ((.|.)) import Data.Primitive (MutableByteArray(..),ByteArray(..),MutablePrimArray(..)) import Data.Primitive.Addr (Addr(..),plusAddr,nullAddr)+#if defined(UNLIFTEDARRAYFUNCTIONS) import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray) import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray)) import Data.Primitive.Unlifted.Array.Primops (MutableUnliftedArray#(MutableUnliftedArray#))+#endif import Data.Void (Void) import Data.Word (Word8) import Foreign.C.Error (Errno,getErrno)@@ -69,7 +74,9 @@  import qualified Control.Monad.Primitive as PM import qualified Data.Primitive as PM+#if defined(UNLIFTEDARRAYFUNCTIONS) import qualified Data.Primitive.Unlifted.Array as PM+#endif import qualified Linux.Socket.Types as LST import qualified Posix.Socket as S @@ -99,6 +106,7 @@      -> SocketFlags      -> IO Fd +#if defined(UNLIFTEDARRAYFUNCTIONS) foreign import ccall unsafe "HaskellPosix.h recvmmsg_sockaddr_in"   c_unsafe_recvmmsg_sockaddr_in ::        Fd@@ -117,6 +125,7 @@     -> CUInt -- Length of msghdr array     -> MessageFlags 'Receive     -> IO CInt+#endif  -- | Linux extends the @type@ argument of --   <http://man7.org/linux/man-pages/man2/socket.2.html socket> to allow@@ -135,6 +144,7 @@ applySocketFlags :: SocketFlags -> Type -> Type applySocketFlags (SocketFlags s) (Type t) = Type (s .|. t) +#if defined(UNLIFTEDARRAYFUNCTIONS) -- | Receive multiple messages. This does not provide the socket --   addresses or the control messages. It does not use any of the --   input-scattering that @recvmmsg@ offers, meaning that a single@@ -343,6 +353,7 @@     else do       a <- PM.unsafeFreezeUnliftedArray r       pure (validation,maxMsgSz,a)+#endif  pokeMultipleMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> CUInt -> IO () pokeMultipleMessageHeader mmsgHdrAddr a b c d e f g len = do@@ -419,8 +430,10 @@ touchMutableByteArray# :: MutableByteArray# RealWorld -> IO () touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #) +#if defined(UNLIFTEDARRAYFUNCTIONS) touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO () touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x  touchMutableUnliftedArray# :: MutableUnliftedArray# RealWorld a -> IO () touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)+#endif
src/Posix/File.hs view
@@ -16,6 +16,7 @@   , writeBytesCompletelyErrno   , uninterruptibleOpen   , uninterruptibleOpenMode+  , uninterruptibleOpenUntypedFlags   , writeByteArray   , writeMutableByteArray   , close@@ -116,6 +117,15 @@   -> IO (Either Errno Fd) uninterruptibleOpen (ManagedCString (ByteArray name)) (AccessMode x) (CreationFlags y) (StatusFlags z) =   c_unsafe_open name (x .|. y .|. z) >>= errorsFromFd++-- | Variant of 'uninterruptibleOpen' that does not help the caller with+-- the types of the flags.+uninterruptibleOpenUntypedFlags ::+     ManagedCString -- ^ NULL-terminated file name+  -> CInt -- ^ Flags+  -> IO (Either Errno Fd)+uninterruptibleOpenUntypedFlags (ManagedCString (ByteArray name)) x =+  c_unsafe_open name x >>= errorsFromFd  uninterruptibleOpenMode ::      ManagedCString -- ^ NULL-terminated file name
src/Posix/Socket.hs view
@@ -42,6 +42,7 @@     -- ** Connect   , connect   , uninterruptibleConnect+  , uninterruptibleConnectPtr     -- ** Listen   , uninterruptibleListen     -- ** Accept@@ -76,7 +77,9 @@   , uninterruptibleSendToInternetByteArray   , uninterruptibleSendToInternetMutableByteArray     -- ** Write Vector+#if defined(UNLIFTEDARRAYFUNCTIONS)   , writeVector+#endif     -- ** Receive   , receive   , receiveByteArray@@ -90,12 +93,16 @@   , uninterruptibleReceiveFromInternetMutableByteArray     -- ** Receive Message     -- $receiveMessage+#if defined(UNLIFTEDARRAYFUNCTIONS)   , uninterruptibleReceiveMessageA   , uninterruptibleReceiveMessageB+#endif     -- ** Send Message   , uninterruptibleSendMessageA   , uninterruptibleSendMessageB+#if defined(UNLIFTEDARRAYFUNCTIONS)   , uninterruptibleSendByteArrays+#endif     -- ** Byte-Order Conversion     -- $conversion   , hostToNetworkLong@@ -206,9 +213,13 @@ import GHC.IO (IO(..)) import Data.Primitive.Addr (Addr(..),plusAddr,nullAddr) import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),ByteArray(..))++#if defined(UNLIFTEDARRAYFUNCTIONS) import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray,UnliftedArray_(UnliftedArray)) import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray)) import Data.Primitive.Unlifted.Array.Primops (UnliftedArray#(UnliftedArray#),MutableUnliftedArray#)+#endif+ import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..)) import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset(..)) import Data.Word (Word8,Word16,Word32,byteSwap16,byteSwap32)@@ -217,7 +228,7 @@ import Foreign.C.String (CString) import Foreign.C.Types (CInt(..),CSize(..)) import Foreign.Ptr (nullPtr)-import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#)+import GHC.Exts (Ptr(Ptr),RealWorld,ByteArray#,MutableByteArray#) import GHC.Exts (Addr#,TYPE) import GHC.Exts (Int(I#)) import GHC.Exts (shrinkMutableByteArray#,touch#)@@ -237,7 +248,9 @@ import qualified Posix.File as F import qualified Posix.Socket.Types as PST import qualified Data.Primitive as PM+#if defined(UNLIFTEDARRAYFUNCTIONS) import qualified Data.Primitive.Unlifted.Array as PM+#endif import qualified Control.Monad.Primitive as PM import qualified GHC.Exts as Exts @@ -348,6 +361,8 @@   c_safe_mutablebytearray_connect :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CInt foreign import ccall unsafe "sys/socket.h connect"   c_unsafe_connect :: Fd -> ByteArray# -> CInt -> IO CInt+foreign import ccall unsafe "sys/socket.h connect"+  c_unsafe_connect_addr :: Fd -> Addr# -> CInt -> IO CInt  -- There are several options for wrapping send. Both safe and unsafe -- are useful. Additionally, in the unsafe category, we also@@ -390,8 +405,10 @@ foreign import ccall unsafe "HaskellPosix.h sendmsg_b"   c_unsafe_sendmsg_b :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize +#if defined(UNLIFTEDARRAYFUNCTIONS) foreign import ccall unsafe "HaskellPosix.h sendmsg_bytearrays"   c_unsafe_sendmsg_bytearrays :: Fd -> UnliftedArray# ByteArray# -> Int -> Int -> Int -> MessageFlags 'Send -> IO CSsize+#endif  foreign import ccall safe "sys/uio.h writev"   c_safe_writev :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CSsize@@ -549,6 +566,14 @@ uninterruptibleConnect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =   c_unsafe_connect fd sockAddr# (intToCInt (PM.sizeofByteArray sockAddr)) >>= errorsFromInt_ +uninterruptibleConnectPtr ::+     Fd -- ^ Fd+  -> Ptr a -- ^ Socket address+  -> Int -- ^ Size of socket address+  -> IO (Either Errno ())+uninterruptibleConnectPtr !fd (Ptr sockAddr#) !sz =+  c_unsafe_connect_addr fd sockAddr# (intToCInt sz) >>= errorsFromInt_+ -- | Extract the first connection on the queue of pending connections. The --   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification> --   includes more details. This function\'s type differs slightly from@@ -735,50 +760,6 @@     PM.copyByteArray x off b 0 (csizeToInt len)     errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags --- | Write data from multiple byte arrays to the file/socket associated---   with the file descriptor. This does not support slicing. The---   <http://pubs.opengroup.org/onlinepubs/009604499/functions/writev.html POSIX specification>---   of @writev@ includes more details.-writeVector ::-     Fd -- ^ Socket-  -> UnliftedArray ByteArray -- ^ Source byte arrays-  -> IO (Either Errno CSize)-writeVector fd buffers = do-  iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <--    PM.newPinnedByteArray-      (cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)--  -- We construct a list of the new buffers for the sole purpose-  -- of ensuring that we can touch the list later to keep all-  -- the new buffers live.-  newBufs <- foldDownward (PM.sizeofUnliftedArray buffers) UNil $ \newBufs i -> do-    let !buf = PM.indexUnliftedArray buffers i-    pinByteArray buf >>= \case-      Nothing -> do-        let buffer = buf-        let targetAddr :: Addr-            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`-              (i * cintToInt PST.sizeofIOVector)-        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))-        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))-        pure newBufs-      Just buffer -> do-        let targetAddr :: Addr-            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`-              (i * cintToInt PST.sizeofIOVector)-        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))-        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))-        pure (UCons (unByteArray buffer) newBufs)-  r <- errorsFromSize =<<-    c_safe_writev fd iovecs# (intToCInt (PM.sizeofUnliftedArray buffers))-  -- Touching both the unlifted array and the list of new buffers-  -- here is crucial to ensuring that-  -- the buffers do not get GCed before c_safe_writev. Just touching-  -- them should keep all of their children alive too.-  touchUnliftedArray buffers-  touchLifted newBufs-  pure r- #if MIN_VERSION_base(4,16,0) data UList (a :: TYPE ('BoxedRep 'Unlifted)) where #else@@ -843,23 +824,6 @@     c_unsafe_sendmsg_b fd (unMba array) offset lenB addr lenA flags       >>= errorsFromSize --- | Send many immutable byte arrays with @sendmsg@.--- This accepts a slice into the chunks. Additionally,--- this accepts an offset into the first chunk.-uninterruptibleSendByteArrays ::-     Fd -- ^ Socket-  -> UnliftedArray ByteArray -- ^ Byte arrays-  -> Int -- ^ Offset into byte array chunks-  -> Int -- ^ Number of chunks to send-  -> Int -- ^ Offset into first chunk-  -> MessageFlags 'Send-  -> IO (Either Errno CSize)-{-# inline uninterruptibleSendByteArrays #-}-uninterruptibleSendByteArrays !fd (UnliftedArray arrs)-  off !len !offC !flags =-    c_unsafe_sendmsg_bytearrays fd arrs off len offC flags-      >>= errorsFromSize- -- | Send data from a mutable byte array over a network socket. Users --   may specify an offset and a length to send fewer bytes than are --   actually present in the array. Since this uses the safe@@ -1167,86 +1131,9 @@   c_unsafe_addr_peerless_recvfrom fd b len flags     >>= errorsFromSize --- | Receive a message, scattering the input. This does not provide---   the socket address or the control messages. All of the chunks---   must have the same maximum size. All resulting byte arrays have---   been explicitly pinned.-uninterruptibleReceiveMessageA ::-     Fd -- ^ Socket-  -> CSize -- ^ Maximum bytes per chunk-  -> CSize -- ^ Maximum number of chunks-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno (CSize,UnliftedArray ByteArray))-uninterruptibleReceiveMessageA !s !chunkSize !chunkCount !flags = do-  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)-  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeIOVectors bufs iovecsAddr chunkSize chunkCount-  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)-  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)-  pokeMessageHeader msgHdrAddr nullAddr 0 iovecsAddr chunkCount nullAddr 0 flags-  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags-  if r > (-1)-    then do-      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs-      frozenBufs <- deepFreezeIOVectors filled bufs-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      pure (Right (cssizeToCSize r,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      fmap Left getErrno- ptrToAddr :: Ptr Word8 -> Addr ptrToAddr (Exts.Ptr a) = Addr a --- | Receive a message, scattering the input. This provides the socket---   address but does not include control messages. All of the chunks---   must have the same maximum size. All resulting byte arrays have---   been explicitly pinned.-uninterruptibleReceiveMessageB ::-     Fd -- ^ Socket-  -> CSize -- ^ Maximum bytes per chunk-  -> CSize -- ^ Maximum number of chunks-  -> MessageFlags 'Receive -- ^ Flags-  -> CInt -- ^ Maximum socket address size-  -> IO (Either Errno (CInt,SocketAddress,CSize,UnliftedArray ByteArray))-uninterruptibleReceiveMessageB !s !chunkSize !chunkCount !flags !maxSockAddrSz = do-  sockAddrBuf <- PM.newPinnedByteArray (cintToInt maxSockAddrSz)-  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)-  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeIOVectors bufs iovecsAddr chunkSize chunkCount-  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)-  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)-  pokeMessageHeader msgHdrAddr-    (ptrToAddr (PM.mutableByteArrayContents sockAddrBuf)) maxSockAddrSz iovecsAddr-    chunkCount nullAddr 0 flags-  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags-  if r > (-1)-    then do-      actualSockAddrSz <- PST.peekMessageHeaderNameLength msgHdrAddr-      if actualSockAddrSz < maxSockAddrSz-        then shrinkMutableByteArray sockAddrBuf (cintToInt actualSockAddrSz)-        else pure ()-      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf-      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs-      frozenBufs <- deepFreezeIOVectors filled bufs-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      touchMutableByteArray sockAddrBuf-      pure (Right (actualSockAddrSz,SocketAddress sockAddr,cssizeToCSize r,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      touchMutableByteArray sockAddrBuf-      fmap Left getErrno- -- | Shutdown a socket. This uses the unsafe FFI. uninterruptibleShutdown ::      Fd@@ -1330,6 +1217,144 @@   PST.pokeMessageHeaderControlLength msgHdrAddr f   PST.pokeMessageHeaderFlags msgHdrAddr g +#if defined(UNLIFTEDARRAYFUNCTIONS)+-- | Write data from multiple byte arrays to the file/socket associated+--   with the file descriptor. This does not support slicing. The+--   <http://pubs.opengroup.org/onlinepubs/009604499/functions/writev.html POSIX specification>+--   of @writev@ includes more details.+writeVector ::+     Fd -- ^ Socket+  -> UnliftedArray ByteArray -- ^ Source byte arrays+  -> IO (Either Errno CSize)+writeVector fd buffers = do+  iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <-+    PM.newPinnedByteArray+      (cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)+  -- We construct a list of the new buffers for the sole purpose+  -- of ensuring that we can touch the list later to keep all+  -- the new buffers live.+  newBufs <- foldDownward (PM.sizeofUnliftedArray buffers) UNil $ \newBufs i -> do+    let !buf = PM.indexUnliftedArray buffers i+    pinByteArray buf >>= \case+      Nothing -> do+        let buffer = buf+        let targetAddr :: Addr+            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`+              (i * cintToInt PST.sizeofIOVector)+        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))+        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))+        pure newBufs+      Just buffer -> do+        let targetAddr :: Addr+            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`+              (i * cintToInt PST.sizeofIOVector)+        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))+        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))+        pure (UCons (unByteArray buffer) newBufs)+  r <- errorsFromSize =<<+    c_safe_writev fd iovecs# (intToCInt (PM.sizeofUnliftedArray buffers))+  -- Touching both the unlifted array and the list of new buffers+  -- here is crucial to ensuring that+  -- the buffers do not get GCed before c_safe_writev. Just touching+  -- them should keep all of their children alive too.+  touchUnliftedArray buffers+  touchLifted newBufs+  pure r++-- | Send many immutable byte arrays with @sendmsg@.+-- This accepts a slice into the chunks. Additionally,+-- this accepts an offset into the first chunk.+uninterruptibleSendByteArrays ::+     Fd -- ^ Socket+  -> UnliftedArray ByteArray -- ^ Byte arrays+  -> Int -- ^ Offset into byte array chunks+  -> Int -- ^ Number of chunks to send+  -> Int -- ^ Offset into first chunk+  -> MessageFlags 'Send+  -> IO (Either Errno CSize)+{-# inline uninterruptibleSendByteArrays #-}+uninterruptibleSendByteArrays !fd (UnliftedArray arrs)+  off !len !offC !flags =+    c_unsafe_sendmsg_bytearrays fd arrs off len offC flags+      >>= errorsFromSize++-- | Receive a message, scattering the input. This does not provide+--   the socket address or the control messages. All of the chunks+--   must have the same maximum size. All resulting byte arrays have+--   been explicitly pinned.+uninterruptibleReceiveMessageA ::+     Fd -- ^ Socket+  -> CSize -- ^ Maximum bytes per chunk+  -> CSize -- ^ Maximum number of chunks+  -> MessageFlags 'Receive -- ^ Flags+  -> IO (Either Errno (CSize,UnliftedArray ByteArray))+uninterruptibleReceiveMessageA !s !chunkSize !chunkCount !flags = do+  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)+  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)+  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)+  initializeIOVectors bufs iovecsAddr chunkSize chunkCount+  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)+  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)+  pokeMessageHeader msgHdrAddr nullAddr 0 iovecsAddr chunkCount nullAddr 0 flags+  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags+  if r > (-1)+    then do+      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs+      frozenBufs <- deepFreezeIOVectors filled bufs+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      pure (Right (cssizeToCSize r,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      fmap Left getErrno++-- | Receive a message, scattering the input. This provides the socket+--   address but does not include control messages. All of the chunks+--   must have the same maximum size. All resulting byte arrays have+--   been explicitly pinned.+uninterruptibleReceiveMessageB ::+     Fd -- ^ Socket+  -> CSize -- ^ Maximum bytes per chunk+  -> CSize -- ^ Maximum number of chunks+  -> MessageFlags 'Receive -- ^ Flags+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (CInt,SocketAddress,CSize,UnliftedArray ByteArray))+uninterruptibleReceiveMessageB !s !chunkSize !chunkCount !flags !maxSockAddrSz = do+  sockAddrBuf <- PM.newPinnedByteArray (cintToInt maxSockAddrSz)+  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)+  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)+  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)+  initializeIOVectors bufs iovecsAddr chunkSize chunkCount+  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)+  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)+  pokeMessageHeader msgHdrAddr+    (ptrToAddr (PM.mutableByteArrayContents sockAddrBuf)) maxSockAddrSz iovecsAddr+    chunkCount nullAddr 0 flags+  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags+  if r > (-1)+    then do+      actualSockAddrSz <- PST.peekMessageHeaderNameLength msgHdrAddr+      if actualSockAddrSz < maxSockAddrSz+        then shrinkMutableByteArray sockAddrBuf (cintToInt actualSockAddrSz)+        else pure ()+      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf+      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs+      frozenBufs <- deepFreezeIOVectors filled bufs+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      touchMutableByteArray sockAddrBuf+      pure (Right (actualSockAddrSz,SocketAddress sockAddr,cssizeToCSize r,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      touchMutableByteArray sockAddrBuf+      fmap Left getErrno+ -- This sets up an array of iovec. The iov_len is assigned to the -- same length in all of these. The actual buffers are allocated -- and stuck in an unlifted array. Pointers to these buffers (we can@@ -1407,23 +1432,24 @@         else PM.unsafeFreezeUnliftedArray x   go 0 -unByteArray :: ByteArray -> ByteArray#-unByteArray (ByteArray x) = x- touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO () touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x  touchUnliftedArray :: UnliftedArray a -> IO () touchUnliftedArray (UnliftedArray x) = touchUnliftedArray# x -touchMutableByteArray :: MutableByteArray RealWorld -> IO ()-touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x- touchMutableUnliftedArray# :: MutableUnliftedArray# RealWorld a -> IO () touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)  touchUnliftedArray# :: UnliftedArray# a -> IO () touchUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)+#endif++unByteArray :: ByteArray -> ByteArray#+unByteArray (ByteArray x) = x++touchMutableByteArray :: MutableByteArray RealWorld -> IO ()+touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x  touchMutableByteArray# :: MutableByteArray# RealWorld -> IO () touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)