{-# LINE 1 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Foreign.CUDA.Runtime.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 25 "src/Foreign/CUDA/Runtime/Event.chs" #-}
import Foreign.CUDA.Driver.Event ( Event(..), EventFlag(..), WaitFlag )
import Foreign.CUDA.Driver.Stream ( Stream(..), defaultStream )
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Runtime.Error
import Foreign
import Foreign.C
import Control.Monad ( liftM )
import Control.Exception ( throwIO )
import Data.Maybe ( fromMaybe )
{-# INLINEABLE create #-}
create :: [EventFlag] -> IO Event
create :: [EventFlag] -> IO Event
create ![EventFlag]
flags = (Status, Event) -> IO Event
forall a. (Status, a) -> IO a
resultIfOk ((Status, Event) -> IO Event) -> IO (Status, Event) -> IO Event
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EventFlag] -> IO (Status, Event)
cudaEventCreateWithFlags [EventFlag]
flags
{-# INLINE cudaEventCreateWithFlags #-}
cudaEventCreateWithFlags :: ([EventFlag]) -> IO ((Status), (Event))
cudaEventCreateWithFlags :: [EventFlag] -> IO (Status, Event)
cudaEventCreateWithFlags [EventFlag]
a2 =
(Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event))
-> (Ptr (Ptr ()) -> IO (Status, Event)) -> IO (Status, Event)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' ->
let {a2' :: CUInt
a2' = [EventFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [EventFlag]
a2} in
Ptr (Ptr ()) -> CUInt -> IO CInt
cudaEventCreateWithFlags'_ Ptr (Ptr ())
a1' CUInt
a2' IO CInt -> (CInt -> IO (Status, Event)) -> IO (Status, Event)
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 Event
peekEvt Ptr (Ptr ())
a1'IO Event -> (Event -> IO (Status, Event)) -> IO (Status, Event)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Event
a1'' ->
(Status, Event) -> IO (Status, Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Event
a1'')
{-# LINE 55 "src/Foreign/CUDA/Runtime/Event.chs" #-}
where peekEvt = liftM Event . peek
{-# INLINEABLE destroy #-}
destroy :: Event -> IO ()
destroy :: Event -> IO ()
destroy !Event
ev = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> IO Status
cudaEventDestroy Event
ev
{-# INLINE cudaEventDestroy #-}
cudaEventDestroy :: (Event) -> IO ((Status))
cudaEventDestroy :: Event -> IO Status
cudaEventDestroy Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cudaEventDestroy'_ Ptr ()
a1' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 68 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# INLINEABLE elapsedTime #-}
elapsedTime :: Event -> Event -> IO Float
elapsedTime :: Event -> Event -> IO Float
elapsedTime !Event
ev1 !Event
ev2 = (Status, Float) -> IO Float
forall a. (Status, a) -> IO a
resultIfOk ((Status, Float) -> IO Float) -> IO (Status, Float) -> IO Float
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> Event -> IO (Status, Float)
cudaEventElapsedTime Event
ev1 Event
ev2
{-# INLINE cudaEventElapsedTime #-}
cudaEventElapsedTime :: (Event) -> (Event) -> IO ((Status), (Float))
cudaEventElapsedTime :: Event -> Event -> IO (Status, Float)
cudaEventElapsedTime Event
a2 Event
a3 =
(Ptr CFloat -> IO (Status, Float)) -> IO (Status, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Status, Float)) -> IO (Status, Float))
-> (Ptr CFloat -> IO (Status, Float)) -> IO (Status, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
a1' ->
let {a2' :: Ptr ()
a2' = Event -> Ptr ()
useEvent Event
a2} in
let {a3' :: Ptr ()
a3' = Event -> Ptr ()
useEvent Event
a3} in
Ptr CFloat -> Ptr () -> Ptr () -> IO CInt
cudaEventElapsedTime'_ Ptr CFloat
a1' Ptr ()
a2' Ptr ()
a3' IO CInt -> (CInt -> IO (Status, Float)) -> IO (Status, Float)
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 CFloat -> IO Float
forall a b. (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b
peekFloatConv Ptr CFloat
a1'IO Float -> (Float -> IO (Status, Float)) -> IO (Status, Float)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Float
a1'' ->
(Status, Float) -> IO (Status, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Float
a1'')
{-# LINE 82 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# INLINEABLE query #-}
query :: Event -> IO Bool
query :: Event -> IO Bool
query !Event
ev =
Event -> IO Status
cudaEventQuery Event
ev IO Status -> (Status -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
rv ->
case Status
rv of
Status
Success -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Status
NotReady -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Status
_ -> CUDAException -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (Status -> CUDAException
ExitCode Status
rv)
{-# INLINE cudaEventQuery #-}
cudaEventQuery :: (Event) -> IO ((Status))
cudaEventQuery :: Event -> IO Status
cudaEventQuery Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cudaEventQuery'_ Ptr ()
a1' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 99 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# INLINEABLE record #-}
record :: Event -> Maybe Stream -> IO ()
record :: Event -> Maybe Stream -> IO ()
record !Event
ev !Maybe Stream
mst =
Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> Stream -> IO Status
cudaEventRecord Event
ev (Stream -> (Stream -> Stream) -> Maybe Stream -> Stream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stream
defaultStream Stream -> Stream
forall a. a -> a
id Maybe Stream
mst)
{-# INLINE cudaEventRecord #-}
cudaEventRecord :: (Event) -> (Stream) -> IO ((Status))
cudaEventRecord :: Event -> Stream -> IO Status
cudaEventRecord Event
a1 Stream
a2 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
let {a2' :: Ptr ()
a2' = Stream -> Ptr ()
useStream Stream
a2} in
Ptr () -> Ptr () -> IO CInt
cudaEventRecord'_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 114 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# INLINEABLE wait #-}
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait !Event
ev !Maybe Stream
mst ![WaitFlag]
flags =
let st :: Stream
st = Stream -> Maybe Stream -> Stream
forall a. a -> Maybe a -> a
fromMaybe Stream
defaultStream Maybe Stream
mst
in Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Stream -> Event -> [WaitFlag] -> IO Status
cudaStreamWaitEvent Stream
st Event
ev [WaitFlag]
flags
{-# INLINE cudaStreamWaitEvent #-}
cudaStreamWaitEvent :: (Stream) -> (Event) -> ([WaitFlag]) -> IO ((Status))
cudaStreamWaitEvent :: Stream -> Event -> [WaitFlag] -> IO Status
cudaStreamWaitEvent Stream
a1 Event
a2 [WaitFlag]
a3 =
let {a1' :: Ptr ()
a1' = Stream -> Ptr ()
useStream Stream
a1} in
let {a2' :: Ptr ()
a2' = Event -> Ptr ()
useEvent Event
a2} in
let {a3' :: CUInt
a3' = [WaitFlag] -> CUInt
forall a b. (Enum a, Num b, Bits b) => [a] -> b
combineBitMasks [WaitFlag]
a3} in
Ptr () -> Ptr () -> CUInt -> IO CInt
cudaStreamWaitEvent'_ Ptr ()
a1' Ptr ()
a2' CUInt
a3' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 137 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# INLINEABLE block #-}
block :: Event -> IO ()
block :: Event -> IO ()
block !Event
ev = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> IO Status
cudaEventSynchronize Event
ev
{-# INLINE cudaEventSynchronize #-}
cudaEventSynchronize :: (Event) -> IO ((Status))
cudaEventSynchronize :: Event -> IO Status
cudaEventSynchronize Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cudaEventSynchronize'_ Ptr ()
a1' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')
{-# LINE 148 "src/Foreign/CUDA/Runtime/Event.chs" #-}
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventCreateWithFlags"
cudaEventCreateWithFlags'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventDestroy"
cudaEventDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventElapsedTime"
cudaEventElapsedTime'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventQuery"
cudaEventQuery'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventRecord"
cudaEventRecord'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaStreamWaitEvent"
cudaStreamWaitEvent'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Foreign/CUDA/Runtime/Event.chs.h cudaEventSynchronize"
cudaEventSynchronize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))