{-# LINE 1 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE EmptyCase #-}
module Foreign.CUDA.Driver.Stream (
Stream(..), StreamPriority, StreamCallback,
StreamFlag(..), StreamWriteFlag(..), StreamWaitFlag(..), StreamCallbackFlag,
create, createWithPriority, destroy, finished, block, callback,
getFlags, getPriority, getContext,
write, wait,
defaultStream,
defaultStreamLegacy,
defaultStreamPerThread,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 36 "src/Foreign/CUDA/Driver/Stream.chs" #-}
import Foreign.CUDA.Ptr
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Context.Base ( Context(..) )
import Foreign.CUDA.Internal.C2HS
import Control.Exception ( throwIO )
import Control.Monad ( liftM )
import Foreign
import Foreign.C
import Unsafe.Coerce
import GHC.Base
import GHC.Ptr
import GHC.Word
newtype Stream = Stream { useStream :: ((C2HSImp.Ptr ()))}
deriving (Eq, Show)
type StreamPriority = Int
data StreamFlag = Default
| NonBlocking
deriving (Eq,Show,Bounded)
instance Enum StreamFlag where
succ Default = NonBlocking
succ NonBlocking = error "StreamFlag.succ: NonBlocking has no successor"
pred NonBlocking = Default
pred Default = error "StreamFlag.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 NonBlocking
fromEnum Default = 0
fromEnum NonBlocking = 1
toEnum 0 = Default
toEnum 1 = NonBlocking
toEnum unmatched = error ("StreamFlag.toEnum: Cannot match " ++ show unmatched)
{-# LINE 106 "src/Foreign/CUDA/Driver/Stream.chs" #-}
data StreamWriteFlag = WriteValueDefault
| WriteValueNoMemoryBarrier
deriving (Eq,Show,Bounded)
instance Enum StreamWriteFlag where
succ WriteValueDefault = WriteValueNoMemoryBarrier
succ WriteValueNoMemoryBarrier = error "StreamWriteFlag.succ: WriteValueNoMemoryBarrier has no successor"
pred WriteValueNoMemoryBarrier = WriteValueDefault
pred WriteValueDefault = error "StreamWriteFlag.pred: WriteValueDefault 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 WriteValueNoMemoryBarrier
fromEnum WriteValueDefault = 0
fromEnum WriteValueNoMemoryBarrier = 1
toEnum 0 = WriteValueDefault
toEnum 1 = WriteValueNoMemoryBarrier
toEnum unmatched = error ("StreamWriteFlag.toEnum: Cannot match " ++ show unmatched)
{-# LINE 110 "src/Foreign/CUDA/Driver/Stream.chs" #-}
data StreamWaitFlag = WaitValueGeq
| WaitValueEq
| WaitValueAnd
| WaitValueNor
| WaitValueFlush
deriving (Eq,Show,Bounded)
instance Enum StreamWaitFlag where
succ WaitValueGeq = WaitValueEq
succ WaitValueEq = WaitValueAnd
succ WaitValueAnd = WaitValueNor
succ WaitValueNor = WaitValueFlush
succ WaitValueFlush = error "StreamWaitFlag.succ: WaitValueFlush has no successor"
pred WaitValueEq = WaitValueGeq
pred WaitValueAnd = WaitValueEq
pred WaitValueNor = WaitValueAnd
pred WaitValueFlush = WaitValueNor
pred WaitValueGeq = error "StreamWaitFlag.pred: WaitValueGeq 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 WaitValueFlush
fromEnum WaitValueGeq = 0
fromEnum WaitValueEq = 1
fromEnum WaitValueAnd = 2
fromEnum WaitValueNor = 3
fromEnum WaitValueFlush = 1073741824
toEnum 0 = WaitValueGeq
toEnum 1 = WaitValueEq
toEnum 2 = WaitValueAnd
toEnum 3 = WaitValueNor
toEnum 1073741824 = WaitValueFlush
toEnum unmatched = error ("StreamWaitFlag.toEnum: Cannot match " ++ show unmatched)
{-# LINE 115 "src/Foreign/CUDA/Driver/Stream.chs" #-}
type StreamCallback = ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))))
{-# LINE 124 "src/Foreign/CUDA/Driver/Stream.chs" #-}
data StreamCallbackFlag
instance Enum StreamCallbackFlag where
toEnum x = error ("StreamCallbackFlag.toEnum: Cannot match " ++ show x)
fromEnum x = case x of {}
{-# INLINEABLE create #-}
create :: [StreamFlag] -> IO Stream
create !flags = resultIfOk =<< cuStreamCreate flags
{-# INLINE cuStreamCreate #-}
cuStreamCreate :: ([StreamFlag]) -> IO ((Status), (Stream))
cuStreamCreate a2 =
alloca $ \a1' ->
let {a2' = combineBitMasks a2} in
cuStreamCreate'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekStream a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 150 "src/Foreign/CUDA/Driver/Stream.chs" #-}
where
peekStream = liftM Stream . peek
{-# INLINEABLE createWithPriority #-}
createWithPriority :: StreamPriority -> [StreamFlag] -> IO Stream
createWithPriority !priority !flags = resultIfOk =<< cuStreamCreateWithPriority flags priority
{-# INLINE cuStreamCreateWithPriority #-}
cuStreamCreateWithPriority :: ([StreamFlag]) -> (StreamPriority) -> IO ((Status), (Stream))
cuStreamCreateWithPriority a2 a3 =
alloca $ \a1' ->
let {a2' = combineBitMasks a2} in
let {a3' = fromIntegral a3} in
cuStreamCreateWithPriority'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekStream a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 184 "src/Foreign/CUDA/Driver/Stream.chs" #-}
where
peekStream = liftM Stream . peek
{-# INLINEABLE destroy #-}
destroy :: Stream -> IO ()
destroy !st = nothingIfOk =<< cuStreamDestroy st
{-# INLINE cuStreamDestroy #-}
cuStreamDestroy :: (Stream) -> IO ((Status))
cuStreamDestroy a1 =
let {a1' = useStream a1} in
cuStreamDestroy'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 204 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE finished #-}
finished :: Stream -> IO Bool
finished !st =
cuStreamQuery st >>= \rv ->
case rv of
Success -> return True
NotReady -> return False
_ -> throwIO (ExitCode rv)
{-# INLINE cuStreamQuery #-}
cuStreamQuery :: (Stream) -> IO ((Status))
cuStreamQuery a1 =
let {a1' = useStream a1} in
cuStreamQuery'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 223 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE block #-}
block :: Stream -> IO ()
block !st = nothingIfOk =<< cuStreamSynchronize st
{-# INLINE cuStreamSynchronize #-}
cuStreamSynchronize :: (Stream) -> IO ((Status))
cuStreamSynchronize a1 =
let {a1' = useStream a1} in
cuStreamSynchronize'_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 237 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE getPriority #-}
getPriority :: Stream -> IO StreamPriority
getPriority !st = resultIfOk =<< cuStreamGetPriority st
{-# INLINE cuStreamGetPriority #-}
cuStreamGetPriority :: (Stream) -> IO ((Status), (StreamPriority))
cuStreamGetPriority a1 =
let {a1' = useStream a1} in
alloca $ \a2' ->
cuStreamGetPriority'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekIntConv a2'>>= \a2'' ->
return (res', a2'')
{-# LINE 260 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE getFlags #-}
getFlags :: (Stream) -> IO (([StreamFlag]))
getFlags a1 =
let {a1' = useStream a1} in
alloca $ \a2' ->
getFlags'_ a1' a2' >>= \res ->
checkStatus res >>
extract a2'>>= \a2'' ->
return (a2'')
{-# LINE 274 "src/Foreign/CUDA/Driver/Stream.chs" #-}
where
extract p = extractBitMasks `fmap` peek p
{-# INLINEABLE getContext #-}
getContext :: Stream -> IO Context
getContext !st = resultIfOk =<< cuStreamGetCtx st
{-# INLINE cuStreamGetCtx #-}
cuStreamGetCtx :: (Stream) -> IO ((Status), (Context))
cuStreamGetCtx a1 =
let {a1' = useStream a1} in
alloca $ \a2' ->
cuStreamGetCtx'_ a1' a2' >>= \res ->
let {res' = cToEnum res} in
peekCtx a2'>>= \a2'' ->
return (res', a2'')
{-# LINE 302 "src/Foreign/CUDA/Driver/Stream.chs" #-}
where
peekCtx = liftM Context . peek
{-# INLINEABLE write #-}
write :: Storable a => DevicePtr a -> a -> Stream -> [StreamWriteFlag] -> IO ()
write ptr val stream flags =
case sizeOf val of
4 -> write32 (castDevPtr ptr) (unsafeCoerce val) stream flags
8 -> write64 (castDevPtr ptr) (unsafeCoerce val) stream flags
_ -> cudaErrorIO "Stream.write: can only write 32- and 64-bit values"
{-# INLINE write32 #-}
write32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWriteFlag] -> IO ()
write32 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue32 stream ptr val flags
{-# INLINE cuStreamWriteValue32 #-}
cuStreamWriteValue32 :: (Stream) -> (DevicePtr Word32) -> (Word32) -> ([StreamWriteFlag]) -> IO ((Status))
cuStreamWriteValue32 a1 a2 a3 a4 =
let {a1' = useStream a1} in
let {a2' = useDeviceHandle a2} in
let {a3' = fromIntegral a3} in
let {a4' = combineBitMasks a4} in
cuStreamWriteValue32'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 343 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINE write64 #-}
write64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWriteFlag] -> IO ()
write64 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue64 stream ptr val flags
{-# INLINE cuStreamWriteValue64 #-}
cuStreamWriteValue64 :: (Stream) -> (DevicePtr Word64) -> (Word64) -> ([StreamWriteFlag]) -> IO ((Status))
cuStreamWriteValue64 a1 a2 a3 a4 =
let {a1' = useStream a1} in
let {a2' = useDeviceHandle a2} in
let {a3' = fromIntegral a3} in
let {a4' = combineBitMasks a4} in
cuStreamWriteValue64'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 360 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE wait #-}
wait :: Storable a => DevicePtr a -> a -> Stream -> [StreamWaitFlag] -> IO ()
wait ptr val stream flags =
case sizeOf val of
4 -> wait32 (castDevPtr ptr) (unsafeCoerce val) stream flags
8 -> wait64 (castDevPtr ptr) (unsafeCoerce val) stream flags
_ -> cudaErrorIO "Stream.wait: can only wait on 32- and 64-bit values"
{-# INLINE wait32 #-}
wait32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWaitFlag] -> IO ()
wait32 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue32 stream ptr val flags
{-# INLINE cuStreamWaitValue32 #-}
cuStreamWaitValue32 :: (Stream) -> (DevicePtr Word32) -> (Word32) -> ([StreamWaitFlag]) -> IO ((Status))
cuStreamWaitValue32 a1 a2 a3 a4 =
let {a1' = useStream a1} in
let {a2' = useDeviceHandle a2} in
let {a3' = fromIntegral a3} in
let {a4' = combineBitMasks a4} in
cuStreamWaitValue32'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 396 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINE wait64 #-}
wait64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWaitFlag] -> IO ()
wait64 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue64 stream ptr val flags
{-# INLINE cuStreamWaitValue64 #-}
cuStreamWaitValue64 :: (Stream) -> (DevicePtr Word64) -> (Word64) -> ([StreamWaitFlag]) -> IO ((Status))
cuStreamWaitValue64 a1 a2 a3 a4 =
let {a1' = useStream a1} in
let {a2' = useDeviceHandle a2} in
let {a3' = fromIntegral a3} in
let {a4' = combineBitMasks a4} in
cuStreamWaitValue64'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 412 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINEABLE callback #-}
callback :: (Stream) -> (StreamCallback) -> (Ptr ()) -> ([StreamCallbackFlag]) -> IO ()
callback a1 a2 a3 a4 =
let {a1' = useStream a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = combineBitMasks a4} in
callback'_ a1' a2' a3' a4' >>= \res ->
checkStatus res >>
return ()
{-# LINE 428 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# INLINE defaultStream #-}
defaultStream :: Stream
defaultStream = Stream (Ptr (int2Addr# 0#))
{-# INLINE defaultStreamLegacy #-}
defaultStreamLegacy :: Stream
defaultStreamLegacy = Stream (Ptr (int2Addr# 0x1#))
{-# INLINE defaultStreamPerThread #-}
defaultStreamPerThread :: Stream
defaultStreamPerThread = Stream (Ptr (int2Addr# 0x2#))
{-# INLINE useDeviceHandle #-}
useDeviceHandle :: DevicePtr a -> (C2HSImp.CULLong)
{-# LINE 475 "src/Foreign/CUDA/Driver/Stream.chs" #-}
useDeviceHandle (DevicePtr (Ptr addr#)) =
CULLong (W64# (int2Word# (addr2Int# addr#)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamCreate"
cuStreamCreate'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamCreateWithPriority"
cuStreamCreateWithPriority'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamDestroy"
cuStreamDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamQuery"
cuStreamQuery'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Foreign/CUDA/Driver/Stream.chs.h cuStreamSynchronize"
cuStreamSynchronize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetPriority"
cuStreamGetPriority'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetFlags"
getFlags'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetCtx"
cuStreamGetCtx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt)))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWriteValue32"
cuStreamWriteValue32'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWriteValue64"
cuStreamWriteValue64'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWaitValue32"
cuStreamWaitValue32'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWaitValue64"
cuStreamWaitValue64'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamAddCallback"
callback'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))