{-# LINE 1 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
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 { Event -> Ptr ()
useEvent :: ((C2HSImp.Ptr ()))}
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)
data EventFlag = Default
| BlockingSync
| DisableTiming
| Interprocess
deriving (EventFlag -> EventFlag -> Bool
(EventFlag -> EventFlag -> Bool)
-> (EventFlag -> EventFlag -> Bool) -> Eq EventFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventFlag -> EventFlag -> Bool
$c/= :: EventFlag -> EventFlag -> Bool
== :: EventFlag -> EventFlag -> Bool
$c== :: EventFlag -> EventFlag -> Bool
Eq,Int -> EventFlag -> ShowS
[EventFlag] -> ShowS
EventFlag -> String
(Int -> EventFlag -> ShowS)
-> (EventFlag -> String)
-> ([EventFlag] -> ShowS)
-> Show EventFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventFlag] -> ShowS
$cshowList :: [EventFlag] -> ShowS
show :: EventFlag -> String
$cshow :: EventFlag -> String
showsPrec :: Int -> EventFlag -> ShowS
$cshowsPrec :: Int -> EventFlag -> ShowS
Show,EventFlag
EventFlag -> EventFlag -> Bounded EventFlag
forall a. a -> a -> Bounded a
maxBound :: EventFlag
$cmaxBound :: EventFlag
minBound :: EventFlag
$cminBound :: EventFlag
Bounded)
instance Enum EventFlag where
succ :: EventFlag -> EventFlag
succ EventFlag
Default = EventFlag
BlockingSync
succ EventFlag
BlockingSync = EventFlag
DisableTiming
succ DisableTiming = Interprocess
succ Interprocess = error "EventFlag.succ: Interprocess has no successor"
pred :: EventFlag -> EventFlag
pred EventFlag
BlockingSync = EventFlag
Default
pred EventFlag
DisableTiming = EventFlag
BlockingSync
pred EventFlag
Interprocess = EventFlag
DisableTiming
pred EventFlag
Default = String -> EventFlag
forall a. HasCallStack => String -> a
error String
"EventFlag.pred: Default has no predecessor"
enumFromTo :: EventFlag -> EventFlag -> [EventFlag]
enumFromTo EventFlag
from EventFlag
to = EventFlag -> [EventFlag]
forall t. Enum t => t -> [t]
go EventFlag
from
where
end :: Int
end = EventFlag -> Int
forall a. Enum a => a -> Int
fromEnum EventFlag
to
go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
EQ -> [v]
Ordering
GT -> []
enumFrom :: EventFlag -> [EventFlag]
enumFrom EventFlag
from = EventFlag -> EventFlag -> [EventFlag]
forall a. Enum a => a -> a -> [a]
enumFromTo EventFlag
from EventFlag
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
{-# 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 :: 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
cuEventDestroy Event
ev
{-# INLINE cuEventDestroy #-}
cuEventDestroy :: (Event) -> IO ((Status))
cuEventDestroy :: Event -> IO Status
cuEventDestroy Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cuEventDestroy'_ 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 104 "src/Foreign/CUDA/Driver/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)
cuEventElapsedTime Event
ev1 Event
ev2
{-# INLINE cuEventElapsedTime #-}
cuEventElapsedTime :: (Event) -> (Event) -> IO ((Status), (Float))
cuEventElapsedTime :: Event -> Event -> IO (Status, Float)
cuEventElapsedTime 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
cuEventElapsedTime'_ 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 120 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE query #-}
query :: Event -> IO Bool
query :: Event -> IO Bool
query !Event
ev =
Event -> IO Status
cuEventQuery 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 cuEventQuery #-}
cuEventQuery :: (Event) -> IO ((Status))
cuEventQuery :: Event -> IO Status
cuEventQuery Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cuEventQuery'_ 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 139 "src/Foreign/CUDA/Driver/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
cuEventRecord Event
ev (Stream -> Maybe Stream -> Stream
forall a. a -> Maybe a -> a
fromMaybe Stream
defaultStream Maybe Stream
mst)
{-# INLINE cuEventRecord #-}
cuEventRecord :: (Event) -> (Stream) -> IO ((Status))
cuEventRecord :: Event -> Stream -> IO Status
cuEventRecord 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
cuEventRecord'_ 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 156 "src/Foreign/CUDA/Driver/Event.chs" #-}
{-# INLINEABLE wait #-}
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait !Event
ev !Maybe Stream
mst ![WaitFlag]
flags =
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
cuStreamWaitEvent (Stream -> Maybe Stream -> Stream
forall a. a -> Maybe a -> a
fromMaybe Stream
defaultStream Maybe Stream
mst) Event
ev [WaitFlag]
flags
{-# INLINE cuStreamWaitEvent #-}
cuStreamWaitEvent :: (Stream) -> (Event) -> ([WaitFlag]) -> IO ((Status))
cuStreamWaitEvent :: Stream -> Event -> [WaitFlag] -> IO Status
cuStreamWaitEvent 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
cuStreamWaitEvent'_ 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 182 "src/Foreign/CUDA/Driver/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
cuEventSynchronize Event
ev
{-# INLINE cuEventSynchronize #-}
cuEventSynchronize :: (Event) -> IO ((Status))
cuEventSynchronize :: Event -> IO Status
cuEventSynchronize Event
a1 =
let {a1' :: Ptr ()
a1' = Event -> Ptr ()
useEvent Event
a1} in
Ptr () -> IO CInt
cuEventSynchronize'_ 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 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))