-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/Driver/Context.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Context
-- Copyright : (c) [2009..2012] Trevor L. McDonell
-- License   : BSD
--
-- Context management for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Context (

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

  -- * Peer Access
  PeerFlag,
  accessible, add, remove,

  -- * Cache Configuration
  Cache(..), Limit(..),
  getLimit, setLimit, setCacheConfig

) where



{-# LINE 32 "./Foreign/CUDA/Driver/Context.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)
instance Enum ContextFlag where
  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 61 "./Foreign/CUDA/Driver/Context.chs" #-}


-- |
-- Device limits flags
--
data Limit = StackSize
           | PrintfFifoSize
           | MallocHeapSize
           | DevRuntimeSyncDepth
           | DevRuntimePendingLaunchCount
           | Max
           deriving (Eq,Show)
instance Enum Limit where
  fromEnum StackSize = 0
  fromEnum PrintfFifoSize = 1
  fromEnum MallocHeapSize = 2
  fromEnum DevRuntimeSyncDepth = 3
  fromEnum DevRuntimePendingLaunchCount = 4
  fromEnum Max = 5

  toEnum 0 = StackSize
  toEnum 1 = PrintfFifoSize
  toEnum 2 = MallocHeapSize
  toEnum 3 = DevRuntimeSyncDepth
  toEnum 4 = DevRuntimePendingLaunchCount
  toEnum 5 = Max
  toEnum unmatched = error ("Limit.toEnum: Cannot match " ++ show unmatched)

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


-- |
-- Device cache configuration preference
--
data Cache = PreferNone
           | PreferShared
           | PreferL1
           | PreferEqual
           deriving (Eq,Show)
instance Enum Cache where
  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 83 "./Foreign/CUDA/Driver/Context.chs" #-}


-- |
-- Possible option values for direct peer memory access
--
data PeerFlag
instance Enum PeerFlag where


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


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

-- |
-- Create a new CUDA context and associate it with the calling thread
--
{-# 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 113 "./Foreign/CUDA/Driver/Context.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 128 "./Foreign/CUDA/Driver/Context.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 141 "./Foreign/CUDA/Driver/Context.chs" #-}



-- |
-- Destroy the specified context. This fails if the context is more than a
-- single attachment (including that from initial creation).
--
{-# 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 154 "./Foreign/CUDA/Driver/Context.chs" #-}



-- |
-- Return the context bound to the calling CPU thread. Requires cuda-4.0.
--
{-# INLINEABLE get #-}
get :: IO Context
get = resultIfOk =<< cuCtxGetCurrent

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

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

  where peekCtx = liftM Context . peek


-- |
-- Bind the specified context to the calling thread. Requires cuda-4.0.
--
{-# 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 187 "./Foreign/CUDA/Driver/Context.chs" #-}


-- |
-- Return the device of the currently active context
--
{-# 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 198 "./Foreign/CUDA/Driver/Context.chs" #-}

  where dev = liftM Device . peekIntConv


-- |
-- Pop the current CUDA context from the CPU thread. The context must have a
-- single usage count (matching calls to 'attach' and 'detach'). If successful,
-- the new context is returned, and the old may be attached to a different CPU.
--
{-# 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 213 "./Foreign/CUDA/Driver/Context.chs" #-}

  where peekCtx = liftM Context . peek


-- |
-- Push the given context onto the CPU's thread stack of current contexts. The
-- context must be floating (via 'pop'), i.e. not attached to any thread.
--
{-# 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 227 "./Foreign/CUDA/Driver/Context.chs" #-}



-- |
-- Block until the device has completed all preceding requests
--
{-# INLINEABLE sync #-}
sync :: IO ()
sync = nothingIfOk =<< cuCtxSynchronize

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

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



--------------------------------------------------------------------------------
-- Peer access
--------------------------------------------------------------------------------

-- |
-- Queries if the first device can directly access the memory of the second. If
-- direct access is possible, it can then be enabled with 'add'. Requires
-- cuda-4.0.
--
{-# INLINEABLE accessible #-}
accessible :: Device -> Device -> IO Bool
accessible !dev !peer = resultIfOk =<< cuDeviceCanAccessPeer dev peer

{-# INLINE cuDeviceCanAccessPeer #-}
cuDeviceCanAccessPeer :: (Device) -> (Device) -> IO ((Status), (Bool))
cuDeviceCanAccessPeer a2 a3 =
  alloca $ \a1' -> 
  let {a2' = useDevice a2} in 
  let {a3' = useDevice a3} in 
  cuDeviceCanAccessPeer'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekBool  a1'>>= \a1'' -> 
  return (res', a1'')

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



-- |
-- If the devices of both the current and supplied contexts support unified
-- addressing, then enable allocations in the supplied context to be accessible
-- by the current context. Requires cuda-4.0.
--
{-# INLINEABLE add #-}
add :: Context -> [PeerFlag] -> IO ()
add !ctx !flags = nothingIfOk =<< cuCtxEnablePeerAccess ctx flags

{-# INLINE cuCtxEnablePeerAccess #-}
cuCtxEnablePeerAccess :: (Context) -> ([PeerFlag]) -> IO ((Status))
cuCtxEnablePeerAccess a1 a2 =
  let {a1' = useContext a1} in 
  let {a2' = combineBitMasks a2} in 
  cuCtxEnablePeerAccess'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

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



-- |
-- Disable direct memory access from the current context to the supplied
-- context. Requires cuda-4.0.
--
{-# INLINEABLE remove #-}
remove :: Context -> IO ()
remove !ctx = nothingIfOk =<< cuCtxDisablePeerAccess ctx

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

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



--------------------------------------------------------------------------------
-- Cache configuration
--------------------------------------------------------------------------------

-- |
-- Query compute 2.0 call stack limits. Requires cuda-3.1.
--
{-# INLINEABLE getLimit #-}
getLimit :: Limit -> IO Int
getLimit !l = resultIfOk =<< cuCtxGetLimit l

{-# INLINE cuCtxGetLimit #-}
cuCtxGetLimit :: (Limit) -> IO ((Status), (Int))
cuCtxGetLimit a2 =
  alloca $ \a1' -> 
  let {a2' = cFromEnum a2} in 
  cuCtxGetLimit'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekIntConv  a1'>>= \a1'' -> 
  return (res', a1'')

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


-- |
-- Specify the size of the call stack, for compute 2.0 devices. Requires
-- cuda-3.1.
--
{-# INLINEABLE setLimit #-}
setLimit :: Limit -> Int -> IO ()
setLimit !l !n = nothingIfOk =<< cuCtxSetLimit l n

{-# INLINE cuCtxSetLimit #-}
cuCtxSetLimit :: (Limit) -> (Int) -> IO ((Status))
cuCtxSetLimit a1 a2 =
  let {a1' = cFromEnum a1} in 
  let {a2' = cIntConv a2} in 
  cuCtxSetLimit'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

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


-- |
-- On devices where the L1 cache and shared memory use the same hardware
-- resources, this sets the preferred cache configuration for the current
-- context. This is only a preference. Requires cuda-3.2.
--
{-# INLINEABLE setCacheConfig #-}
setCacheConfig :: Cache -> IO ()
setCacheConfig !c = nothingIfOk =<< cuCtxSetCacheConfig c

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

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



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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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