module Foreign.CUDA.Driver.Context (
Context(..), ContextFlag(..),
create, attach, detach, destroy, device, pop, push, sync, get, set,
PeerFlag,
accessible, add, remove,
Cache(..), Limit(..),
getLimit, setLimit, setCacheConfig
) where
import Foreign.CUDA.Driver.Device (Device(..))
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign
import Foreign.C
import Control.Monad (liftM)
newtype Context = Context { useContext :: ((Ptr ()))}
deriving (Eq, Show)
data ContextFlag = SchedAuto
| SchedSpin
| SchedYield
| SchedBlockingSync
| BlockingSync
| SchedMask
| MapHost
| LmemResizeToMax
| FlagsMask
deriving (Eq,Show)
instance Enum ContextFlag where
fromEnum SchedAuto = 0
fromEnum SchedSpin = 1
fromEnum SchedYield = 2
fromEnum SchedBlockingSync = 4
fromEnum BlockingSync = 4
fromEnum SchedMask = 7
fromEnum MapHost = 8
fromEnum LmemResizeToMax = 16
fromEnum FlagsMask = 31
toEnum 0 = SchedAuto
toEnum 1 = SchedSpin
toEnum 2 = SchedYield
toEnum 4 = SchedBlockingSync
toEnum 7 = SchedMask
toEnum 8 = MapHost
toEnum 16 = LmemResizeToMax
toEnum 31 = FlagsMask
toEnum unmatched = error ("ContextFlag.toEnum: Cannot match " ++ show unmatched)
data Limit = StackSize
| PrintfFifoSize
| MallocHeapSize
| DevRuntimeSyncDepth
| DevRuntimePendingLaunchCount
| Max
deriving (Eq,Show)
instance Enum Limit where
fromEnum StackSize = 0
fromEnum PrintfFifoSize = 1
fromEnum MallocHeapSize = 2
fromEnum DevRuntimeSyncDepth = 3
fromEnum DevRuntimePendingLaunchCount = 4
fromEnum Max = 5
toEnum 0 = StackSize
toEnum 1 = PrintfFifoSize
toEnum 2 = MallocHeapSize
toEnum 3 = DevRuntimeSyncDepth
toEnum 4 = DevRuntimePendingLaunchCount
toEnum 5 = Max
toEnum unmatched = error ("Limit.toEnum: Cannot match " ++ show unmatched)
data Cache = PreferNone
| PreferShared
| PreferL1
| PreferEqual
deriving (Eq,Show)
instance Enum Cache where
fromEnum PreferNone = 0
fromEnum PreferShared = 1
fromEnum PreferL1 = 2
fromEnum PreferEqual = 3
toEnum 0 = PreferNone
toEnum 1 = PreferShared
toEnum 2 = PreferL1
toEnum 3 = PreferEqual
toEnum unmatched = error ("Cache.toEnum: Cannot match " ++ show unmatched)
data PeerFlag
instance Enum PeerFlag where
create :: Device -> [ContextFlag] -> IO Context
create !dev !flags = resultIfOk =<< cuCtxCreate flags dev
cuCtxCreate :: ([ContextFlag]) -> (Device) -> IO ((Status), (Context))
cuCtxCreate a2 a3 =
alloca $ \a1' ->
let {a2' = combineBitMasks a2} in
let {a3' = useDevice a3} in
cuCtxCreate'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekCtx a1'>>= \a1'' ->
return (res', a1'')
where peekCtx = liftM Context . peek
attach :: Context -> [ContextFlag] -> IO ()
attach !ctx !flags = nothingIfOk =<< cuCtxAttach ctx flags
cuCtxAttach :: (Context) -> ([ContextFlag]) -> IO ((Status))
cuCtxAttach a1 a2 =
withCtx a1 $ \a1' ->
let {a2' = combineBitMasks a2} in
cuCtxAttach'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
where withCtx = with . useContext
detach :: Context -> IO ()
detach !ctx = nothingIfOk =<< cuCtxDetach ctx
cuCtxDetach :: (Context) -> IO ((Status))
cuCtxDetach a1 =
let {a1' = useContext a1} in
cuCtxDetach'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
destroy :: Context -> IO ()
destroy !ctx = nothingIfOk =<< cuCtxDestroy ctx
cuCtxDestroy :: (Context) -> IO ((Status))
cuCtxDestroy a1 =
let {a1' = useContext a1} in
cuCtxDestroy'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
get :: IO Context
get = resultIfOk =<< cuCtxGetCurrent
cuCtxGetCurrent :: IO ((Status), (Context))
cuCtxGetCurrent =
alloca $ \a1' ->
cuCtxGetCurrent'_ a1' >>= \res ->
let {res' = cToEnum res} in
peekCtx a1'>>= \a1'' ->
return (res', a1'')
where peekCtx = liftM Context . peek
set :: Context -> IO ()
set !ctx = nothingIfOk =<< cuCtxSetCurrent ctx
cuCtxSetCurrent :: (Context) -> IO ((Status))
cuCtxSetCurrent a1 =
let {a1' = useContext a1} in
cuCtxSetCurrent'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
device :: IO Device
device = resultIfOk =<< cuCtxGetDevice
cuCtxGetDevice :: IO ((Status), (Device))
cuCtxGetDevice =
alloca $ \a1' ->
cuCtxGetDevice'_ a1' >>= \res ->
let {res' = cToEnum res} in
dev a1'>>= \a1'' ->
return (res', a1'')
where dev = liftM Device . peekIntConv
pop :: IO Context
pop = resultIfOk =<< cuCtxPopCurrent
cuCtxPopCurrent :: IO ((Status), (Context))
cuCtxPopCurrent =
alloca $ \a1' ->
cuCtxPopCurrent'_ a1' >>= \res ->
let {res' = cToEnum res} in
peekCtx a1'>>= \a1'' ->
return (res', a1'')
where peekCtx = liftM Context . peek
push :: Context -> IO ()
push !ctx = nothingIfOk =<< cuCtxPushCurrent ctx
cuCtxPushCurrent :: (Context) -> IO ((Status))
cuCtxPushCurrent a1 =
let {a1' = useContext a1} in
cuCtxPushCurrent'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
sync :: IO ()
sync = nothingIfOk =<< cuCtxSynchronize
cuCtxSynchronize :: IO ((Status))
cuCtxSynchronize =
cuCtxSynchronize'_ >>= \res ->
let {res' = cToEnum res} in
return (res')
accessible :: Device -> Device -> IO Bool
accessible !dev !peer = resultIfOk =<< cuDeviceCanAccessPeer dev peer
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'')
add :: Context -> [PeerFlag] -> IO ()
add !ctx !flags = nothingIfOk =<< cuCtxEnablePeerAccess ctx flags
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')
remove :: Context -> IO ()
remove !ctx = nothingIfOk =<< cuCtxDisablePeerAccess ctx
cuCtxDisablePeerAccess :: (Context) -> IO ((Status))
cuCtxDisablePeerAccess a1 =
let {a1' = useContext a1} in
cuCtxDisablePeerAccess'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
getLimit :: Limit -> IO Int
getLimit !l = resultIfOk =<< cuCtxGetLimit l
cuCtxGetLimit :: (Limit) -> IO ((Status), (Int))
cuCtxGetLimit a2 =
alloca $ \a1' ->
let {a2' = cFromEnum a2} in
cuCtxGetLimit'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekIntConv a1'>>= \a1'' ->
return (res', a1'')
setLimit :: Limit -> Int -> IO ()
setLimit !l !n = nothingIfOk =<< cuCtxSetLimit l n
cuCtxSetLimit :: (Limit) -> (Int) -> IO ((Status))
cuCtxSetLimit a1 a2 =
let {a1' = cFromEnum a1} in
let {a2' = cIntConv a2} in
cuCtxSetLimit'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
setCacheConfig :: Cache -> IO ()
setCacheConfig !c = nothingIfOk =<< cuCtxSetCacheConfig c
cuCtxSetCacheConfig :: (Cache) -> IO ((Status))
cuCtxSetCacheConfig a1 =
let {a1' = cFromEnum a1} in
cuCtxSetCacheConfig'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxCreate"
cuCtxCreate'_ :: ((Ptr (Ptr ())) -> (CUInt -> (CInt -> (IO CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxAttach"
cuCtxAttach'_ :: ((Ptr (Ptr ())) -> (CUInt -> (IO CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxDetach"
cuCtxDetach'_ :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxDestroy"
cuCtxDestroy'_ :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxGetCurrent"
cuCtxGetCurrent'_ :: ((Ptr (Ptr ())) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxSetCurrent"
cuCtxSetCurrent'_ :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxGetDevice"
cuCtxGetDevice'_ :: ((Ptr CInt) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxPopCurrent"
cuCtxPopCurrent'_ :: ((Ptr (Ptr ())) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxPushCurrent"
cuCtxPushCurrent'_ :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxSynchronize"
cuCtxSynchronize'_ :: (IO CInt)
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuDeviceCanAccessPeer"
cuDeviceCanAccessPeer'_ :: ((Ptr CInt) -> (CInt -> (CInt -> (IO CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxEnablePeerAccess"
cuCtxEnablePeerAccess'_ :: ((Ptr ()) -> (CUInt -> (IO CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxDisablePeerAccess"
cuCtxDisablePeerAccess'_ :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxGetLimit"
cuCtxGetLimit'_ :: ((Ptr CULong) -> (CInt -> (IO CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxSetLimit"
cuCtxSetLimit'_ :: (CInt -> (CULong -> (IO CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context.chs.h cuCtxSetCacheConfig"
cuCtxSetCacheConfig'_ :: (CInt -> (IO CInt))