diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -4,6 +4,17 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/). +## [0.9.0.0] - 2017-11-15 +### Fixed + * Build fixes for CUDA-9 + +### Added + * `Peer.getAttribute` + * `Exec.launchKernelCooperative` + +### Changed + * Changed type of `Stream.wait` and `Stream.write` to support 64-bit values + ## [0.8.0.1] - 2017-10-24 ### Fixed * [#50] Escape backslashes used in -D flags on Windows @@ -92,6 +103,7 @@ * Add functions from CUDA-6.5 +[0.9.0.0]: https://github.com/tmcdonell/cuda/compare/0.8.0.1...0.9.0.0 [0.8.0.1]: https://github.com/tmcdonell/cuda/compare/0.8.0.0...0.8.0.1 [0.8.0.0]: https://github.com/tmcdonell/cuda/compare/0.7.5.3...0.8.0.0 [0.7.5.3]: https://github.com/tmcdonell/cuda/compare/0.7.5.2...0.7.5.3 diff --git a/cuda.cabal b/cuda.cabal --- a/cuda.cabal +++ b/cuda.cabal @@ -1,5 +1,5 @@ Name: cuda -Version: 0.8.0.1 +Version: 0.9.0.0 Synopsis: FFI binding to the CUDA interface for programming NVIDIA GPUs Description: The CUDA library provides a direct, general purpose C-like SPMD programming @@ -181,7 +181,6 @@ source-repository this type: git location: https://github.com/tmcdonell/cuda - tag: 0.8.0.1 + tag: 0.9.0.0 -- vim: nospell - diff --git a/examples/src/deviceQueryDrv/DeviceQuery.hs b/examples/src/deviceQueryDrv/DeviceQuery.hs --- a/examples/src/deviceQueryDrv/DeviceQuery.hs +++ b/examples/src/deviceQueryDrv/DeviceQuery.hs @@ -13,9 +13,10 @@ main :: IO () main = do - version <- CUDA.driverVersion + version <- CUDA.driverVersion printf "CUDA device query (Driver API, statically linked)\n" printf "CUDA driver version %d.%d\n" (version`div`1000) ((version`mod`100)`div`10) + printf "CUDA API version %d.%d\n" (CUDA.libraryVersion`div`1000) ((CUDA.libraryVersion`mod`100)`div`10) CUDA.initialise [] numDevices <- CUDA.count diff --git a/src/Foreign/CUDA/Driver/Context/Peer.chs b/src/Foreign/CUDA/Driver/Context/Peer.chs --- a/src/Foreign/CUDA/Driver/Context/Peer.chs +++ b/src/Foreign/CUDA/Driver/Context/Peer.chs @@ -21,8 +21,8 @@ module Foreign.CUDA.Driver.Context.Peer ( -- * Peer Access - PeerFlag, - accessible, add, remove, + PeerFlag, PeerAttribute(..), + accessible, add, remove, getAttribute, ) where @@ -55,6 +55,22 @@ #endif +-- | Peer-to-peer attributes +-- +#if CUDA_VERSION < 8000 +data PeerAttribute +instance Enum PeerAttribute where +#ifdef USE_EMPTY_CASE + toEnum x = case x of {} + fromEnum x = case x of {} +#endif +#else +{# enum CUdevice_P2PAttribute as PeerAttribute + { underscoreToCase } + with prefix="CU_DEVICE_P2P_ATTRIBUTE" deriving (Eq, Show) #} +#endif + + -------------------------------------------------------------------------------- -- Peer access -------------------------------------------------------------------------------- @@ -127,5 +143,31 @@ {-# INLINE cuCtxDisablePeerAccess #-} {# fun unsafe cuCtxDisablePeerAccess { useContext `Context' } -> `Status' cToEnum #} +#endif + + +-- | +-- Queries attributes of the link between two devices +-- +-- +-- +-- Requires CUDA-8.0 +-- +-- @since 0.9.0.0@ +-- +{-# INLINEABLE getAttribute #-} +getAttribute :: PeerAttribute -> Device -> Device -> IO Int +#if CUDA_VERSION < 8000 +getAttribute _ _ _ = requireSDK 'getAttribute 8.0 +#else +getAttribute attrib src dst = resultIfOk =<< cuDeviceGetP2PAttribute attrib src dst + +{-# INLINE cuDeviceGetP2PAttribute #-} +{# fun unsafe cuDeviceGetP2PAttribute + { alloca- `Int' peekIntConv* + , cFromEnum `PeerAttribute' + , useDevice `Device' + , useDevice `Device' + } -> `Status' cToEnum #} #endif diff --git a/src/Foreign/CUDA/Driver/Exec.chs b/src/Foreign/CUDA/Driver/Exec.chs --- a/src/Foreign/CUDA/Driver/Exec.chs +++ b/src/Foreign/CUDA/Driver/Exec.chs @@ -22,6 +22,7 @@ setCacheConfigFun, setSharedMemConfigFun, launchKernel, launchKernel', + launchKernelCooperative, -- Deprecated since CUDA-4.0 setBlockShape, setSharedSize, setParams, launch, @@ -279,6 +280,79 @@ launchKernel' = launchKernel #endif + +-- | +-- Invoke a kernel on a @(gx * gy * gz)@ grid of blocks, where each block +-- contains @(tx * ty * tz)@ threads and has access to a given number of bytes +-- of shared memory. The launch may also be associated with a specific stream. +-- +-- The thread blocks can cooperate and synchronise as they execute. +-- +-- The device on which this kernel is invoked must have +-- 'Foreign.CUDA.Driver.Device.attribute' +-- 'Foreign.CUDA.Driver.Device.CooperativeLaunch'. +-- +-- The total number of blocks launched can not exceed the maximum number of +-- active thread blocks per multiprocessor +-- ('Foreign.CUDA.Analysis.Device.threadBlocksPerMP'), multiplied by the number +-- of multiprocessors ('Foreign.CUDA.Analysis.Device.multiProcessorCount'). +-- +-- The kernel can not make use of dynamic parallelism. +-- +-- +-- +-- Requires CUDA-9.0 +-- +-- @since 0.9.0.0@ +-- +{-# INLINEABLE launchKernelCooperative #-} +launchKernelCooperative + :: Fun -- ^ function to execute + -> (Int,Int,Int) -- ^ block grid dimension + -> (Int,Int,Int) -- ^ thread block shape + -> Int -- ^ shared memory (bytes) + -> Maybe Stream -- ^ (optional) stream to execute in + -> [FunParam] -- ^ list of function parameters + -> IO () +#if CUDA_VERSION < 9000 +launchKernelCooperative _ _ _ _ _ _ = requireSDK 'launchKernelCooperative 9.0 +#else +launchKernelCooperative !fn (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !mst !args + = (=<<) nothingIfOk + $ withMany withFP args + $ \pa -> withArray pa + $ \pp -> cuLaunchCooperativeKernel fn gx gy gz tx ty tz sm st pp + where + !st = fromMaybe defaultStream mst + + withFP :: FunParam -> (Ptr FunParam -> IO b) -> IO b + withFP !p !f = case p of + IArg v -> with' v (f . castPtr) + FArg v -> with' v (f . castPtr) + VArg v -> with' v (f . castPtr) + + -- can't use the standard 'with' because 'alloca' will pass an undefined + -- dummy argument when determining 'sizeOf' and 'alignment', but sometimes + -- instances in Accelerate need to evaluate this argument. + -- + with' :: Storable a => a -> (Ptr a -> IO b) -> IO b + with' !val !f = + allocaBytes (sizeOf val) $ \ptr -> do + poke ptr val + f ptr + +{-# INLINE cuLaunchCooperativeKernel #-} +{# fun unsafe cuLaunchCooperativeKernel + { useFun `Fun' + , `Int', `Int', `Int' + , `Int', `Int', `Int' + , `Int' + , useStream `Stream' + , castPtr `Ptr (Ptr FunParam)' + } -> `Status' cToEnum #} +#endif + +-- TODO: cuLaunchCooperativeKernelMultiDevice introduced CUDA-9.0 -------------------------------------------------------------------------------- -- Deprecated diff --git a/src/Foreign/CUDA/Driver/Module/Base.chs b/src/Foreign/CUDA/Driver/Module/Base.chs --- a/src/Foreign/CUDA/Driver/Module/Base.chs +++ b/src/Foreign/CUDA/Driver/Module/Base.chs @@ -278,10 +278,12 @@ {-# INLINE jitTargetOfCompute #-} jitTargetOfCompute :: Compute -> JITTarget +#if CUDA_VERSION < 9000 jitTargetOfCompute (Compute 1 0) = Compute10 jitTargetOfCompute (Compute 1 1) = Compute11 jitTargetOfCompute (Compute 1 2) = Compute12 jitTargetOfCompute (Compute 1 3) = Compute13 +#endif jitTargetOfCompute (Compute 2 0) = Compute20 jitTargetOfCompute (Compute 2 1) = Compute21 #if CUDA_VERSION >= 5000 diff --git a/src/Foreign/CUDA/Driver/Stream.chs b/src/Foreign/CUDA/Driver/Stream.chs --- a/src/Foreign/CUDA/Driver/Stream.chs +++ b/src/Foreign/CUDA/Driver/Stream.chs @@ -15,7 +15,7 @@ module Foreign.CUDA.Driver.Stream ( -- * Stream Management - Stream(..), StreamFlag, StreamWriteFlag(..), StreamWaitFlag(..), + Stream(..), StreamFlag(..), StreamWriteFlag(..), StreamWaitFlag(..), create, createWithPriority, destroy, finished, block, getPriority, write, wait, @@ -27,15 +27,17 @@ {# context lib="cuda" #} -- Friends +import Foreign.CUDA.Ptr import Foreign.CUDA.Types import Foreign.CUDA.Driver.Error import Foreign.CUDA.Internal.C2HS -- System +import Control.Exception ( throwIO ) +import Control.Monad ( liftM ) import Foreign import Foreign.C -import Control.Monad ( liftM ) -import Control.Exception ( throwIO ) +import Unsafe.Coerce -------------------------------------------------------------------------------- @@ -187,20 +189,32 @@ -- -- -- --- Requires CUDA-8.0. +-- -- +-- Requires CUDA-8.0 for 32-bit values. +-- +-- Requires CUDA-9.0 for 64-bit values. +-- {-# INLINEABLE write #-} -write :: DevicePtr Int32 -> Int32 -> Stream -> [StreamWriteFlag] -> IO () +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 + _ -> cudaError "Stream.write: can only write 32- and 64-bit values" + +{-# INLINE write32 #-} +write32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWriteFlag] -> IO () #if CUDA_VERSION < 8000 -write _ _ _ _ = requireSDK 'write 8.0 +write32 _ _ _ _ = requireSDK 'write32 8.0 #else -write ptr val stream flags = nothingIfOk =<< cuStreamWriteValue32 stream ptr val flags +write32 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue32 stream ptr val flags {-# INLINE cuStreamWriteValue32 #-} {# fun unsafe cuStreamWriteValue32 { useStream `Stream' - , useDeviceHandle `DevicePtr Int32' - , `Int32' + , useDeviceHandle `DevicePtr Word32' + , `Word32' , combineBitMasks `[StreamWriteFlag]' } -> `Status' cToEnum #} @@ -208,26 +222,75 @@ useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr #endif +{-# INLINE write64 #-} +write64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWriteFlag] -> IO () +#if CUDA_VERSION < 9000 +write64 _ _ _ _ = requireSDK 'write64 9.0 +#else +write64 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue64 stream ptr val flags +{-# INLINE cuStreamWriteValue64 #-} +{# fun unsafe cuStreamWriteValue64 + { useStream `Stream' + , useDeviceHandle `DevicePtr Word64' + , `Word64' + , combineBitMasks `[StreamWriteFlag]' + } + -> `Status' cToEnum #} + where + useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr +#endif + + -- | Wait on a memory location. Work ordered after the operation will block -- until the given condition on the memory is satisfied. -- -- -- --- Requires CUDA-8.0. +-- -- +-- Requires CUDA-8.0 for 32-bit values. +-- +-- Requires CUDA-9.0 for 64-bit values. +-- {-# INLINEABLE wait #-} -wait :: DevicePtr Int32 -> Int32 -> Stream -> [StreamWaitFlag] -> IO () +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 + _ -> cudaError "Stream.wait: can only wait on 32- and 64-bit values" + +{-# INLINE wait32 #-} +wait32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWaitFlag] -> IO () #if CUDA_VERSION < 8000 -wait _ _ _ _ = requireSDK 'wait 8.0 +wait32 _ _ _ _ = requireSDK 'wait32 8.0 #else -wait ptr val stream flags = nothingIfOk =<< cuStreamWaitValue32 stream ptr val flags +wait32 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue32 stream ptr val flags {-# INLINE cuStreamWaitValue32 #-} {# fun unsafe cuStreamWaitValue32 { useStream `Stream' - , useDeviceHandle `DevicePtr Int32' - , `Int32' + , useDeviceHandle `DevicePtr Word32' + , `Word32' + , combineBitMasks `[StreamWaitFlag]' + } -> `Status' cToEnum #} + where + useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr +#endif + +{-# INLINE wait64 #-} +wait64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWaitFlag] -> IO () +#if CUDA_VERSION < 9000 +wait64 _ _ _ _ = requireSDK 'wait64 9.0 +#else +wait64 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue64 stream ptr val flags + +{-# INLINE cuStreamWaitValue64 #-} +{# fun unsafe cuStreamWaitValue64 + { useStream `Stream' + , useDeviceHandle `DevicePtr Word64' + , `Word64' , combineBitMasks `[StreamWaitFlag]' } -> `Status' cToEnum #} where diff --git a/src/Foreign/CUDA/Driver/Utils.chs b/src/Foreign/CUDA/Driver/Utils.chs --- a/src/Foreign/CUDA/Driver/Utils.chs +++ b/src/Foreign/CUDA/Driver/Utils.chs @@ -12,6 +12,7 @@ module Foreign.CUDA.Driver.Utils ( driverVersion, + libraryVersion, ) where @@ -37,4 +38,13 @@ {-# INLINE cuDriverGetVersion #-} {# fun unsafe cuDriverGetVersion { alloca- `Int' peekIntConv* } -> `Status' cToEnum #} + + +-- | +-- Return the version number of the CUDA library (API) that this package was +-- compiled against. +-- +{-# INLINEABLE libraryVersion #-} +libraryVersion :: Int +libraryVersion = {#const CUDA_VERSION #} diff --git a/src/Foreign/CUDA/Runtime/Utils.chs b/src/Foreign/CUDA/Runtime/Utils.chs --- a/src/Foreign/CUDA/Runtime/Utils.chs +++ b/src/Foreign/CUDA/Runtime/Utils.chs @@ -13,6 +13,7 @@ runtimeVersion, driverVersion, + libraryVersion, ) where @@ -50,4 +51,13 @@ {-# INLINE cudaDriverGetVersion #-} {# fun unsafe cudaDriverGetVersion { alloca- `Int' peekIntConv* } -> `Status' cToEnum #} + + +-- | +-- Return the version number of the CUDA library (API) that this package was +-- compiled against. +-- +{-# INLINEABLE libraryVersion #-} +libraryVersion :: Int +libraryVersion = {#const CUDART_VERSION #} diff --git a/src/Foreign/CUDA/Types.chs b/src/Foreign/CUDA/Types.chs --- a/src/Foreign/CUDA/Types.chs +++ b/src/Foreign/CUDA/Types.chs @@ -24,7 +24,7 @@ Event(..), EventFlag(..), WaitFlag, -- * Streams - Stream(..), StreamPriority, StreamFlag, + Stream(..), StreamFlag(..), StreamPriority, defaultStream, ) where @@ -98,7 +98,9 @@ -- Event creation flags -- {# enum CUevent_flags as EventFlag - { underscoreToCase } + { underscoreToCase + , CU_EVENT_DEFAULT as EventDefault + } with prefix="CU_EVENT" deriving (Eq, Show, Bounded) #} -- | @@ -135,15 +137,23 @@ type StreamPriority = Int -- | --- Possible option flags for stream initialisation. Dummy instance until the API --- exports actual option values. +-- Execution stream creation flags -- +#if CUDA_VERSION < 7500 data StreamFlag instance Enum StreamFlag where #ifdef USE_EMPTY_CASE toEnum x = case x of {} fromEnum x = case x of {} #endif +#else +{# enum CUstream_flags as StreamFlag + { underscoreToCase + , CU_STREAM_DEFAULT as StreamDefault + } + with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #} +#endif + -- | -- The main execution stream. No operations overlap with operations in the