{-# LINE 1 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Driver.Context.Config (
getFlags,
Limit(..),
getLimit, setLimit,
Cache(..),
getCache, setCache,
SharedMem(..),
getSharedMem, setSharedMem,
StreamPriority,
getStreamPriorityRange,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 43 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
import Foreign.CUDA.Driver.Context.Base
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Driver.Stream ( Stream, StreamPriority )
import Control.Monad
import Foreign
import Foreign.C
data Limit = StackSize
| PrintfFifoSize
| MallocHeapSize
| DevRuntimeSyncDepth
| DevRuntimePendingLaunchCount
| MaxL2FetchGranularity
| Max
deriving (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
Eq,Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
(Int -> Limit -> ShowS)
-> (Limit -> String) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> String
$cshow :: Limit -> String
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> Limit -> ShowS
Show)
instance Enum Limit where
succ :: Limit -> Limit
succ Limit
StackSize = Limit
PrintfFifoSize
succ Limit
PrintfFifoSize = Limit
MallocHeapSize
succ Limit
MallocHeapSize = Limit
DevRuntimeSyncDepth
succ Limit
DevRuntimeSyncDepth = Limit
DevRuntimePendingLaunchCount
succ Limit
DevRuntimePendingLaunchCount = Limit
MaxL2FetchGranularity
succ Limit
MaxL2FetchGranularity = Limit
Max
succ Limit
Max = String -> Limit
forall a. HasCallStack => String -> a
error String
"Limit.succ: Max has no successor"
pred PrintfFifoSize = StackSize
pred MallocHeapSize = PrintfFifoSize
pred DevRuntimeSyncDepth = MallocHeapSize
pred DevRuntimePendingLaunchCount = DevRuntimeSyncDepth
pred MaxL2FetchGranularity = DevRuntimePendingLaunchCount
pred Max = MaxL2FetchGranularity
pred StackSize = error "Limit.pred: StackSize 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 Max
fromEnum StackSize = 0
fromEnum PrintfFifoSize = 1
fromEnum MallocHeapSize = 2
fromEnum DevRuntimeSyncDepth = 3
fromEnum DevRuntimePendingLaunchCount = 4
fromEnum MaxL2FetchGranularity = 5
fromEnum Max = 6
toEnum 0 = StackSize
toEnum 1 = PrintfFifoSize
toEnum 2 = MallocHeapSize
toEnum 3 = DevRuntimeSyncDepth
toEnum 4 = DevRuntimePendingLaunchCount
toEnum 5 = MaxL2FetchGranularity
toEnum 6 = Max
toEnum unmatched = error ("Limit.toEnum: Cannot match " ++ show unmatched)
{-# LINE 70 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
data Cache = PreferNone
| PreferShared
| PreferL1
| PreferEqual
deriving (Eq,Show)
instance Enum Cache where
succ PreferNone = PreferShared
succ PreferShared = PreferL1
succ PreferL1 = PreferEqual
succ PreferEqual = error "Cache.succ: PreferEqual has no successor"
pred PreferShared = PreferNone
pred PreferL1 = PreferShared
pred PreferEqual = PreferL1
pred PreferNone = error "Cache.pred: PreferNone 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 PreferEqual
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)
{-# LINE 82 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
data SharedMem = DefaultBankSize
| FourByteBankSize
| EightByteBankSize
deriving (Eq,Show)
instance Enum SharedMem where
succ DefaultBankSize = FourByteBankSize
succ FourByteBankSize = EightByteBankSize
succ EightByteBankSize = error "SharedMem.succ: EightByteBankSize has no successor"
pred FourByteBankSize = DefaultBankSize
pred EightByteBankSize = FourByteBankSize
pred DefaultBankSize = error "SharedMem.pred: DefaultBankSize 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 EightByteBankSize
fromEnum DefaultBankSize = 0
fromEnum FourByteBankSize = 1
fromEnum EightByteBankSize = 2
toEnum 0 = DefaultBankSize
toEnum 1 = FourByteBankSize
toEnum 2 = EightByteBankSize
toEnum unmatched = error ("SharedMem.toEnum: Cannot match " ++ show unmatched)
{-# LINE 94 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE getFlags #-}
getFlags :: IO [ContextFlag]
getFlags = resultIfOk =<< cuCtxGetFlags
{-# INLINE cuCtxGetFlags #-}
cuCtxGetFlags :: IO ((Status), ([ContextFlag]))
cuCtxGetFlags =
alloca $ \a1' ->
cuCtxGetFlags'_ a1' >>= \res ->
let {res' = cToEnum res} in
peekFlags a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 117 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
where
peekFlags = liftM extractBitMasks . peek
{-# INLINEABLE getLimit #-}
getLimit :: Limit -> IO Int
getLimit :: Limit -> IO Int
getLimit !Limit
l = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Limit -> IO (Status, Int)
cuCtxGetLimit Limit
l
{-# INLINE cuCtxGetLimit #-}
cuCtxGetLimit :: (Limit) -> IO ((Status), (Int))
cuCtxGetLimit :: Limit -> IO (Status, Int)
cuCtxGetLimit Limit
a2 =
(Ptr CULong -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CULong -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a1' ->
let {a2' :: CInt
a2' = Limit -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Limit
a2} in
Ptr CULong -> CInt -> IO CInt
cuCtxGetLimit'_ Ptr CULong
a1' CInt
a2' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
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 CULong -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv Ptr CULong
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' ->
(Status, Int) -> IO (Status, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')
{-# LINE 141 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE setLimit #-}
setLimit :: Limit -> Int -> IO ()
setLimit :: Limit -> Int -> IO ()
setLimit !Limit
l !Int
n = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Limit -> Int -> IO Status
cuCtxSetLimit Limit
l Int
n
{-# INLINE cuCtxSetLimit #-}
cuCtxSetLimit :: (Limit) -> (Int) -> IO ((Status))
cuCtxSetLimit :: Limit -> Int -> IO Status
cuCtxSetLimit Limit
a1 Int
a2 =
let {a1' :: CInt
a1' = Limit -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Limit
a1} in
let {a2' :: CULong
a2' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in
CInt -> CULong -> IO CInt
cuCtxSetLimit'_ CInt
a1' CULong
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 162 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE getCache #-}
getCache :: IO Cache
getCache :: IO Cache
getCache = (Status, Cache) -> IO Cache
forall a. (Status, a) -> IO a
resultIfOk ((Status, Cache) -> IO Cache) -> IO (Status, Cache) -> IO Cache
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, Cache)
cuCtxGetCacheConfig
{-# INLINE cuCtxGetCacheConfig #-}
cuCtxGetCacheConfig :: IO ((Status), (Cache))
cuCtxGetCacheConfig :: IO (Status, Cache)
cuCtxGetCacheConfig =
(Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache))
-> (Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' ->
Ptr CInt -> IO CInt
cuCtxGetCacheConfig'_ Ptr CInt
a1' IO CInt -> (CInt -> IO (Status, Cache)) -> IO (Status, Cache)
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 CInt -> IO Cache
forall a b. (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum Ptr CInt
a1'IO Cache -> (Cache -> IO (Status, Cache)) -> IO (Status, Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Cache
a1'' ->
(Status, Cache) -> IO (Status, Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Cache
a1'')
{-# LINE 184 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE setCache #-}
setCache :: Cache -> IO ()
setCache :: Cache -> IO ()
setCache !Cache
c = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cache -> IO Status
cuCtxSetCacheConfig Cache
c
{-# INLINE cuCtxSetCacheConfig #-}
cuCtxSetCacheConfig :: (Cache) -> IO ((Status))
cuCtxSetCacheConfig :: Cache -> IO Status
cuCtxSetCacheConfig Cache
a1 =
let {a1' :: CInt
a1' = Cache -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Cache
a1} in
CInt -> IO CInt
cuCtxSetCacheConfig'_ CInt
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 210 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE getSharedMem #-}
getSharedMem :: IO SharedMem
getSharedMem :: IO SharedMem
getSharedMem = (Status, SharedMem) -> IO SharedMem
forall a. (Status, a) -> IO a
resultIfOk ((Status, SharedMem) -> IO SharedMem)
-> IO (Status, SharedMem) -> IO SharedMem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, SharedMem)
cuCtxGetSharedMemConfig
{-# INLINE cuCtxGetSharedMemConfig #-}
cuCtxGetSharedMemConfig :: IO ((Status), (SharedMem))
cuCtxGetSharedMemConfig :: IO (Status, SharedMem)
cuCtxGetSharedMemConfig =
(Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem))
-> (Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' ->
Ptr CInt -> IO CInt
cuCtxGetSharedMemConfig'_ Ptr CInt
a1' IO CInt
-> (CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
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 CInt -> IO SharedMem
forall a b. (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum Ptr CInt
a1'IO SharedMem
-> (SharedMem -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SharedMem
a1'' ->
(Status, SharedMem) -> IO (Status, SharedMem)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', SharedMem
a1'')
{-# LINE 236 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE setSharedMem #-}
setSharedMem :: SharedMem -> IO ()
setSharedMem :: SharedMem -> IO ()
setSharedMem !SharedMem
c = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SharedMem -> IO Status
cuCtxSetSharedMemConfig SharedMem
c
{-# INLINE cuCtxSetSharedMemConfig #-}
cuCtxSetSharedMemConfig :: (SharedMem) -> IO ((Status))
cuCtxSetSharedMemConfig :: SharedMem -> IO Status
cuCtxSetSharedMemConfig SharedMem
a1 =
let {a1' :: CInt
a1' = SharedMem -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum SharedMem
a1} in
CInt -> IO CInt
cuCtxSetSharedMemConfig'_ CInt
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 266 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
{-# INLINEABLE getStreamPriorityRange #-}
getStreamPriorityRange :: IO (StreamPriority, StreamPriority)
getStreamPriorityRange :: IO (Int, Int)
getStreamPriorityRange = do
(Status
r,Int
l,Int
h) <- IO (Status, Int, Int)
cuCtxGetStreamPriorityRange
(Status, (Int, Int)) -> IO (Int, Int)
forall a. (Status, a) -> IO a
resultIfOk (Status
r, (Int
h,Int
l))
{-# INLINE cuCtxGetStreamPriorityRange #-}
cuCtxGetStreamPriorityRange :: IO ((Status), (Int), (Int))
cuCtxGetStreamPriorityRange :: IO (Status, Int, Int)
cuCtxGetStreamPriorityRange =
(Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int))
-> (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' ->
(Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int))
-> (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a2' ->
Ptr CInt -> Ptr CInt -> IO CInt
cuCtxGetStreamPriorityRange'_ Ptr CInt
a1' Ptr CInt
a2' IO CInt -> (CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
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 CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' ->
Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv Ptr CInt
a2'IO Int -> (Int -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a2'' ->
(Status, Int, Int) -> IO (Status, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'', Int
a2'')
{-# LINE 296 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetFlags"
cuCtxGetFlags'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetLimit"
cuCtxGetLimit'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetLimit"
cuCtxSetLimit'_ :: (C2HSImp.CInt -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetCacheConfig"
cuCtxGetCacheConfig'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetCacheConfig"
cuCtxSetCacheConfig'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetSharedMemConfig"
cuCtxGetSharedMemConfig'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetSharedMemConfig"
cuCtxSetSharedMemConfig'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetStreamPriorityRange"
cuCtxGetStreamPriorityRange'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))