{-# LINE 1 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Driver.Context.Primary (
status, setup, reset, retain, release,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 26 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
import Foreign.CUDA.Driver.Context.Base
import Foreign.CUDA.Driver.Device
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Control.Exception
import Control.Monad
import Foreign
import Foreign.C
{-# INLINEABLE status #-}
status :: Device -> IO (Bool, [ContextFlag])
status :: Device -> IO (Bool, [ContextFlag])
status !Device
dev =
Device -> IO (Status, [ContextFlag], Bool)
cuDevicePrimaryCtxGetState Device
dev IO (Status, [ContextFlag], Bool)
-> ((Status, [ContextFlag], Bool) -> IO (Bool, [ContextFlag]))
-> IO (Bool, [ContextFlag])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Status
rv, ![ContextFlag]
flags, !Bool
active) ->
case Status
rv of
Status
Success -> (Bool, [ContextFlag]) -> IO (Bool, [ContextFlag])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
active, [ContextFlag]
flags)
Status
_ -> CUDAException -> IO (Bool, [ContextFlag])
forall e a. Exception e => e -> IO a
throwIO (Status -> CUDAException
ExitCode Status
rv)
cuDevicePrimaryCtxGetState :: (Device) -> IO ((Status), ([ContextFlag]), (Bool))
cuDevicePrimaryCtxGetState :: Device -> IO (Status, [ContextFlag], Bool)
cuDevicePrimaryCtxGetState Device
a1 =
let {a1' :: CInt
a1' = Device -> CInt
useDevice Device
a1} in
(Ptr CUInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool))
-> (Ptr CUInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
a2' ->
(Ptr CInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool))
-> (Ptr CInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a3' ->
CInt -> Ptr CUInt -> Ptr CInt -> IO CInt
cuDevicePrimaryCtxGetState'_ CInt
a1' Ptr CUInt
a2' Ptr CInt
a3' IO CInt
-> (CInt -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. IO a -> (a -> IO b) -> IO b
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 CUInt -> IO [ContextFlag]
peekFlags Ptr CUInt
a2'IO [ContextFlag]
-> ([ContextFlag] -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ContextFlag]
a2'' ->
Ptr CInt -> IO Bool
forall a. (Integral a, Storable a) => Ptr a -> IO Bool
peekBool Ptr CInt
a3'IO Bool
-> (Bool -> IO (Status, [ContextFlag], Bool))
-> IO (Status, [ContextFlag], Bool)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
a3'' ->
(Status, [ContextFlag], Bool) -> IO (Status, [ContextFlag], Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', a2'', a3'')
{-# LINE 69 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
where
peekFlags = liftM extractBitMasks . peek
{-# INLINEABLE setup #-}
setup :: Device -> [ContextFlag] -> IO ()
setup :: Device -> [ContextFlag] -> IO ()
setup !Device
dev ![ContextFlag]
flags = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> [ContextFlag] -> IO Status
cuDevicePrimaryCtxSetFlags Device
dev [ContextFlag]
flags
{-# INLINE cuDevicePrimaryCtxSetFlags #-}
cuDevicePrimaryCtxSetFlags :: (Device) -> ([ContextFlag]) -> IO ((Status))
cuDevicePrimaryCtxSetFlags :: Device -> [ContextFlag] -> IO Status
cuDevicePrimaryCtxSetFlags Device
a1 [ContextFlag]
a2 =
let {a1' :: CInt
a1' = Device -> CInt
useDevice Device
a1} in
let {a2' :: CUInt
a2' = [ContextFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [ContextFlag]
a2} in
CInt -> CUInt -> IO CInt
cuDevicePrimaryCtxSetFlags'_ CInt
a1' CUInt
a2' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 95 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
{-# INLINEABLE reset #-}
reset :: Device -> IO ()
reset :: Device -> IO ()
reset !Device
dev = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO Status
cuDevicePrimaryCtxReset Device
dev
{-# INLINE cuDevicePrimaryCtxReset #-}
cuDevicePrimaryCtxReset :: (Device) -> IO ((Status))
cuDevicePrimaryCtxReset :: Device -> IO Status
cuDevicePrimaryCtxReset Device
a1 =
let {a1' :: CInt
a1' = Device -> CInt
useDevice Device
a1} in
CInt -> IO CInt
cuDevicePrimaryCtxReset'_ CInt
a1' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 116 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
{-# INLINEABLE release #-}
release :: Device -> IO ()
release :: Device -> IO ()
release !Device
dev = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO Status
cuDevicePrimaryCtxRelease Device
dev
{-# INLINE cuDevicePrimaryCtxRelease #-}
cuDevicePrimaryCtxRelease :: (Device) -> IO ((Status))
cuDevicePrimaryCtxRelease :: Device -> IO Status
cuDevicePrimaryCtxRelease Device
a1 =
let {a1' :: CInt
a1' = Device -> CInt
useDevice Device
a1} in
CInt -> IO CInt
cuDevicePrimaryCtxRelease'_ CInt
a1' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 141 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
{-# INLINEABLE retain #-}
retain :: Device -> IO Context
retain :: Device -> IO Context
retain !Device
dev = (Status, Context) -> IO Context
forall a. (Status, a) -> IO a
resultIfOk ((Status, Context) -> IO Context)
-> IO (Status, Context) -> IO Context
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO (Status, Context)
cuDevicePrimaryCtxRetain Device
dev
{-# INLINE cuDevicePrimaryCtxRetain #-}
cuDevicePrimaryCtxRetain :: (Device) -> IO ((Status), (Context))
cuDevicePrimaryCtxRetain :: Device -> IO (Status, Context)
cuDevicePrimaryCtxRetain Device
a2 =
(Ptr (Ptr ()) -> IO (Status, Context)) -> IO (Status, Context)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Status, Context)) -> IO (Status, Context))
-> (Ptr (Ptr ()) -> IO (Status, Context)) -> IO (Status, Context)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' ->
let {a2' :: CInt
a2' = Device -> CInt
useDevice Device
a2} in
Ptr (Ptr ()) -> CInt -> IO CInt
cuDevicePrimaryCtxRetain'_ Ptr (Ptr ())
a1' CInt
a2' IO CInt -> (CInt -> IO (Status, Context)) -> IO (Status, Context)
forall a b. IO a -> (a -> IO b) -> IO b
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 (Ptr ()) -> IO Context
peekCtx Ptr (Ptr ())
a1'IO Context
-> (Context -> IO (Status, Context)) -> IO (Status, Context)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Context
a1'' ->
(Status, Context) -> IO (Status, Context)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Context
a1'')
{-# LINE 166 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
where
peekCtx = liftM Context . peek
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxGetState"
cuDevicePrimaryCtxGetState'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxSetFlags"
cuDevicePrimaryCtxSetFlags'_ :: (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxReset"
cuDevicePrimaryCtxReset'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxRelease"
cuDevicePrimaryCtxRelease'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxRetain"
cuDevicePrimaryCtxRetain'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))