-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# 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
-- Copyright : [2009..2018] Trevor L. McDonell
-- License   : BSD
--
-- Direct peer context access functions for the low-level driver interface.
--
-- Since: CUDA-4.0
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Context.Peer (

  -- * Peer Access
  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" #-}


-- Friends
import Foreign.CUDA.Driver.Context.Base                 ( Context(..) )
import Foreign.CUDA.Driver.Device                       ( Device(..) )
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C


--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- Possible option values for direct peer memory access
--
data PeerFlag
instance Enum PeerFlag where


-- | Peer-to-peer attributes
--
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" #-}



--------------------------------------------------------------------------------
-- Peer access
--------------------------------------------------------------------------------

-- |
-- Queries if the first device can directly access the memory of the second. If
-- direct access is possible, it can then be enabled with 'add'.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g496bdaae1f632ebfb695b99d2c40f19e>
--
{-# 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" #-}



-- |
-- If the devices of both the current and supplied contexts support unified
-- addressing, then enable allocations in the supplied context to be accessible
-- by the current context.
--
-- Note that access is unidirectional, and in order to access memory in the
-- current context from the peer context, a separate symmetric call to
-- 'add' is required.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g0889ec6728e61c05ed359551d67b3f5a>
--
{-# 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" #-}



-- |
-- Disable direct memory access from the current context to the supplied
-- peer context, and unregisters any registered allocations.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g5b4b6936ea868d4954ce4d841a3b4810>
--
{-# 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" #-}



-- |
-- Queries attributes of the link between two devices
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g4c55c60508f8eba4546b51f2ee545393>
--
-- Requires CUDA-8.0
--
-- @since 0.9.0.0@
--
{-# 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)))))