-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Context/Primary.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Context.Primary
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Primary context management for low-level driver interface. The primary
-- context is unique per device and shared with the Runtime API. This
-- allows integration with other libraries using CUDA.
--
-- Since: CUDA-7.0
--
--------------------------------------------------------------------------------

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" #-}


-- Friends
import Foreign.CUDA.Driver.Context.Base
import Foreign.CUDA.Driver.Device
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Control.Exception
import Control.Monad
import Foreign
import Foreign.C


--------------------------------------------------------------------------------
-- Primary context management
--------------------------------------------------------------------------------


-- |
-- Get the status of the primary context. Returns whether the current
-- context is active, and the flags it was (or will be) created with.
--
-- Requires CUDA-7.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g65f3e018721b6d90aa05cfb56250f469>
--
{-# 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


-- |
-- Specify the flags that the primary context should be created with. Note
-- that this is an error if the primary context is already active.
--
-- Requires CUDA-7.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gd779a84f17acdad0d9143d9fe719cfdf>
--
{-# 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" #-}



-- |
-- Destroy all allocations and reset all state on the primary context of
-- the given device in the current process. Requires cuda-7.0
--
-- Requires CUDA-7.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g5d38802e8600340283958a117466ce12>
--
{-# 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" #-}



-- |
-- Release the primary context on the given device. If there are no more
-- references to the primary context it will be destroyed, regardless of
-- how many threads it is current to.
--
-- Unlike 'Foreign.CUDA.Driver.Context.Base.pop' this does not pop the
-- context from the stack in any circumstances.
--
-- Requires CUDA-7.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gf2a8bc16f8df0c88031f6a1ba3d6e8ad>
--
{-# 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" #-}



-- |
-- Retain the primary context for the given device, creating it if
-- necessary, and increasing its usage count. The caller must call
-- 'release' when done using the context. Unlike
-- 'Foreign.CUDA.Driver.Context.Base.create' the newly retained context is
-- not pushed onto the stack.
--
-- Requires CUDA-7.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g9051f2d5c31501997a6cb0530290a300>
--
{-# 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)))