diff --git a/Foreign/CUDA/Analysis/Occupancy.hs b/Foreign/CUDA/Analysis/Occupancy.hs --- a/Foreign/CUDA/Analysis/Occupancy.hs +++ b/Foreign/CUDA/Analysis/Occupancy.hs @@ -48,7 +48,8 @@ module Foreign.CUDA.Analysis.Occupancy ( Occupancy(..), - occupancy, optimalBlockSize, maxResidentBlocks + occupancy, optimalBlockSize, optimalBlockSizeBy, maxResidentBlocks, + incPow2, incWarp ) where @@ -115,20 +116,54 @@ -- | -- Optimise multiprocessor occupancy as a function of thread block size and --- resource usage. This returns the smallest satisfying block size. +-- resource usage. This returns the smallest satisfying block size in increments +-- of a single warp. -- optimalBlockSize :: DeviceProperties -- ^ Architecture to optimise for -> (Int -> Int) -- ^ Register count as a function of thread block size -> (Int -> Int) -- ^ Shared memory usage (bytes) as a function of thread block size -> (Int, Occupancy) -optimalBlockSize dev freg fsmem +optimalBlockSize = flip optimalBlockSizeBy incWarp + + +-- | +-- As 'optimalBlockSize', but with a generator that produces the specific thread +-- block sizes that should be tested. The generated list can produce values in +-- any order, but should be monotonically decreasing to return the smallest +-- satisfying block size (and vice-versa). +-- +optimalBlockSizeBy + :: DeviceProperties + -> (DeviceProperties -> [Int]) + -> (Int -> Int) + -> (Int -> Int) + -> (Int, Occupancy) +optimalBlockSizeBy dev fblk freg fsmem = maximumBy (comparing (occupancy100 . snd)) $ zip threads residency where residency = map (\t -> occupancy dev t (freg t) (fsmem t)) threads - threads = let det = warpSize dev - mts = maxThreadsPerBlock dev - in enumFromThenTo mts (mts - det) det + threads = fblk dev + + +-- | Decrements in powers-of-two, over the range of supported thread block sizes +-- for the given device. +-- +incPow2 :: DeviceProperties -> [Int] +incPow2 dev = map ((2::Int)^) $ enumFromThenTo ub (ub-1) lb + where + round' = round :: Double -> Int + lb = round' . logBase 2 . fromIntegral $ warpSize dev + ub = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev + +-- | Decrements in the warp size of the device, over the range of supported +-- thread block sizes. +-- +incWarp :: DeviceProperties -> [Int] +incWarp dev = enumFromThenTo mts (mts - det) det + where + det = warpSize dev + mts = maxThreadsPerBlock dev -- | diff --git a/Foreign/CUDA/Driver.hs b/Foreign/CUDA/Driver.hs --- a/Foreign/CUDA/Driver.hs +++ b/Foreign/CUDA/Driver.hs @@ -26,7 +26,7 @@ import Foreign.CUDA.Driver.Device import Foreign.CUDA.Driver.Error import Foreign.CUDA.Driver.Exec -import Foreign.CUDA.Driver.Marshal hiding (useDeviceHandle, peekDevPtr) +import Foreign.CUDA.Driver.Marshal hiding (useDeviceHandle, peekDeviceHandle) import Foreign.CUDA.Driver.Module import Foreign.CUDA.Driver.Utils diff --git a/Foreign/CUDA/Driver/Marshal.chs b/Foreign/CUDA/Driver/Marshal.chs --- a/Foreign/CUDA/Driver/Marshal.chs +++ b/Foreign/CUDA/Driver/Marshal.chs @@ -30,7 +30,7 @@ memset, getDevicePtr, -- Internal - useDeviceHandle, peekDevPtr + useDeviceHandle, peekDeviceHandle ) where @@ -125,8 +125,8 @@ doMalloc x n = resultIfOk =<< cuMemAlloc (n * sizeOf x) {# fun unsafe cuMemAlloc - { alloca'- `DevicePtr a' peekDevPtr* - , `Int' } -> `Status' cToEnum #} + { alloca'- `DevicePtr a' peekDeviceHandle* + , `Int' } -> `Status' cToEnum #} where alloca' = F.alloca @@ -370,9 +370,9 @@ getDevicePtr flags hp = resultIfOk =<< cuMemHostGetDevicePointer hp flags {# fun unsafe cuMemHostGetDevicePointer - { alloca'- `DevicePtr a' peekDevPtr* + { alloca'- `DevicePtr a' peekDeviceHandle* , useHP `HostPtr a' - , combineBitMasks `[AllocFlag]' } -> `Status' cToEnum #} + , combineBitMasks `[AllocFlag]' } -> `Status' cToEnum #} where alloca' = F.alloca useHP = castPtr . useHostPtr @@ -382,10 +382,24 @@ -- Internal -------------------------------------------------------------------------------- --- Lift an opaque handle to a typed DevicePtr representation +-- Lift an opaque handle to a typed DevicePtr representation. The driver +-- interface requires this special type for 'mallocArray' and the like, which is +-- a 32-bit value on all platforms. -- -peekDevPtr :: Ptr {# type CUdeviceptr #} -> IO (DevicePtr a) -peekDevPtr p = DevicePtr . intPtrToPtr . fromIntegral <$> peek p +-- Tesla architecture products (compute 1.x) support only a 32-bit address space +-- and expect pointers passed to kernels of this width, while the Fermi +-- architecture (compute 2.x) supports 64-bit wide pointers. +-- +-- When interface with the driver functions, we require this special 32-bit +-- opaque type. When passing pointers to kernel functions, we must use the +-- native host pointer type. On 32-bit platforms, this distinction is +-- irrelevant. For Tesla devices executing on 64-bit host platforms, the runtime +-- will automatically squash pointers to 32-bits. Fermi architectures however +-- may use the entire bitwidth, so the 32-bit CUdeviceptr must be converted to +-- a 64-bit pointer by the application before passing to the kernel. +-- +peekDeviceHandle :: Ptr {# type CUdeviceptr #} -> IO (DevicePtr a) +peekDeviceHandle p = DevicePtr . intPtrToPtr . fromIntegral <$> peek p -- Use a device pointer as an opaque handle type -- diff --git a/Foreign/CUDA/Driver/Module.chs b/Foreign/CUDA/Driver/Module.chs --- a/Foreign/CUDA/Driver/Module.chs +++ b/Foreign/CUDA/Driver/Module.chs @@ -25,7 +25,7 @@ import Foreign.CUDA.Ptr import Foreign.CUDA.Driver.Error import Foreign.CUDA.Driver.Exec -import Foreign.CUDA.Driver.Marshal (peekDevPtr) +import Foreign.CUDA.Driver.Marshal (peekDeviceHandle) import Foreign.CUDA.Driver.Texture import Foreign.CUDA.Internal.C2HS @@ -111,10 +111,10 @@ resultIfOk (status,(dptr,bytes)) {# fun unsafe cuModuleGetGlobal - { alloca- `DevicePtr a' peekDevPtr* + { alloca- `DevicePtr a' peekDeviceHandle* , alloca- `Int' peekIntConv* , useModule `Module' - , withCString* `String' } -> `Status' cToEnum #} + , withCString* `String' } -> `Status' cToEnum #} -- | diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,16 +0,0 @@ -Change Log -~~~~~~~~~~ - -0.2.1 - * Improved configuration phase - * Fixes for 3.1 release changes - * Additional CUDA 3.1 bindings - -0.2 - * Occupancy calculator - * Textures - * Additional CUDA 3.0 bindings - -0.1 - * Initial release - diff --git a/cuda.cabal b/cuda.cabal --- a/cuda.cabal +++ b/cuda.cabal @@ -1,5 +1,5 @@ Name: cuda -Version: 0.2.1 +Version: 0.2.2 Synopsis: FFI binding to the CUDA interface for programming NVIDIA GPUs Description: The CUDA library provides a direct, general purpose C-like SPMD programming @@ -10,6 +10,30 @@ . . + /New in 0.2.2:/ + . + * Foreign.CUDA.Analysis.optimalBlockSizeBy + . + /New in 0.2.1:/ + . + * Improved cabal configuration phase + . + * Fixes for SDK 3.1 release changes + . + * Additional CUDA 3.1 bindings + . + /New in 0.2:/ + . + * Occupancy calculator + . + * Textures + . + * Additional CUDA 3.0 bindings + . + /New in 0.1:/ + . + * Initial release + . License: BSD3 License-file: LICENSE @@ -18,6 +42,7 @@ Maintainer: Trevor L. McDonell Category: Foreign Cabal-version: >=1.6 +Tested-with: GHC >= 6.12 Build-type: Custom Extra-tmp-files: cuda.buildinfo config.status config.log @@ -27,7 +52,6 @@ config.sub install-sh cuda.buildinfo.in - README Library Exposed-Modules: Foreign.CUDA @@ -63,8 +87,8 @@ Include-dirs: . C-sources: cbits/stubs.c - Build-tools: c2hs, hsc2hs + Build-tools: c2hs >= 0.16, hsc2hs Build-depends: base >= 3 && < 5, haskell98, bytestring, extensible-exceptions Extensions: - ghc-options: -Wall + ghc-options: -Wall -O2