{-# LINE 1 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Driver.IPC.Marshal (
IPCDevicePtr, IPCFlag(..),
export, open, close,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 30 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
import Foreign.CUDA.Ptr
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Driver.Marshal
import Control.Monad
import Prelude
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal
newtype IPCDevicePtr a = IPCDevicePtr { IPCDevicePtr a -> IPCMemHandle
useIPCDevicePtr :: IPCMemHandle }
deriving (IPCDevicePtr a -> IPCDevicePtr a -> Bool
(IPCDevicePtr a -> IPCDevicePtr a -> Bool)
-> (IPCDevicePtr a -> IPCDevicePtr a -> Bool)
-> Eq (IPCDevicePtr a)
forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPCDevicePtr a -> IPCDevicePtr a -> Bool
$c/= :: forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
== :: IPCDevicePtr a -> IPCDevicePtr a -> Bool
$c== :: forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
Eq, Int -> IPCDevicePtr a -> ShowS
[IPCDevicePtr a] -> ShowS
IPCDevicePtr a -> String
(Int -> IPCDevicePtr a -> ShowS)
-> (IPCDevicePtr a -> String)
-> ([IPCDevicePtr a] -> ShowS)
-> Show (IPCDevicePtr a)
forall a. Int -> IPCDevicePtr a -> ShowS
forall a. [IPCDevicePtr a] -> ShowS
forall a. IPCDevicePtr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPCDevicePtr a] -> ShowS
$cshowList :: forall a. [IPCDevicePtr a] -> ShowS
show :: IPCDevicePtr a -> String
$cshow :: forall a. IPCDevicePtr a -> String
showsPrec :: Int -> IPCDevicePtr a -> ShowS
$cshowsPrec :: forall a. Int -> IPCDevicePtr a -> ShowS
Show)
data IPCFlag = LazyEnablePeerAccess
deriving (IPCFlag -> IPCFlag -> Bool
(IPCFlag -> IPCFlag -> Bool)
-> (IPCFlag -> IPCFlag -> Bool) -> Eq IPCFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPCFlag -> IPCFlag -> Bool
$c/= :: IPCFlag -> IPCFlag -> Bool
== :: IPCFlag -> IPCFlag -> Bool
$c== :: IPCFlag -> IPCFlag -> Bool
Eq,Int -> IPCFlag -> ShowS
[IPCFlag] -> ShowS
IPCFlag -> String
(Int -> IPCFlag -> ShowS)
-> (IPCFlag -> String) -> ([IPCFlag] -> ShowS) -> Show IPCFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPCFlag] -> ShowS
$cshowList :: [IPCFlag] -> ShowS
show :: IPCFlag -> String
$cshow :: IPCFlag -> String
showsPrec :: Int -> IPCFlag -> ShowS
$cshowsPrec :: Int -> IPCFlag -> ShowS
Show,IPCFlag
IPCFlag -> IPCFlag -> Bounded IPCFlag
forall a. a -> a -> Bounded a
maxBound :: IPCFlag
$cmaxBound :: IPCFlag
minBound :: IPCFlag
$cminBound :: IPCFlag
Bounded)
instance Enum IPCFlag where
succ :: IPCFlag -> IPCFlag
succ IPCFlag
LazyEnablePeerAccess = String -> IPCFlag
forall a. HasCallStack => String -> a
error String
"IPCFlag.succ: LazyEnablePeerAccess has no successor"
pred :: IPCFlag -> IPCFlag
pred IPCFlag
LazyEnablePeerAccess = String -> IPCFlag
forall a. HasCallStack => String -> a
error String
"IPCFlag.pred: LazyEnablePeerAccess has no predecessor"
enumFromTo :: IPCFlag -> IPCFlag -> [IPCFlag]
enumFromTo IPCFlag
from IPCFlag
to = IPCFlag -> [IPCFlag]
forall t. Enum t => t -> [t]
go IPCFlag
from
where
end :: Int
end = IPCFlag -> Int
forall a. Enum a => a -> Int
fromEnum IPCFlag
to
go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
Ordering
EQ -> [t
v]
Ordering
GT -> []
enumFrom :: IPCFlag -> [IPCFlag]
enumFrom IPCFlag
from = IPCFlag -> IPCFlag -> [IPCFlag]
forall a. Enum a => a -> a -> [a]
enumFromTo IPCFlag
from IPCFlag
LazyEnablePeerAccess
fromEnum :: IPCFlag -> Int
fromEnum IPCFlag
LazyEnablePeerAccess = Int
1
toEnum :: Int -> IPCFlag
toEnum Int
1 = IPCFlag
LazyEnablePeerAccess
toEnum Int
unmatched = String -> IPCFlag
forall a. HasCallStack => String -> a
error (String
"IPCFlag.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)
{-# LINE 68 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
{-# INLINEABLE export #-}
export :: DevicePtr a -> IO (IPCDevicePtr a)
export :: DevicePtr a -> IO (IPCDevicePtr a)
export !DevicePtr a
dptr = do
IPCMemHandle
h <- IO IPCMemHandle
newIPCMemHandle
Status
r <- IPCMemHandle -> DevicePtr a -> IO Status
forall a. IPCMemHandle -> DevicePtr a -> IO Status
cuIpcGetMemHandle IPCMemHandle
h DevicePtr a
dptr
(Status, IPCDevicePtr a) -> IO (IPCDevicePtr a)
forall a. (Status, a) -> IO a
resultIfOk (Status
r, IPCMemHandle -> IPCDevicePtr a
forall a. IPCMemHandle -> IPCDevicePtr a
IPCDevicePtr IPCMemHandle
h)
{-# INLINE cuIpcGetMemHandle #-}
cuIpcGetMemHandle :: (IPCMemHandle) -> (DevicePtr a) -> IO ((Status))
cuIpcGetMemHandle :: IPCMemHandle -> DevicePtr a -> IO Status
cuIpcGetMemHandle IPCMemHandle
a1 DevicePtr a
a2 =
IPCMemHandle -> (Ptr () -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCMemHandle
a1 ((Ptr () -> IO Status) -> IO Status)
-> (Ptr () -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
let {a2' :: DeviceHandle
a2' = DevicePtr a -> DeviceHandle
forall a. DevicePtr a -> DeviceHandle
useDeviceHandle DevicePtr a
a2} in
Ptr () -> DeviceHandle -> IO CInt
cuIpcGetMemHandle'_ Ptr ()
a1' DeviceHandle
a2' IO CInt -> (CInt -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 100 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
{-# INLINEABLE open #-}
open :: IPCDevicePtr a -> [IPCFlag]-> IO (DevicePtr a)
open :: IPCDevicePtr a -> [IPCFlag] -> IO (DevicePtr a)
open !IPCDevicePtr a
hdl ![IPCFlag]
flags = (Status, DevicePtr a) -> IO (DevicePtr a)
forall a. (Status, a) -> IO a
resultIfOk ((Status, DevicePtr a) -> IO (DevicePtr a))
-> IO (Status, DevicePtr a) -> IO (DevicePtr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
forall a. IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
cuIpcOpenMemHandle (IPCDevicePtr a -> IPCMemHandle
forall a. IPCDevicePtr a -> IPCMemHandle
useIPCDevicePtr IPCDevicePtr a
hdl) [IPCFlag]
flags
{-# INLINE cuIpcOpenMemHandle #-}
cuIpcOpenMemHandle :: (IPCMemHandle) -> ([IPCFlag]) -> IO ((Status), (DevicePtr a))
cuIpcOpenMemHandle :: IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
cuIpcOpenMemHandle IPCMemHandle
a2 [IPCFlag]
a3 =
(Ptr DeviceHandle -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DeviceHandle -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a))
-> (Ptr DeviceHandle -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall a b. (a -> b) -> a -> b
$ \Ptr DeviceHandle
a1' ->
IPCMemHandle
-> (Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCMemHandle
a2 ((Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a))
-> (Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a2' ->
let {a3' :: CUInt
a3' = [IPCFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [IPCFlag]
a3} in
Ptr DeviceHandle -> Ptr () -> CUInt -> IO CInt
cuIpcOpenMemHandle'_ Ptr DeviceHandle
a1' Ptr ()
a2' CUInt
a3' IO CInt
-> (CInt -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
Ptr DeviceHandle -> IO (DevicePtr a)
forall a. Ptr DeviceHandle -> IO (DevicePtr a)
peekDeviceHandle Ptr DeviceHandle
a1'IO (DevicePtr a)
-> (DevicePtr a -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DevicePtr a
a1'' ->
(Status, DevicePtr a) -> IO (Status, DevicePtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', DevicePtr a
a1'')
{-# LINE 135 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
{-# INLINEABLE close #-}
close :: DevicePtr a -> IO ()
close :: DevicePtr a -> IO ()
close !DevicePtr a
dptr = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DevicePtr a -> IO Status
forall a. DevicePtr a -> IO Status
cuIpcCloseMemHandle DevicePtr a
dptr
{-# INLINE cuIpcCloseMemHandle #-}
cuIpcCloseMemHandle :: (DevicePtr a) -> IO ((Status))
cuIpcCloseMemHandle :: DevicePtr a -> IO Status
cuIpcCloseMemHandle DevicePtr a
a1 =
let {a1' :: DeviceHandle
a1' = DevicePtr a -> DeviceHandle
forall a. DevicePtr a -> DeviceHandle
useDeviceHandle DevicePtr a
a1} in
DeviceHandle -> IO CInt
cuIpcCloseMemHandle'_ DeviceHandle
a1' IO CInt -> (CInt -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 162 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
type IPCMemHandle = ForeignPtr ()
newIPCMemHandle :: IO IPCMemHandle
newIPCMemHandle :: IO IPCMemHandle
newIPCMemHandle = Int -> IO IPCMemHandle
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
64
{-# LINE 176 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}
foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcGetMemHandle"
cuIpcGetMemHandle'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcOpenMemHandle"
cuIpcOpenMemHandle'_ :: ((C2HSImp.Ptr C2HSImp.CULLong) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcCloseMemHandle"
cuIpcCloseMemHandle'_ :: (C2HSImp.CULLong -> (IO C2HSImp.CInt))