{-# LINE 1 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE EmptyCase #-}
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
toEnum x = case x of {}
fromEnum x = case x of {}
data PeerAttribute = PerformanceRank
| AccessSupported
| NativeAtomicSupported
deriving (Eq,Show)
instance Enum PeerAttribute where
succ PerformanceRank = AccessSupported
succ AccessSupported = NativeAtomicSupported
succ NativeAtomicSupported = error "PeerAttribute.succ: NativeAtomicSupported has no successor"
pred AccessSupported = PerformanceRank
pred NativeAtomicSupported = AccessSupported
pred PerformanceRank = error "PeerAttribute.pred: PerformanceRank has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from NativeAtomicSupported
fromEnum PerformanceRank = 1
fromEnum AccessSupported = 2
fromEnum NativeAtomicSupported = 3
toEnum 1 = PerformanceRank
toEnum 2 = AccessSupported
toEnum 3 = NativeAtomicSupported
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 !ctx !flags = nothingIfOk =<< cuCtxEnablePeerAccess ctx flags
{-# INLINE cuCtxEnablePeerAccess #-}
cuCtxEnablePeerAccess :: (Context) -> ([PeerFlag]) -> IO ((Status))
cuCtxEnablePeerAccess a1 a2 =
let {a1' = useContext a1} in
let {a2' = combineBitMasks a2} in
cuCtxEnablePeerAccess'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 125 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE remove #-}
remove :: Context -> IO ()
remove !ctx = nothingIfOk =<< cuCtxDisablePeerAccess ctx
{-# INLINE cuCtxDisablePeerAccess #-}
cuCtxDisablePeerAccess :: (Context) -> IO ((Status))
cuCtxDisablePeerAccess a1 =
let {a1' = useContext a1} in
cuCtxDisablePeerAccess'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 146 "src/Foreign/CUDA/Driver/Context/Peer.chs" #-}
{-# INLINEABLE getAttribute #-}
getAttribute :: PeerAttribute -> Device -> Device -> IO Int
getAttribute attrib src dst = resultIfOk =<< cuDeviceGetP2PAttribute attrib src dst
{-# INLINE cuDeviceGetP2PAttribute #-}
cuDeviceGetP2PAttribute :: (PeerAttribute) -> (Device) -> (Device) -> IO ((Status), (Int))
cuDeviceGetP2PAttribute a2 a3 a4 =
alloca $ \a1' ->
let {a2' = cFromEnum a2} in
let {a3' = useDevice a3} in
let {a4' = useDevice a4} in
cuDeviceGetP2PAttribute'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
peekIntConv a1'>>= \a1'' ->
return (res', 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)))))