-- 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/Context/Primary.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Context.Primary
-- Copyright : [2009..2014] 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



{-# LINE 26 "./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 !dev =
  cuDevicePrimaryCtxGetState dev >>= \(rv, !flags, !active) ->
  case rv of
    Success -> return (active, flags)
    _       -> throwIO (ExitCode rv)

cuDevicePrimaryCtxGetState :: (Device) -> IO ((Status), ([ContextFlag]), (Bool))
cuDevicePrimaryCtxGetState a1 =
  let {a1' = useDevice a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  cuDevicePrimaryCtxGetState'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekFlags  a2'>>= \a2'' -> 
  peekBool  a3'>>= \a3'' -> 
  return (res', a2'', a3'')

{-# LINE 69 "./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 !dev !flags = nothingIfOk =<< cuDevicePrimaryCtxSetFlags dev flags

{-# INLINE cuDevicePrimaryCtxSetFlags #-}
cuDevicePrimaryCtxSetFlags :: (Device) -> ([ContextFlag]) -> IO ((Status))
cuDevicePrimaryCtxSetFlags a1 a2 =
  let {a1' = useDevice a1} in 
  let {a2' = combineBitMasks a2} in 
  cuDevicePrimaryCtxSetFlags'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 95 "./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 !dev = nothingIfOk =<< cuDevicePrimaryCtxReset dev

{-# INLINE cuDevicePrimaryCtxReset #-}
cuDevicePrimaryCtxReset :: (Device) -> IO ((Status))
cuDevicePrimaryCtxReset a1 =
  let {a1' = useDevice a1} in 
  cuDevicePrimaryCtxReset'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 116 "./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 !dev = nothingIfOk =<< cuDevicePrimaryCtxRelease dev

{-# INLINE cuDevicePrimaryCtxRelease #-}
cuDevicePrimaryCtxRelease :: (Device) -> IO ((Status))
cuDevicePrimaryCtxRelease a1 =
  let {a1' = useDevice a1} in 
  cuDevicePrimaryCtxRelease'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 141 "./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 !dev = resultIfOk =<< cuDevicePrimaryCtxRetain dev

{-# INLINE cuDevicePrimaryCtxRetain #-}
cuDevicePrimaryCtxRetain :: (Device) -> IO ((Status), (Context))
cuDevicePrimaryCtxRetain a2 =
  alloca $ \a1' -> 
  let {a2' = useDevice a2} in 
  cuDevicePrimaryCtxRetain'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekCtx  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 166 "./Foreign/CUDA/Driver/Context/Primary.chs" #-}

  where
    peekCtx = liftM Context . peek


foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxGetState"
  cuDevicePrimaryCtxGetState'_ :: (CInt -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxSetFlags"
  cuDevicePrimaryCtxSetFlags'_ :: (CInt -> (CUInt -> (IO CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxReset"
  cuDevicePrimaryCtxReset'_ :: (CInt -> (IO CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxRelease"
  cuDevicePrimaryCtxRelease'_ :: (CInt -> (IO CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Primary.chs.h cuDevicePrimaryCtxRetain"
  cuDevicePrimaryCtxRetain'_ :: ((Ptr (Ptr ())) -> (CInt -> (IO CInt)))