-- GENERATED by C->Haskell Compiler, version 0.25.2 Snowboundest, 31 Oct 2014 (Haskell) -- Edit the ORIGNAL .chs file instead! {-# LINE 1 "./Foreign/CUDA/Driver/IPC/Marshal.chs" #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.IPC.Marshal -- Copyright : [2009..2015] 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 {-# LINE 29 "./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 63 "./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.0. -- -- <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 95 "./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 'create' 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.0. -- -- <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 130 "./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.0. -- -- <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 157 "./Foreign/CUDA/Driver/IPC/Marshal.chs" #-} -------------------------------------------------------------------------------- -- Internal -------------------------------------------------------------------------------- type IPCMemHandle = ForeignPtr () newIPCMemHandle :: IO IPCMemHandle newIPCMemHandle = mallocForeignPtrBytes 64 {-# LINE 167 "./Foreign/CUDA/Driver/IPC/Marshal.chs" #-} foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcGetMemHandle" cuIpcGetMemHandle'_ :: ((Ptr ()) -> (CULLong -> (IO CInt))) foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcOpenMemHandle" cuIpcOpenMemHandle'_ :: ((Ptr CULLong) -> ((Ptr ()) -> (CUInt -> (IO CInt)))) foreign import ccall unsafe "Foreign/CUDA/Driver/IPC/Marshal.chs.h cuIpcCloseMemHandle" cuIpcCloseMemHandle'_ :: (CULLong -> (IO CInt))