{-# OPTIONS_GHC -optc-D_XOPEN_SOURCE=500 #-}
{-# LINE 1 "System/Posix/IO/Extra.hsc" #-}
module System.Posix.IO.Extra(writev, pwrite, pread) where
{-# LINE 2 "System/Posix/IO/Extra.hsc" #-}


{-# LINE 4 "System/Posix/IO/Extra.hsc" #-}

{-# LINE 5 "System/Posix/IO/Extra.hsc" #-}

{-# LINE 6 "System/Posix/IO/Extra.hsc" #-}

import Foreign
import Foreign.C
import Control.Monad
import System.Posix.Types

foreign import ccall safe "writev" cwritev :: Fd -> Ptr () -> CInt -> IO ByteCount

writev :: Fd -> [(Ptr a, Int)] -> IO ByteCount
writev fd lst = do
  let len = length lst
  allocaBytes (((8)) * len) $ \iovs -> do
{-# LINE 18 "System/Posix/IO/Extra.hsc" #-}
  let w i (p,pl) = do let iov = plusPtr iovs (((8)) * i)
{-# LINE 19 "System/Posix/IO/Extra.hsc" #-}
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) iov p
{-# LINE 20 "System/Posix/IO/Extra.hsc" #-}
                      ((\hsc_ptr -> pokeByteOff hsc_ptr 4))  iov pl
{-# LINE 21 "System/Posix/IO/Extra.hsc" #-}
  zipWithM_ w [0..] lst
  throwErrnoIfMinus1Retry "writev" $ cwritev fd iovs $ fromIntegral len

foreign import ccall safe pwrite64 :: Fd -> Ptr a -> CSize -> COff -> IO ByteCount
foreign import ccall safe pread64  :: Fd -> Ptr a -> CSize -> COff -> IO ByteCount

pwrite :: Fd -> Ptr a -> Int -> COff -> IO ByteCount
pwrite fd ptr len off = throwErrnoIfMinus1Retry "pwrite" $ pwrite64 fd ptr (fromIntegral len) off

pread :: Fd -> Ptr a -> Int -> COff -> IO ByteCount
pread fd ptr len off = throwErrnoIfMinus1Retry "pread" $ pread64 fd ptr (fromIntegral len) off