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


{-# 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
-- Copyright : [2009..2017] Trevor L. McDonell
-- License   : BSD
--
-- IPC memory management for low-level driver interface.
--
-- Restricted to devices which support unified addressing on Linux
-- operating systems.
--
-- Since CUDA-4.0.
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.IPC.Marshal (

  -- ** IPC memory management
  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" #-}


-- Friends
import Foreign.CUDA.Ptr
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Driver.Marshal

-- System
import Control.Monad
import Prelude

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal


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

-- |
-- A CUDA memory handle used for inter-process communication.
--
newtype IPCDevicePtr a = IPCDevicePtr { useIPCDevicePtr :: IPCMemHandle }
  deriving (Eq, Show)


-- |
-- Flags for controlling IPC memory access
--
data IPCFlag = LazyEnablePeerAccess
  deriving (Eq,Show,Bounded)
instance Enum IPCFlag where
  succ LazyEnablePeerAccess = error "IPCFlag.succ: LazyEnablePeerAccess has no successor"

  pred LazyEnablePeerAccess = error "IPCFlag.pred: LazyEnablePeerAccess 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 LazyEnablePeerAccess

  fromEnum LazyEnablePeerAccess = 1

  toEnum 1 = LazyEnablePeerAccess
  toEnum unmatched = error ("IPCFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 68 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}



--------------------------------------------------------------------------------
-- IPC memory management
--------------------------------------------------------------------------------

-- |
-- Create an inter-process memory handle for an existing device memory
-- allocation. The handle can then be sent to another process and made
-- available to that process via 'open'.
--
-- Requires CUDA-4.1.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g6f1b5be767b275f016523b2ac49ebec1>
--
{-# INLINEABLE export #-}
export :: DevicePtr a -> IO (IPCDevicePtr a)
export !dptr = do
  h <- newIPCMemHandle
  r <- cuIpcGetMemHandle h dptr
  resultIfOk (r, IPCDevicePtr h)

{-# INLINE cuIpcGetMemHandle #-}
cuIpcGetMemHandle :: (IPCMemHandle) -> (DevicePtr a) -> IO ((Status))
cuIpcGetMemHandle a1 a2 =
  withForeignPtr a1 $ \a1' -> 
  let {a2' = useDeviceHandle a2} in 
  cuIpcGetMemHandle'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 100 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}



-- |
-- Open an inter-process memory handle exported from another process,
-- returning a device pointer usable in the current process.
--
-- Maps memory exported by another process with 'export into the current
-- device address space. For contexts on different devices, 'open' can
-- attempt to enable peer access if the user called
-- 'Foreign.CUDA.Driver.Context.Peer.add', and is controlled by the
-- 'LazyEnablePeerAccess' flag.
--
-- Each handle from a given device and context may only be 'open'ed by one
-- context per device per other process. Memory returned by 'open' must be
-- freed via 'close'.
--
-- Requires CUDA-4.1.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1ga8bd126fcff919a0c996b7640f197b79>
--
{-# INLINEABLE open #-}
open :: IPCDevicePtr a -> [IPCFlag]-> IO (DevicePtr a)
open !hdl !flags = resultIfOk =<< cuIpcOpenMemHandle (useIPCDevicePtr hdl) flags

{-# INLINE cuIpcOpenMemHandle #-}
cuIpcOpenMemHandle :: (IPCMemHandle) -> ([IPCFlag]) -> IO ((Status), (DevicePtr a))
cuIpcOpenMemHandle a2 a3 =
  alloca $ \a1' -> 
  withForeignPtr a2 $ \a2' -> 
  let {a3' = combineBitMasks a3} in 
  cuIpcOpenMemHandle'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekDeviceHandle  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 135 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}



-- |
-- Close and unmap memory returned by 'open'. The original allocation in
-- the exporting process as well as imported mappings in other processes
-- are unaffected.
--
-- Any resources used to enable peer access will be freed if this is the
-- last mapping using them.
--
-- Requires CUDA-4.1.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gd6f5d5bcf6376c6853b64635b0157b9e>
--
{-# INLINEABLE close #-}
close :: DevicePtr a -> IO ()
close !dptr = nothingIfOk =<< cuIpcCloseMemHandle dptr

{-# INLINE cuIpcCloseMemHandle #-}
cuIpcCloseMemHandle :: (DevicePtr a) -> IO ((Status))
cuIpcCloseMemHandle a1 =
  let {a1' = useDeviceHandle a1} in 
  cuIpcCloseMemHandle'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 162 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}



--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

type IPCMemHandle = ForeignPtr ()

newIPCMemHandle :: IO IPCMemHandle
newIPCMemHandle = mallocForeignPtrBytes 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))