{-# LINE 1 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE EmptyCase #-}
module Foreign.CUDA.Driver.Event (
Event(..), EventFlag(..), WaitFlag,
create, destroy, elapsedTime, query, record, wait, block
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 28 "src/Foreign/CUDA/Driver/Event.chs" #-}
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Stream ( Stream(..), defaultStream )
import Foreign
import Foreign.C
import Data.Maybe
import Control.Monad ( liftM )
import Control.Exception ( throwIO )
newtype Event = Event { useEvent :: ((C2HSImp.Ptr ()))}
deriving (Eq, Show)
data EventFlag = Default
| BlockingSync
| DisableTiming
| Interprocess
deriving (Eq,Show,Bounded)
instance Enum EventFlag where
succ Default = BlockingSync
succ BlockingSync = DisableTiming
succ DisableTiming = Interprocess
succ Interprocess = error "EventFlag.succ: Interprocess has no successor"
pred BlockingSync = Default
pred DisableTiming = BlockingSync
pred Interprocess = DisableTiming
pred Default = error "EventFlag.pred: Default 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 Interprocess
fromEnum Default = 0
fromEnum BlockingSync = 1
fromEnum DisableTiming = 2
fromEnum Interprocess = 4
toEnum 0 = Default
toEnum 1 = BlockingSync
toEnum 2 = DisableTiming
toEnum 4 = Interprocess
toEnum unmatched = error ("EventFlag.toEnum: Cannot match " ++ show unmatched)
{-# LINE 60 "src/Foreign/CUDA/Driver/Event.chs" #-}
data WaitFlag
instance Enum WaitFlag where
toEnum x = error ("WaitFlag.toEnum: Cannot match " ++ show x)
fromEnum x = case x of {}
{-# INLINEABLE create #-}
create :: [EventFlag] -> IO Event
create !flags = resultIfOk =<< cuEventCreate flags
{-# INLINE cuEventCreate #-}
cuEventCreate :: ([EventFlag]) -> IO ((Status), (Event))
cuEventCreate a2 =
alloca $ \a1' ->
let {a2' = combineBitMasks a2} in
cuEventCreate'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekEvt a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 89 "src/Foreign/CUDA/Driver/Event.chs" #-}
where peekEvt = liftM Event . peek
{-# INLINEABLE destroy #-}
destroy :: Event -> IO ()
destroy !ev = nothingIfOk =<< cuEventDestroy ev
{-# INLINE cuEventDestroy #-}
cuEventDestroy :: (Event) -> IO ((Status))
cuEventDestroy a1 =
let {a1' = useEvent a1} in
cuEventDestroy'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 104 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE elapsedTime #-}
elapsedTime :: Event -> Event -> IO Float
elapsedTime !ev1 !ev2 = resultIfOk =<< cuEventElapsedTime ev1 ev2
{-# INLINE cuEventElapsedTime #-}
cuEventElapsedTime :: (Event) -> (Event) -> IO ((Status), (Float))
cuEventElapsedTime a2 a3 =
alloca $ \a1' ->
let {a2' = useEvent a2} in
let {a3' = useEvent a3} in
cuEventElapsedTime'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekFloatConv a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 120 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE query #-}
query :: Event -> IO Bool
query !ev =
cuEventQuery ev >>= \rv ->
case rv of
Success -> return True
NotReady -> return False
_ -> throwIO (ExitCode rv)
{-# INLINE cuEventQuery #-}
cuEventQuery :: (Event) -> IO ((Status))
cuEventQuery a1 =
let {a1' = useEvent a1} in
cuEventQuery'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 139 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE record #-}
record :: Event -> Maybe Stream -> IO ()
record !ev !mst =
nothingIfOk =<< cuEventRecord ev (fromMaybe defaultStream mst)
{-# INLINE cuEventRecord #-}
cuEventRecord :: (Event) -> (Stream) -> IO ((Status))
cuEventRecord a1 a2 =
let {a1' = useEvent a1} in
let {a2' = useStream a2} in
cuEventRecord'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 156 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE wait #-}
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait !ev !mst !flags =
nothingIfOk =<< cuStreamWaitEvent (fromMaybe defaultStream mst) ev flags
{-# INLINE cuStreamWaitEvent #-}
cuStreamWaitEvent :: (Stream) -> (Event) -> ([WaitFlag]) -> IO ((Status))
cuStreamWaitEvent a1 a2 a3 =
let {a1' = useStream a1} in
let {a2' = useEvent a2} in
let {a3' = combineBitMasks a3} in
cuStreamWaitEvent'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 182 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE block #-}
block :: Event -> IO ()
block !ev = nothingIfOk =<< cuEventSynchronize ev
{-# INLINE cuEventSynchronize #-}
cuEventSynchronize :: (Event) -> IO ((Status))
cuEventSynchronize a1 =
let {a1' = useEvent a1} in
cuEventSynchronize'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 195 "src/Foreign/CUDA/Driver/Event.chs" #-}
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuEventCreate"
cuEventCreate'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuEventDestroy"
cuEventDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuEventElapsedTime"
cuEventElapsedTime'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuEventQuery"
cuEventQuery'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuEventRecord"
cuEventRecord'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Event.chs.h cuStreamWaitEvent"
cuStreamWaitEvent'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Foreign/CUDA/Driver/Event.chs.h cuEventSynchronize"
cuEventSynchronize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))