-- 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/IPC/Marshal.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.IPC.Marshal
-- Copyright : [2009..2018] 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 { IPCDevicePtr a -> IPCMemHandle
useIPCDevicePtr :: IPCMemHandle }
  deriving (IPCDevicePtr a -> IPCDevicePtr a -> Bool
(IPCDevicePtr a -> IPCDevicePtr a -> Bool)
-> (IPCDevicePtr a -> IPCDevicePtr a -> Bool)
-> Eq (IPCDevicePtr a)
forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPCDevicePtr a -> IPCDevicePtr a -> Bool
$c/= :: forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
== :: IPCDevicePtr a -> IPCDevicePtr a -> Bool
$c== :: forall a. IPCDevicePtr a -> IPCDevicePtr a -> Bool
Eq, Int -> IPCDevicePtr a -> ShowS
[IPCDevicePtr a] -> ShowS
IPCDevicePtr a -> String
(Int -> IPCDevicePtr a -> ShowS)
-> (IPCDevicePtr a -> String)
-> ([IPCDevicePtr a] -> ShowS)
-> Show (IPCDevicePtr a)
forall a. Int -> IPCDevicePtr a -> ShowS
forall a. [IPCDevicePtr a] -> ShowS
forall a. IPCDevicePtr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPCDevicePtr a] -> ShowS
$cshowList :: forall a. [IPCDevicePtr a] -> ShowS
show :: IPCDevicePtr a -> String
$cshow :: forall a. IPCDevicePtr a -> String
showsPrec :: Int -> IPCDevicePtr a -> ShowS
$cshowsPrec :: forall a. Int -> IPCDevicePtr a -> ShowS
Show)


-- |
-- Flags for controlling IPC memory access
--
data IPCFlag = LazyEnablePeerAccess
  deriving (IPCFlag -> IPCFlag -> Bool
(IPCFlag -> IPCFlag -> Bool)
-> (IPCFlag -> IPCFlag -> Bool) -> Eq IPCFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPCFlag -> IPCFlag -> Bool
$c/= :: IPCFlag -> IPCFlag -> Bool
== :: IPCFlag -> IPCFlag -> Bool
$c== :: IPCFlag -> IPCFlag -> Bool
Eq,Int -> IPCFlag -> ShowS
[IPCFlag] -> ShowS
IPCFlag -> String
(Int -> IPCFlag -> ShowS)
-> (IPCFlag -> String) -> ([IPCFlag] -> ShowS) -> Show IPCFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPCFlag] -> ShowS
$cshowList :: [IPCFlag] -> ShowS
show :: IPCFlag -> String
$cshow :: IPCFlag -> String
showsPrec :: Int -> IPCFlag -> ShowS
$cshowsPrec :: Int -> IPCFlag -> ShowS
Show,IPCFlag
IPCFlag -> IPCFlag -> Bounded IPCFlag
forall a. a -> a -> Bounded a
maxBound :: IPCFlag
$cmaxBound :: IPCFlag
minBound :: IPCFlag
$cminBound :: IPCFlag
Bounded)
instance Enum IPCFlag where
  succ :: IPCFlag -> IPCFlag
succ IPCFlag
LazyEnablePeerAccess = String -> IPCFlag
forall a. HasCallStack => String -> a
error String
"IPCFlag.succ: LazyEnablePeerAccess has no successor"

  pred :: IPCFlag -> IPCFlag
pred IPCFlag
LazyEnablePeerAccess = String -> IPCFlag
forall a. HasCallStack => String -> a
error String
"IPCFlag.pred: LazyEnablePeerAccess has no predecessor"

  enumFromTo :: IPCFlag -> IPCFlag -> [IPCFlag]
enumFromTo IPCFlag
from IPCFlag
to = IPCFlag -> [IPCFlag]
forall t. Enum t => t -> [t]
go IPCFlag
from
    where
      end :: Int
end = IPCFlag -> Int
forall a. Enum a => a -> Int
fromEnum IPCFlag
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 :: IPCFlag -> [IPCFlag]
enumFrom IPCFlag
from = IPCFlag -> IPCFlag -> [IPCFlag]
forall a. Enum a => a -> a -> [a]
enumFromTo IPCFlag
from IPCFlag
LazyEnablePeerAccess

  fromEnum :: IPCFlag -> Int
fromEnum IPCFlag
LazyEnablePeerAccess = Int
1

  toEnum :: Int -> IPCFlag
toEnum Int
1 = IPCFlag
LazyEnablePeerAccess
  toEnum Int
unmatched = String -> IPCFlag
forall a. HasCallStack => String -> a
error (String
"IPCFlag.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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 :: DevicePtr a -> IO (IPCDevicePtr a)
export !DevicePtr a
dptr = do
  IPCMemHandle
h <- IO IPCMemHandle
newIPCMemHandle
  Status
r <- IPCMemHandle -> DevicePtr a -> IO Status
forall a. IPCMemHandle -> DevicePtr a -> IO Status
cuIpcGetMemHandle IPCMemHandle
h DevicePtr a
dptr
  (Status, IPCDevicePtr a) -> IO (IPCDevicePtr a)
forall a. (Status, a) -> IO a
resultIfOk (Status
r, IPCMemHandle -> IPCDevicePtr a
forall a. IPCMemHandle -> IPCDevicePtr a
IPCDevicePtr IPCMemHandle
h)

{-# INLINE cuIpcGetMemHandle #-}
cuIpcGetMemHandle :: (IPCMemHandle) -> (DevicePtr a) -> IO ((Status))
cuIpcGetMemHandle :: IPCMemHandle -> DevicePtr a -> IO Status
cuIpcGetMemHandle IPCMemHandle
a1 DevicePtr a
a2 =
  IPCMemHandle -> (Ptr () -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCMemHandle
a1 ((Ptr () -> IO Status) -> IO Status)
-> (Ptr () -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' -> 
  let {a2' :: DeviceHandle
a2' = DevicePtr a -> DeviceHandle
forall a. DevicePtr a -> DeviceHandle
useDeviceHandle DevicePtr a
a2} in 
  Ptr () -> DeviceHandle -> IO CInt
cuIpcGetMemHandle'_ Ptr ()
a1' DeviceHandle
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 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 :: IPCDevicePtr a -> [IPCFlag] -> IO (DevicePtr a)
open !IPCDevicePtr a
hdl ![IPCFlag]
flags = (Status, DevicePtr a) -> IO (DevicePtr a)
forall a. (Status, a) -> IO a
resultIfOk ((Status, DevicePtr a) -> IO (DevicePtr a))
-> IO (Status, DevicePtr a) -> IO (DevicePtr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
forall a. IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
cuIpcOpenMemHandle (IPCDevicePtr a -> IPCMemHandle
forall a. IPCDevicePtr a -> IPCMemHandle
useIPCDevicePtr IPCDevicePtr a
hdl) [IPCFlag]
flags

{-# INLINE cuIpcOpenMemHandle #-}
cuIpcOpenMemHandle :: (IPCMemHandle) -> ([IPCFlag]) -> IO ((Status), (DevicePtr a))
cuIpcOpenMemHandle :: IPCMemHandle -> [IPCFlag] -> IO (Status, DevicePtr a)
cuIpcOpenMemHandle IPCMemHandle
a2 [IPCFlag]
a3 =
  (Ptr DeviceHandle -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DeviceHandle -> IO (Status, DevicePtr a))
 -> IO (Status, DevicePtr a))
-> (Ptr DeviceHandle -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall a b. (a -> b) -> a -> b
$ \Ptr DeviceHandle
a1' -> 
  IPCMemHandle
-> (Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr IPCMemHandle
a2 ((Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a))
-> (Ptr () -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a2' -> 
  let {a3' :: CUInt
a3' = [IPCFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [IPCFlag]
a3} in 
  Ptr DeviceHandle -> Ptr () -> CUInt -> IO CInt
cuIpcOpenMemHandle'_ Ptr DeviceHandle
a1' Ptr ()
a2' CUInt
a3' IO CInt
-> (CInt -> IO (Status, DevicePtr a)) -> IO (Status, DevicePtr a)
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 DeviceHandle -> IO (DevicePtr a)
forall a. Ptr DeviceHandle -> IO (DevicePtr a)
peekDeviceHandle  Ptr DeviceHandle
a1'IO (DevicePtr a)
-> (DevicePtr a -> IO (Status, DevicePtr a))
-> IO (Status, DevicePtr a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DevicePtr a
a1'' -> 
  (Status, DevicePtr a) -> IO (Status, DevicePtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', DevicePtr a
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 :: DevicePtr a -> IO ()
close !DevicePtr a
dptr = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DevicePtr a -> IO Status
forall a. DevicePtr a -> IO Status
cuIpcCloseMemHandle DevicePtr a
dptr

{-# INLINE cuIpcCloseMemHandle #-}
cuIpcCloseMemHandle :: (DevicePtr a) -> IO ((Status))
cuIpcCloseMemHandle :: DevicePtr a -> IO Status
cuIpcCloseMemHandle DevicePtr a
a1 =
  let {a1' :: DeviceHandle
a1' = DevicePtr a -> DeviceHandle
forall a. DevicePtr a -> DeviceHandle
useDeviceHandle DevicePtr a
a1} in 
  DeviceHandle -> IO CInt
cuIpcCloseMemHandle'_ DeviceHandle
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 162 "src/Foreign/CUDA/Driver/IPC/Marshal.chs" #-}



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

type IPCMemHandle = ForeignPtr ()

newIPCMemHandle :: IO IPCMemHandle
newIPCMemHandle :: IO IPCMemHandle
newIPCMemHandle = Int -> IO IPCMemHandle
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
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))