-- 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/Base.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE EmptyCase                #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Context.Base
-- Copyright : [2009..2015] Trevor L. McDonell
-- License   : BSD
--
-- Context management for the low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Context.Base (

  -- * Context Management
  Context(..), ContextFlag(..),
  create, destroy, device, pop, push, sync, get, set,

  -- Deprecated in CUDA-4.0
  attach, detach,

) where



{-# LINE 31 "./Foreign/CUDA/Driver/Context/Base.chs" #-}


-- Friends
import Foreign.CUDA.Driver.Device                       ( Device(..) )
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Control.Monad                                    ( liftM )


--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A device context
--
newtype Context = Context { useContext :: ((Ptr ()))}
  deriving (Eq, Show)


-- |
-- Context creation flags
--
data ContextFlag = SchedAuto
                 | SchedSpin
                 | SchedYield
                 | SchedBlockingSync
                 | BlockingSync
                 | SchedMask
                 | MapHost
                 | LmemResizeToMax
                 | FlagsMask
  deriving (Eq,Show,Bounded)
instance Enum ContextFlag where
  succ SchedAuto = SchedSpin
  succ SchedSpin = SchedYield
  succ SchedYield = SchedBlockingSync
  succ SchedBlockingSync = SchedMask
  succ BlockingSync = SchedMask
  succ SchedMask = MapHost
  succ MapHost = LmemResizeToMax
  succ LmemResizeToMax = FlagsMask
  succ FlagsMask = error "ContextFlag.succ: FlagsMask has no successor"

  pred SchedSpin = SchedAuto
  pred SchedYield = SchedSpin
  pred SchedBlockingSync = SchedYield
  pred BlockingSync = SchedYield
  pred SchedMask = SchedBlockingSync
  pred MapHost = SchedMask
  pred LmemResizeToMax = MapHost
  pred FlagsMask = LmemResizeToMax
  pred SchedAuto = error "ContextFlag.pred: SchedAuto 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 FlagsMask

  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)

{-# LINE 60 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



{-# DEPRECATED attach, detach "as of CUDA-4.0" #-}
{-# DEPRECATED BlockingSync "use SchedBlockingSync instead" #-}


--------------------------------------------------------------------------------
-- Context management
--------------------------------------------------------------------------------

-- |
-- Create a new CUDA context and associate it with the calling thread. The
-- context is created with a usage count of one, and the caller of 'create'
-- must call 'destroy' when done using the context. If a context is already
-- current to the thread, it is supplanted by the newly created context and
-- must be restored by a subsequent call to 'pop'.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g65dc0012348bc84810e2103a40d8e2cf>
--
{-# INLINEABLE create #-}
create :: Device -> [ContextFlag] -> IO Context
create !dev !flags = resultIfOk =<< cuCtxCreate flags dev

{-# INLINE cuCtxCreate #-}
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'')

{-# LINE 90 "./Foreign/CUDA/Driver/Context/Base.chs" #-}

  where peekCtx = liftM Context . peek


-- |
-- Increments the usage count of the context. API: no context flags are
-- currently supported, so this parameter must be empty.
--
{-# INLINEABLE attach #-}
attach :: Context -> [ContextFlag] -> IO ()
attach !ctx !flags = nothingIfOk =<< cuCtxAttach ctx flags

{-# INLINE cuCtxAttach #-}
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')

{-# LINE 105 "./Foreign/CUDA/Driver/Context/Base.chs" #-}

  where withCtx = with . useContext


-- |
-- Detach the context, and destroy if no longer used
--
{-# INLINEABLE detach #-}
detach :: Context -> IO ()
detach !ctx = nothingIfOk =<< cuCtxDetach ctx

{-# INLINE cuCtxDetach #-}
cuCtxDetach :: (Context) -> IO ((Status))
cuCtxDetach a1 =
  let {a1' = useContext a1} in 
  cuCtxDetach'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 118 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



-- |
-- Destroy the specified context, regardless of how many threads it is
-- current to. The context will be 'pop'ed from the current thread's
-- context stack, but if it is current on any other threads it will remain
-- current to those threads, and attempts to access it will result in an
-- error.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g27a365aebb0eb548166309f58a1e8b8e>
--
{-# INLINEABLE destroy #-}
destroy :: Context -> IO ()
destroy !ctx = nothingIfOk =<< cuCtxDestroy ctx

{-# INLINE cuCtxDestroy #-}
cuCtxDestroy :: (Context) -> IO ((Status))
cuCtxDestroy a1 =
  let {a1' = useContext a1} in 
  cuCtxDestroy'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 136 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



-- |
-- Return the context bound to the calling CPU thread.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g8f13165846b73750693640fb3e8380d0>
--
{-# INLINEABLE get #-}
get :: IO (Maybe Context)
get = resultIfOk =<< cuCtxGetCurrent

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

{-# LINE 155 "./Foreign/CUDA/Driver/Context/Base.chs" #-}

  where peekCtx = liftM (nothingIfNull Context) . peek


-- |
-- Bind the specified context to the calling thread.
--
-- Requires CUDA-4.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gbe562ee6258b4fcc272ca6478ca2a2f7>
--
{-# INLINEABLE set #-}
set :: Context -> IO ()
set !ctx = nothingIfOk =<< cuCtxSetCurrent ctx

{-# INLINE cuCtxSetCurrent #-}
cuCtxSetCurrent :: (Context) -> IO ((Status))
cuCtxSetCurrent a1 =
  let {a1' = useContext a1} in 
  cuCtxSetCurrent'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 177 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



-- |
-- Return the device of the currently active context
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g4e84b109eba36cdaaade167f34ae881e>
--
{-# INLINEABLE device #-}
device :: IO Device
device = resultIfOk =<< cuCtxGetDevice

{-# INLINE cuCtxGetDevice #-}
cuCtxGetDevice :: IO ((Status), (Device))
cuCtxGetDevice =
  alloca $ \a1' -> 
  cuCtxGetDevice'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  dev  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 191 "./Foreign/CUDA/Driver/Context/Base.chs" #-}

  where dev = liftM Device . peekIntConv


-- |
-- Pop the current CUDA context from the CPU thread. The context may then
-- be attached to a different CPU thread by calling 'push'.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2fac188026a062d92e91a8687d0a7902>
--
{-# INLINEABLE pop #-}
pop :: IO Context
pop = resultIfOk =<< cuCtxPopCurrent

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

{-# LINE 207 "./Foreign/CUDA/Driver/Context/Base.chs" #-}

  where peekCtx = liftM Context . peek


-- |
-- Push the given context onto the CPU's thread stack of current contexts.
-- The specified context becomes the CPU thread's current context, so all
-- operations that operate on the current context are affected.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gb02d4c850eb16f861fe5a29682cc90ba>
--
{-# INLINEABLE push #-}
push :: Context -> IO ()
push !ctx = nothingIfOk =<< cuCtxPushCurrent ctx

{-# INLINE cuCtxPushCurrent #-}
cuCtxPushCurrent :: (Context) -> IO ((Status))
cuCtxPushCurrent a1 =
  let {a1' = useContext a1} in 
  cuCtxPushCurrent'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 224 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



-- |
-- Block until the device has completed all preceding requests. If the
-- context was created with the 'SchedBlockingSync' flag, the CPU thread
-- will block until the GPU has finished its work.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g7a54725f28d34b8c6299f0c6ca579616>
--
{-# INLINEABLE sync #-}
sync :: IO ()
sync = nothingIfOk =<< cuCtxSynchronize

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

{-# LINE 240 "./Foreign/CUDA/Driver/Context/Base.chs" #-}



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

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

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

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

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

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

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

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

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

foreign import ccall safe "Foreign/CUDA/Driver/Context/Base.chs.h cuCtxSynchronize"
  cuCtxSynchronize'_ :: (IO CInt)