{-# LINE 1 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Driver.Context.Peer (
PeerFlag, PeerAttribute(..),
accessible, add, remove, getAttribute,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 30 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
import Foreign.CUDA.Driver.Context.Base ( Context(..) )
import Foreign.CUDA.Driver.Device ( Device(..) )
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign
import Foreign.C
data PeerFlag
instance Enum PeerFlag where
data PeerAttribute = PerformanceRank
| AccessSupported
| NativeAtomicSupported
| AccessAccessSupported
| CudaArrayAccessSupported
deriving (PeerAttribute -> PeerAttribute -> Bool
(PeerAttribute -> PeerAttribute -> Bool)
-> (PeerAttribute -> PeerAttribute -> Bool) -> Eq PeerAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeerAttribute -> PeerAttribute -> Bool
$c/= :: PeerAttribute -> PeerAttribute -> Bool
== :: PeerAttribute -> PeerAttribute -> Bool
$c== :: PeerAttribute -> PeerAttribute -> Bool
Eq,Int -> PeerAttribute -> ShowS
[PeerAttribute] -> ShowS
PeerAttribute -> String
(Int -> PeerAttribute -> ShowS)
-> (PeerAttribute -> String)
-> ([PeerAttribute] -> ShowS)
-> Show PeerAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PeerAttribute] -> ShowS
$cshowList :: [PeerAttribute] -> ShowS
show :: PeerAttribute -> String
$cshow :: PeerAttribute -> String
showsPrec :: Int -> PeerAttribute -> ShowS
$cshowsPrec :: Int -> PeerAttribute -> ShowS
Show)
instance Enum PeerAttribute where
succ :: PeerAttribute -> PeerAttribute
succ PeerAttribute
PerformanceRank = PeerAttribute
AccessSupported
succ PeerAttribute
AccessSupported = PeerAttribute
NativeAtomicSupported
succ PeerAttribute
NativeAtomicSupported = PeerAttribute
AccessAccessSupported
succ PeerAttribute
AccessAccessSupported = String -> PeerAttribute
forall a. HasCallStack => String -> a
error String
"PeerAttribute.succ: AccessAccessSupported has no successor"
succ PeerAttribute
CudaArrayAccessSupported = String -> PeerAttribute
forall a. HasCallStack => String -> a
error String
"PeerAttribute.succ: CudaArrayAccessSupported has no successor"
pred :: PeerAttribute -> PeerAttribute
pred PeerAttribute
AccessSupported = PeerAttribute
PerformanceRank
pred PeerAttribute
NativeAtomicSupported = PeerAttribute
AccessSupported
pred PeerAttribute
AccessAccessSupported = PeerAttribute
NativeAtomicSupported
pred PeerAttribute
CudaArrayAccessSupported = PeerAttribute
NativeAtomicSupported
pred PeerAttribute
PerformanceRank = String -> PeerAttribute
forall a. HasCallStack => String -> a
error String
"PeerAttribute.pred: PerformanceRank has no predecessor"
enumFromTo :: PeerAttribute -> PeerAttribute -> [PeerAttribute]
enumFromTo PeerAttribute
from PeerAttribute
to = PeerAttribute -> [PeerAttribute]
forall t. Enum t => t -> [t]
go PeerAttribute
from
where
end :: Int
end = PeerAttribute -> Int
forall a. Enum a => a -> Int
fromEnum PeerAttribute
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 :: PeerAttribute -> [PeerAttribute]
enumFrom PeerAttribute
from = PeerAttribute -> PeerAttribute -> [PeerAttribute]
forall a. Enum a => a -> a -> [a]
enumFromTo PeerAttribute
from PeerAttribute
CudaArrayAccessSupported
fromEnum :: PeerAttribute -> Int
fromEnum PeerAttribute
PerformanceRank = Int
1
fromEnum AccessSupported = 2
fromEnum NativeAtomicSupported = 3
fromEnum AccessAccessSupported = 4
fromEnum PeerAttribute
CudaArrayAccessSupported = Int
4
toEnum 1 = PerformanceRank
toEnum 2 = AccessSupported
toEnum 3 = NativeAtomicSupported
toEnum 4 = AccessAccessSupported
toEnum unmatched = error ("PeerAttribute.toEnum: Cannot match " ++ show unmatched)
{-# LINE 71 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE accessible #-}
accessible :: Device -> Device -> IO Bool
accessible !dev !peer = resultIfOk =<< cuDeviceCanAccessPeer dev peer
{-# INLINE cuDeviceCanAccessPeer #-}
cuDeviceCanAccessPeer :: (Device) -> (Device) -> IO ((Status), (Bool))
cuDeviceCanAccessPeer a2 a3 =
alloca $ \a1' ->
let {a2' = useDevice a2} in
let {a3' = useDevice a3} in
cuDeviceCanAccessPeer'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekBool a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 98 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE add #-}
add :: Context -> [PeerFlag] -> IO ()
add :: Context -> [PeerFlag] -> IO ()
add !Context
ctx ![PeerFlag]
flags = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context -> [PeerFlag] -> IO Status
cuCtxEnablePeerAccess Context
ctx [PeerFlag]
flags
{-# INLINE cuCtxEnablePeerAccess #-}
cuCtxEnablePeerAccess :: (Context) -> ([PeerFlag]) -> IO ((Status))
cuCtxEnablePeerAccess :: Context -> [PeerFlag] -> IO Status
cuCtxEnablePeerAccess Context
a1 [PeerFlag]
a2 =
let {a1' :: Ptr ()
a1' = Context -> Ptr ()
useContext Context
a1} in
let {a2' :: CUInt
a2' = [PeerFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [PeerFlag]
a2} in
Ptr () -> CUInt -> IO CInt
cuCtxEnablePeerAccess'_ Ptr ()
a1' CUInt
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 125 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE remove #-}
remove :: Context -> IO ()
remove :: Context -> IO ()
remove !Context
ctx = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context -> IO Status
cuCtxDisablePeerAccess Context
ctx
{-# INLINE cuCtxDisablePeerAccess #-}
cuCtxDisablePeerAccess :: (Context) -> IO ((Status))
cuCtxDisablePeerAccess :: Context -> IO Status
cuCtxDisablePeerAccess Context
a1 =
let {a1' :: Ptr ()
a1' = Context -> Ptr ()
useContext Context
a1} in
Ptr () -> IO CInt
cuCtxDisablePeerAccess'_ Ptr ()
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 146 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE getAttribute #-}
getAttribute :: PeerAttribute -> Device -> Device -> IO Int
getAttribute :: PeerAttribute -> Device -> Device -> IO Int
getAttribute PeerAttribute
attrib Device
src Device
dst = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PeerAttribute -> Device -> Device -> IO (Status, Int)
cuDeviceGetP2PAttribute PeerAttribute
attrib Device
src Device
dst
{-# INLINE cuDeviceGetP2PAttribute #-}
cuDeviceGetP2PAttribute :: (PeerAttribute) -> (Device) -> (Device) -> IO ((Status), (Int))
cuDeviceGetP2PAttribute :: PeerAttribute -> Device -> Device -> IO (Status, Int)
cuDeviceGetP2PAttribute PeerAttribute
a2 Device
a3 Device
a4 =
(Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CInt -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' ->
let {a2' :: CInt
a2' = PeerAttribute -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum PeerAttribute
a2} in
let {a3' :: CInt
a3' = Device -> CInt
useDevice Device
a3} in
let {a4' :: CInt
a4' = Device -> CInt
useDevice Device
a4} in
Ptr CInt -> CInt -> CInt -> CInt -> IO CInt
cuDeviceGetP2PAttribute'_ Ptr CInt
a1' CInt
a2' CInt
a3' CInt
a4' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
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 CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' ->
(Status, Int) -> IO (Status, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')
{-# LINE 172 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Peer.chs.h cuDeviceCanAccessPeer"
cuDeviceCanAccessPeer'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Peer.chs.h cuCtxEnablePeerAccess"
cuCtxEnablePeerAccess'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Peer.chs.h cuCtxDisablePeerAccess"
cuCtxDisablePeerAccess'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Peer.chs.h cuDeviceGetP2PAttribute"
cuDeviceGetP2PAttribute'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))