-- 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          #-}
{-# LANGUAGE EmptyCase                #-}
--------------------------------------------------------------------------------
-- |
-- 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
  toEnum   x = error ("PeerFlag.toEnum: Cannot match " ++ show x)
  fromEnum x = case x of {}


-- | Peer-to-peer attributes
--
data PeerAttribute = PerformanceRank
                   | AccessSupported
                   | NativeAtomicSupported
                   | ArrayAccessAccessSupported
                   | CudaArrayAccessSupported
  deriving (Eq,Show)
instance Enum PeerAttribute where
  succ PerformanceRank = AccessSupported
  succ AccessSupported = NativeAtomicSupported
  succ NativeAtomicSupported = ArrayAccessAccessSupported
  succ ArrayAccessAccessSupported = error "PeerAttribute.succ: ArrayAccessAccessSupported has no successor"
  succ CudaArrayAccessSupported = error "PeerAttribute.succ: CudaArrayAccessSupported has no successor"

  pred AccessSupported = PerformanceRank
  pred NativeAtomicSupported = AccessSupported
  pred ArrayAccessAccessSupported = NativeAtomicSupported
  pred CudaArrayAccessSupported = NativeAtomicSupported
  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 CudaArrayAccessSupported

  fromEnum PerformanceRank = 1
  fromEnum AccessSupported = 2
  fromEnum NativeAtomicSupported = 3
  fromEnum ArrayAccessAccessSupported = 4
  fromEnum CudaArrayAccessSupported = 4

  toEnum 1 = PerformanceRank
  toEnum 2 = AccessSupported
  toEnum 3 = NativeAtomicSupported
  toEnum 4 = ArrayAccessAccessSupported
  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 !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" #-}



-- |
-- 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 !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" #-}



-- |
-- 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 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)))))