diff --git a/Foreign/CUDA/Analysis.hs b/Foreign/CUDA/Analysis.hs --- a/Foreign/CUDA/Analysis.hs +++ b/Foreign/CUDA/Analysis.hs @@ -8,9 +8,13 @@ -- -------------------------------------------------------------------------------- -module Foreign.CUDA.Analysis (module Analysis) - where +module Foreign.CUDA.Analysis ( -import Foreign.CUDA.Analysis.Device as Analysis -import Foreign.CUDA.Analysis.Occupancy as Analysis + module Foreign.CUDA.Analysis.Device, + module Foreign.CUDA.Analysis.Occupancy + +) where + +import Foreign.CUDA.Analysis.Device +import Foreign.CUDA.Analysis.Occupancy diff --git a/Foreign/CUDA/Analysis/Device.chs b/Foreign/CUDA/Analysis/Device.chs --- a/Foreign/CUDA/Analysis/Device.chs +++ b/Foreign/CUDA/Analysis/Device.chs @@ -40,50 +40,50 @@ data DeviceProperties = DeviceProperties { deviceName :: String, -- ^ Identifier - computeCapability :: Compute, -- ^ Supported compute capability - totalGlobalMem :: Int64, -- ^ Available global memory on the device in bytes - totalConstMem :: Int64, -- ^ Available constant memory on the device in bytes - sharedMemPerBlock :: Int64, -- ^ Available shared memory per block in bytes - regsPerBlock :: Int, -- ^ 32-bit registers per block - warpSize :: Int, -- ^ Warp size in threads (SIMD width) - maxThreadsPerBlock :: Int, -- ^ Max number of threads per block + computeCapability :: !Compute, -- ^ Supported compute capability + totalGlobalMem :: !Int64, -- ^ Available global memory on the device in bytes + totalConstMem :: !Int64, -- ^ Available constant memory on the device in bytes + sharedMemPerBlock :: !Int64, -- ^ Available shared memory per block in bytes + regsPerBlock :: !Int, -- ^ 32-bit registers per block + warpSize :: !Int, -- ^ Warp size in threads (SIMD width) + maxThreadsPerBlock :: !Int, -- ^ Max number of threads per block #if CUDA_VERSION >= 4000 - maxThreadsPerMultiProcessor :: Int, -- ^ Max number of threads per multiprocessor + maxThreadsPerMultiProcessor :: !Int, -- ^ Max number of threads per multiprocessor #endif - maxBlockSize :: (Int,Int,Int), -- ^ Max size of each dimension of a block - maxGridSize :: (Int,Int,Int), -- ^ Max size of each dimension of a grid + maxBlockSize :: !(Int,Int,Int), -- ^ Max size of each dimension of a block + maxGridSize :: !(Int,Int,Int), -- ^ Max size of each dimension of a grid #if CUDA_VERSION >= 3000 - maxTextureDim1D :: Int, -- ^ Maximum texture dimensions - maxTextureDim2D :: (Int,Int), - maxTextureDim3D :: (Int,Int,Int), + maxTextureDim1D :: !Int, -- ^ Maximum texture dimensions + maxTextureDim2D :: !(Int,Int), + maxTextureDim3D :: !(Int,Int,Int), #endif - clockRate :: Int, -- ^ Clock frequency in kilohertz - multiProcessorCount :: Int, -- ^ Number of multiprocessors on the device - memPitch :: Int64, -- ^ Max pitch in bytes allowed by memory copies + clockRate :: !Int, -- ^ Clock frequency in kilohertz + multiProcessorCount :: !Int, -- ^ Number of multiprocessors on the device + memPitch :: !Int64, -- ^ Max pitch in bytes allowed by memory copies #if CUDA_VERSION >= 4000 - memBusWidth :: Int, -- ^ Global memory bus width in bits - memClockRate :: Int, -- ^ Peak memory clock frequency in kilohertz + memBusWidth :: !Int, -- ^ Global memory bus width in bits + memClockRate :: !Int, -- ^ Peak memory clock frequency in kilohertz #endif - textureAlignment :: Int64, -- ^ Alignment requirement for textures - computeMode :: ComputeMode, - deviceOverlap :: Bool, -- ^ Device can concurrently copy memory and execute a kernel + textureAlignment :: !Int64, -- ^ Alignment requirement for textures + computeMode :: !ComputeMode, + deviceOverlap :: !Bool, -- ^ Device can concurrently copy memory and execute a kernel #if CUDA_VERSION >= 3000 - concurrentKernels :: Bool, -- ^ Device can possibly execute multiple kernels concurrently - eccEnabled :: Bool, -- ^ Device supports and has enabled error correction + concurrentKernels :: !Bool, -- ^ Device can possibly execute multiple kernels concurrently + eccEnabled :: !Bool, -- ^ Device supports and has enabled error correction #endif #if CUDA_VERSION >= 4000 - asyncEngineCount :: Int, -- ^ Number of asynchronous engines - cacheMemL2 :: Int, -- ^ Size of the L2 cache in bytes - tccDriverEnabled :: Bool, -- ^ Whether this is a Tesla device using the TCC driver - pciInfo :: PCI, -- ^ PCI device information for the device + asyncEngineCount :: !Int, -- ^ Number of asynchronous engines + cacheMemL2 :: !Int, -- ^ Size of the L2 cache in bytes + tccDriverEnabled :: !Bool, -- ^ Whether this is a Tesla device using the TCC driver + pciInfo :: !PCI, -- ^ PCI device information for the device #endif - kernelExecTimeoutEnabled :: Bool, -- ^ Whether there is a runtime limit on kernels - integrated :: Bool, -- ^ As opposed to discrete + kernelExecTimeoutEnabled :: !Bool, -- ^ Whether there is a runtime limit on kernels + integrated :: !Bool, -- ^ As opposed to discrete #if CUDA_VERSION >= 4000 - canMapHostMemory :: Bool, -- ^ Device can use pinned memory - unifiedAddressing :: Bool -- ^ Device shares a unified address space with the host + canMapHostMemory :: !Bool, -- ^ Device can use pinned memory + unifiedAddressing :: !Bool -- ^ Device shares a unified address space with the host #else - canMapHostMemory :: Bool -- ^ Device can use pinned memory + canMapHostMemory :: !Bool -- ^ Device can use pinned memory #endif } deriving (Show) @@ -91,9 +91,9 @@ data PCI = PCI { - busID :: Int, -- ^ PCI bus ID of the device - deviceID :: Int, -- ^ PCI device ID - domainID :: Int -- ^ PCI domain ID + busID :: !Int, -- ^ PCI bus ID of the device + deviceID :: !Int, -- ^ PCI device ID + domainID :: !Int -- ^ PCI domain ID } deriving (Show) @@ -103,16 +103,16 @@ data Allocation = Warp | Block data DeviceResources = DeviceResources { - threadsPerWarp :: Int, -- ^ Warp size - threadsPerMP :: Int, -- ^ Maximum number of in-flight threads on a multiprocessor - threadBlocksPerMP :: Int, -- ^ Maximum number of thread blocks resident on a multiprocessor - warpsPerMP :: Int, -- ^ Maximum number of in-flight warps per multiprocessor - sharedMemPerMP :: Int, -- ^ Total amount of shared memory per multiprocessor (bytes) - sharedMemAllocUnit :: Int, -- ^ Shared memory allocation unit size (bytes) - regFileSize :: Int, -- ^ Total number of registers in a multiprocessor - regAllocUnit :: Int, -- ^ Register allocation unit size - regAllocWarp :: Int, -- ^ Register allocation granularity for warps - allocation :: Allocation -- ^ How multiprocessor resources are divided + threadsPerWarp :: !Int, -- ^ Warp size + threadsPerMP :: !Int, -- ^ Maximum number of in-flight threads on a multiprocessor + threadBlocksPerMP :: !Int, -- ^ Maximum number of thread blocks resident on a multiprocessor + warpsPerMP :: !Int, -- ^ Maximum number of in-flight warps per multiprocessor + sharedMemPerMP :: !Int, -- ^ Total amount of shared memory per multiprocessor (bytes) + sharedMemAllocUnit :: !Int, -- ^ Shared memory allocation unit size (bytes) + regFileSize :: !Int, -- ^ Total number of registers in a multiprocessor + regAllocUnit :: !Int, -- ^ Register allocation unit size + regAllocWarp :: !Int, -- ^ Register allocation granularity for warps + allocation :: !Allocation -- ^ How multiprocessor resources are divided } 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis.Occupancy @@ -49,7 +50,7 @@ ( Occupancy(..), occupancy, optimalBlockSize, optimalBlockSizeBy, maxResidentBlocks, - incPow2, incWarp + incPow2, incWarp, decPow2, decWarp ) where @@ -63,10 +64,10 @@ -- data Occupancy = Occupancy { - activeThreads :: Int, -- ^ Active threads per multiprocessor - activeThreadBlocks :: Int, -- ^ Active thread blocks per multiprocessor - activeWarps :: Int, -- ^ Active warps per multiprocessor - occupancy100 :: Double -- ^ Occupancy of each multiprocessor (percent) + activeThreads :: !Int, -- ^ Active threads per multiprocessor + activeThreadBlocks :: !Int, -- ^ Active thread blocks per multiprocessor + activeWarps :: !Int, -- ^ Active warps per multiprocessor + occupancy100 :: !Double -- ^ Occupancy of each multiprocessor (percent) } deriving (Eq, Ord, Show) @@ -80,7 +81,7 @@ -> Int -- ^ Registers per thread -> Int -- ^ Shared memory per block (bytes) -> Occupancy -occupancy dev thds regs smem +occupancy !dev !thds !regs !smem = Occupancy at ab aw oc where at = ab * thds @@ -124,14 +125,15 @@ -> (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 = flip optimalBlockSizeBy incWarp +optimalBlockSize = flip optimalBlockSizeBy decWarp -- | -- 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). +-- any order, but the last satisfying block size will be returned. Hence, values +-- should be monotonically decreasing to return the smallest block size yielding +-- maximum occupancy, and vice-versa. -- optimalBlockSizeBy :: DeviceProperties @@ -146,24 +148,43 @@ threads = fblk dev --- | Decrements in powers-of-two, over the range of supported thread block sizes +-- | Increments 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 +incPow2 dev = map ((2::Int)^) [lb, lb+1 .. ub] where round' = round :: Double -> Int lb = round' . logBase 2 . fromIntegral $ warpSize dev ub = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev +-- | Decrements in powers-of-two, over the range of supported thread block sizes +-- for the given device. +-- +decPow2 :: DeviceProperties -> [Int] +decPow2 dev = map ((2::Int)^) [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. -- +decWarp :: DeviceProperties -> [Int] +decWarp dev = [block, block-warp .. warp] + where + warp = warpSize dev + block = maxThreadsPerBlock dev + +-- | Increments 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 +incWarp dev = [warp, 2*warp .. block] where - det = warpSize dev - mts = maxThreadsPerBlock dev + warp = warpSize dev + block = maxThreadsPerBlock dev -- | diff --git a/Foreign/CUDA/Driver/Device.chs b/Foreign/CUDA/Driver/Device.chs --- a/Foreign/CUDA/Driver/Device.chs +++ b/Foreign/CUDA/Driver/Device.chs @@ -56,16 +56,16 @@ -- data CUDevProp = CUDevProp { - cuMaxThreadsPerBlock :: Int, -- Maximum number of threads per block - cuMaxBlockSize :: (Int,Int,Int), -- Maximum size of each dimension of a block - cuMaxGridSize :: (Int,Int,Int), -- Maximum size of each dimension of a grid - cuSharedMemPerBlock :: Int64, -- Shared memory available per block in bytes - cuTotalConstMem :: Int64, -- Constant memory available on device in bytes - cuWarpSize :: Int, -- Warp size in threads (SIMD width) - cuMemPitch :: Int64, -- Maximum pitch in bytes allowed by memory copies - cuRegsPerBlock :: Int, -- 32-bit registers available per block - cuClockRate :: Int, -- Clock frequency in kilohertz - cuTextureAlignment :: Int64 -- Alignment requirement for textures + cuMaxThreadsPerBlock :: !Int, -- Maximum number of threads per block + cuMaxBlockSize :: !(Int,Int,Int), -- Maximum size of each dimension of a block + cuMaxGridSize :: !(Int,Int,Int), -- Maximum size of each dimension of a grid + cuSharedMemPerBlock :: !Int64, -- Shared memory available per block in bytes + cuTotalConstMem :: !Int64, -- Constant memory available on device in bytes + cuWarpSize :: !Int, -- Warp size in threads (SIMD width) + cuMemPitch :: !Int64, -- Maximum pitch in bytes allowed by memory copies + cuRegsPerBlock :: !Int, -- 32-bit registers available per block + cuClockRate :: !Int, -- Clock frequency in kilohertz + cuTextureAlignment :: !Int64 -- Alignment requirement for textures } deriving (Show) diff --git a/Foreign/CUDA/Driver/Error.chs b/Foreign/CUDA/Driver/Error.chs --- a/Foreign/CUDA/Driver/Error.chs +++ b/Foreign/CUDA/Driver/Error.chs @@ -39,61 +39,67 @@ -- Return a descriptive error string associated with a particular error code -- describe :: Status -> String -describe Success = "no error" -describe InvalidValue = "invalid argument" -describe OutOfMemory = "out of memory" -describe NotInitialized = "driver not initialised" -describe Deinitialized = "driver deinitialised" -describe NoDevice = "no CUDA-capable device is available" -describe InvalidDevice = "invalid device ordinal" -describe InvalidImage = "invalid kernel image" -describe InvalidContext = "invalid context handle" -describe ContextAlreadyCurrent = "context already current" -describe MapFailed = "map failed" -describe UnmapFailed = "unmap failed" -describe ArrayIsMapped = "array is mapped" -describe AlreadyMapped = "already mapped" -describe NoBinaryForGPU = "no binary available for this GPU" -describe AlreadyAcquired = "resource already acquired" -describe NotMapped = "not mapped" -describe InvalidSource = "invalid source" -describe FileNotFound = "file not found" -describe InvalidHandle = "invalid handle" -describe NotFound = "not found" -describe NotReady = "device not ready" -describe LaunchFailed = "unspecified launch failure" -describe LaunchOutOfResources = "too many resources requested for launch" -describe LaunchTimeout = "the launch timed out and was terminated" -describe LaunchIncompatibleTexturing = "launch with incompatible texturing" +describe Success = "no error" +describe InvalidValue = "invalid argument" +describe OutOfMemory = "out of memory" +describe NotInitialized = "driver not initialised" +describe Deinitialized = "driver deinitialised" +describe NoDevice = "no CUDA-capable device is available" +describe InvalidDevice = "invalid device ordinal" +describe InvalidImage = "invalid kernel image" +describe InvalidContext = "invalid context handle" +describe ContextAlreadyCurrent = "context already current" +describe MapFailed = "map failed" +describe UnmapFailed = "unmap failed" +describe ArrayIsMapped = "array is mapped" +describe AlreadyMapped = "already mapped" +describe NoBinaryForGPU = "no binary available for this GPU" +describe AlreadyAcquired = "resource already acquired" +describe NotMapped = "not mapped" +describe InvalidSource = "invalid source" +describe FileNotFound = "file not found" +describe InvalidHandle = "invalid handle" +describe NotFound = "not found" +describe NotReady = "device not ready" +describe LaunchFailed = "unspecified launch failure" +describe LaunchOutOfResources = "too many resources requested for launch" +describe LaunchTimeout = "the launch timed out and was terminated" +describe LaunchIncompatibleTexturing = "launch with incompatible texturing" #if CUDA_VERSION >= 3000 -describe NotMappedAsArray = "mapped resource not available for access as an array" -describe NotMappedAsPointer = "mapped resource not available for access as a pointer" -describe EccUncorrectable = "uncorrectable ECC error detected" +describe NotMappedAsArray = "mapped resource not available for access as an array" +describe NotMappedAsPointer = "mapped resource not available for access as a pointer" +describe EccUncorrectable = "uncorrectable ECC error detected" #endif #if CUDA_VERSION >= 3000 && CUDA_VERSION < 3020 -describe PointerIs64bit = "attempt to retrieve a 64-bit pointer via a 32-bit API function" -describe SizeIs64bit = "attempt to retrieve 64-bit size via a 32-bit API function" +describe PointerIs64bit = "attempt to retrieve a 64-bit pointer via a 32-bit API function" +describe SizeIs64bit = "attempt to retrieve 64-bit size via a 32-bit API function" #endif #if CUDA_VERSION >= 3010 -describe UnsupportedLimit = "limits not supported by device" -describe SharedObjectSymbolNotFound = "link to a shared object failed to resolve" -describe SharedObjectInitFailed = "shared object initialisation failed" +describe UnsupportedLimit = "limits not supported by device" +describe SharedObjectSymbolNotFound = "link to a shared object failed to resolve" +describe SharedObjectInitFailed = "shared object initialisation failed" #endif #if CUDA_VERSION >= 3020 -describe OperatingSystem = "operating system call failed" +describe OperatingSystem = "operating system call failed" #endif #if CUDA_VERSION >= 4000 -describe ProfilerDisabled = "profiling APIs disabled: application running with visual profiler" -describe ProfilerNotInitialized = "profiler not initialised" -describe ProfilerAlreadyStarted = "profiler already started" -describe ProfilerAlreadyStopped = "profiler already stopped" -describe ContextAlreadyInUse = "context is already bound to a thread and in use" -describe PeerAccessAlreadyEnabled = "peer access already enabled" -describe PeerAccessNotEnabled = "peer access has not been enabled" -describe PrimaryContextActive = "primary context for this device has already been initialised" -describe ContextIsDestroyed = "context already destroyed" +describe ProfilerDisabled = "profiling APIs disabled: application running with visual profiler" +describe ProfilerNotInitialized = "profiler not initialised" +describe ProfilerAlreadyStarted = "profiler already started" +describe ProfilerAlreadyStopped = "profiler already stopped" +describe ContextAlreadyInUse = "context is already bound to a thread and in use" +describe PeerAccessAlreadyEnabled = "peer access already enabled" +describe PeerAccessNotEnabled = "peer access has not been enabled" +describe PrimaryContextActive = "primary context for this device has already been initialised" +describe ContextIsDestroyed = "context already destroyed" #endif -describe Unknown = "unknown error" +#if CUDA_VERSION >= 4010 +describe Assert = "device-side assert triggered" +describe TooManyPeers = "peer mapping resources exhausted" +describe HostMemoryAlreadyRegistered = "part or all of the requested memory range is already mapped" +describe HostMemoryNotRegistered = "pointer does not correspond to a registered memory region" +#endif +describe Unknown = "unknown error" -------------------------------------------------------------------------------- diff --git a/Foreign/CUDA/Driver/Exec.chs b/Foreign/CUDA/Driver/Exec.chs --- a/Foreign/CUDA/Driver/Exec.chs +++ b/Foreign/CUDA/Driver/Exec.chs @@ -76,10 +76,10 @@ -- Kernel function parameters -- data FunParam where - IArg :: Int -> FunParam - FArg :: Float -> FunParam - TArg :: Texture -> FunParam - VArg :: Storable a => a -> FunParam + IArg :: !Int -> FunParam + FArg :: !Float -> FunParam + TArg :: !Texture -> FunParam + VArg :: Storable a => !a -> FunParam instance Storable FunParam where sizeOf (IArg _) = sizeOf (undefined :: CUInt) @@ -211,10 +211,20 @@ 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) + IArg v -> with' v (f . castPtr) + FArg v -> with' v (f . castPtr) + VArg v -> with' v (f . castPtr) TArg _ -> error "launchKernel: TArg is deprecated" + + -- 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 launchKernel' fn (gx,gy,gz) (tx,ty,tz) sm mst args 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 @@ -54,10 +54,10 @@ -- Just-in-time compilation options -- data JITOption - = MaxRegisters Int -- ^ maximum number of registers per thread - | ThreadsPerBlock Int -- ^ number of threads per block to target for - | OptimisationLevel Int -- ^ level of optimisation to apply (1-4, default 4) - | Target JITTarget -- ^ compilation target, otherwise determined from context + = MaxRegisters !Int -- ^ maximum number of registers per thread + | ThreadsPerBlock !Int -- ^ number of threads per block to target for + | OptimisationLevel !Int -- ^ level of optimisation to apply (1-4, default 4) + | Target !JITTarget -- ^ compilation target, otherwise determined from context -- | FallbackStrategy JITFallback deriving (Show) @@ -66,9 +66,9 @@ -- data JITResult = JITResult { - jitTime :: Float, -- ^ milliseconds spent compiling PTX - jitInfoLog :: ByteString, -- ^ information about PTX asembly - jitErrorLog :: ByteString -- ^ compilation errors + jitTime :: !Float, -- ^ milliseconds spent compiling PTX + jitInfoLog :: !ByteString, -- ^ information about PTX asembly + jitErrorLog :: !ByteString -- ^ compilation errors } deriving (Show) diff --git a/Foreign/CUDA/Internal/C2HS.hs b/Foreign/CUDA/Internal/C2HS.hs --- a/Foreign/CUDA/Internal/C2HS.hs +++ b/Foreign/CUDA/Internal/C2HS.hs @@ -59,8 +59,8 @@ import Foreign hiding (Word) - -- Should also hide the Foreign.Marshal.Pool exports in - -- compilers that export them + -- Should also hide the Foreign.Marshal.Pool exports in + -- compilers that export them import Foreign.C import Control.Monad (liftM) @@ -80,19 +80,19 @@ -- withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c + => a -> (Ptr b -> IO c) -> IO c withIntConv = with . cIntConv withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c + => a -> (Ptr b -> IO c) -> IO c withFloatConv = with . cFloatConv peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b + => Ptr a -> IO b peekIntConv = liftM cIntConv . peek peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b + => Ptr a -> IO b peekFloatConv = liftM cFloatConv . peek -- Passing Booleans by reference @@ -124,15 +124,15 @@ alignment _ = alignment (undefined :: Ptr ()) peek p = do - ptr <- peek (castPtr p) - if ptr == nullPtr - then return Nothing - else liftM Just $ peek ptr + ptr <- peek (castPtr p) + if ptr == nullPtr + then return Nothing + else liftM Just $ peek ptr poke p v = do - ptr <- case v of - Nothing -> return nullPtr - Just v' -> new v' + ptr <- case v of + Nothing -> return nullPtr + Just v' -> new v' poke (castPtr p) ptr -} @@ -171,8 +171,8 @@ -- containsBitMask :: (Bits a, Enum b) => a -> b -> Bool bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm - in - bm' .&. bits == bm' + in + bm' .&. bits == bm' -- |Given a bit pattern, yield all bit masks that it contains. -- @@ -210,7 +210,7 @@ -- |Obtain Haskell 'Bool' from C value. -- -cToBool :: Num a => a -> Bool +cToBool :: (Eq a, Num a) => a -> Bool cToBool = toBool -- |Convert a C enumeration to Haskell. diff --git a/Foreign/CUDA/Ptr.hs b/Foreign/CUDA/Ptr.hs --- a/Foreign/CUDA/Ptr.hs +++ b/Foreign/CUDA/Ptr.hs @@ -25,7 +25,7 @@ -- | -- A reference to data stored on the device -- -data DevicePtr a = DevicePtr { useDevicePtr :: Ptr a } +newtype DevicePtr a = DevicePtr { useDevicePtr :: Ptr a } deriving (Eq,Ord) instance Show (DevicePtr a) where @@ -110,7 +110,7 @@ -- | -- A reference to page-locked host memory -- -data HostPtr a = HostPtr { useHostPtr :: Ptr a } +newtype HostPtr a = HostPtr { useHostPtr :: Ptr a } deriving (Eq,Ord) instance Show (HostPtr a) where diff --git a/Foreign/CUDA/Runtime/Exec.chs b/Foreign/CUDA/Runtime/Exec.chs --- a/Foreign/CUDA/Runtime/Exec.chs +++ b/Foreign/CUDA/Runtime/Exec.chs @@ -47,11 +47,11 @@ data FunAttributes = FunAttributes { - constSizeBytes :: Int64, - localSizeBytes :: Int64, - sharedSizeBytes :: Int64, - maxKernelThreadsPerBlock :: Int, -- ^ maximum block size that can be successively launched (based on register usage) - numRegs :: Int -- ^ number of registers required for each thread + constSizeBytes :: !Int64, + localSizeBytes :: !Int64, + sharedSizeBytes :: !Int64, + maxKernelThreadsPerBlock :: !Int, -- ^ maximum block size that can be successively launched (based on register usage) + numRegs :: !Int -- ^ number of registers required for each thread } deriving (Show) @@ -91,10 +91,10 @@ -- representation on devices that do not support doubles natively. -- data FunParam where - IArg :: Int -> FunParam - FArg :: Float -> FunParam - DArg :: Double -> FunParam - VArg :: Storable a => a -> FunParam + IArg :: !Int -> FunParam + FArg :: !Float -> FunParam + DArg :: !Double -> FunParam + VArg :: Storable a => !a -> FunParam -------------------------------------------------------------------------------- @@ -118,11 +118,11 @@ -- with 'setParams', this pushes data onto the execution stack that will be -- popped when a function is 'launch'ed. -- -setConfig :: (Int,Int) -- ^ grid dimensions - -> (Int,Int,Int) -- ^ block dimensions - -> Int64 -- ^ shared memory per block (bytes) - -> Maybe Stream -- ^ associated processing stream - -> IO () +setConfig :: (Int,Int) -- ^ grid dimensions + -> (Int,Int,Int) -- ^ block dimensions + -> Int64 -- ^ shared memory per block (bytes) + -> Maybe Stream -- ^ associated processing stream + -> IO () setConfig (gx,gy) (bx,by,bz) sharedMem mst = nothingIfOk =<< cudaConfigureCallSimple gx gy bx by bz sharedMem (maybe defaultStream id mst) @@ -134,7 +134,7 @@ -- accepting plain integers. -- {# fun unsafe cudaConfigureCallSimple - { `Int', `Int' + { `Int', `Int' , `Int', `Int', `Int' , cIntConv `Int64' , useStream `Stream' } -> `Status' cToEnum #} diff --git a/Foreign/CUDA/Runtime/Texture.chs b/Foreign/CUDA/Runtime/Texture.chs --- a/Foreign/CUDA/Runtime/Texture.chs +++ b/Foreign/CUDA/Runtime/Texture.chs @@ -46,10 +46,10 @@ data Texture = Texture { - normalised :: Bool, -- ^ access texture using normalised coordinates [0.0,1.0) - filtering :: FilterMode, - addressing :: (AddressMode, AddressMode, AddressMode), - format :: FormatDesc + normalised :: !Bool, -- ^ access texture using normalised coordinates [0.0,1.0) + filtering :: !FilterMode, + addressing :: !(AddressMode, AddressMode, AddressMode), + format :: !FormatDesc } deriving (Eq, Show) @@ -80,8 +80,8 @@ data FormatDesc = FormatDesc { - depth :: (Int,Int,Int,Int), - kind :: FormatKind + depth :: !(Int,Int,Int,Int), + kind :: !FormatKind } deriving (Eq, Show) diff --git a/configure b/configure --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.61 for Haskell CUDA bindings 0.4.0.0. +# Generated by GNU Autoconf 2.61 for Haskell CUDA bindings 0.4.1.0. # # Report bugs to . # @@ -574,8 +574,8 @@ # Identity of this package. PACKAGE_NAME='Haskell CUDA bindings' PACKAGE_TARNAME='cuda' -PACKAGE_VERSION='0.4.0.0' -PACKAGE_STRING='Haskell CUDA bindings 0.4.0.0' +PACKAGE_VERSION='0.4.1.0' +PACKAGE_STRING='Haskell CUDA bindings 0.4.1.0' PACKAGE_BUGREPORT='tmcdonell@cse.unsw.edu.au' ac_unique_file="Foreign/CUDA.hs" @@ -1192,7 +1192,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures Haskell CUDA bindings 0.4.0.0 to adapt to many kinds of systems. +\`configure' configures Haskell CUDA bindings 0.4.1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1258,7 +1258,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of Haskell CUDA bindings 0.4.0.0:";; + short | recursive ) echo "Configuration of Haskell CUDA bindings 0.4.1.0:";; esac cat <<\_ACEOF @@ -1336,7 +1336,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -Haskell CUDA bindings configure 0.4.0.0 +Haskell CUDA bindings configure 0.4.1.0 generated by GNU Autoconf 2.61 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1350,7 +1350,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Haskell CUDA bindings $as_me 0.4.0.0, which was +It was created by Haskell CUDA bindings $as_me 0.4.1.0, which was generated by GNU Autoconf 2.61. Invocation command line was $ $0 $@ @@ -4280,7 +4280,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by Haskell CUDA bindings $as_me 0.4.0.0, which was +This file was extended by Haskell CUDA bindings $as_me 0.4.1.0, which was generated by GNU Autoconf 2.61. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -4323,7 +4323,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -Haskell CUDA bindings config.status 0.4.0.0 +Haskell CUDA bindings config.status 0.4.1.0 configured by $0, generated by GNU Autoconf 2.61, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT([Haskell CUDA bindings], [0.4.0.0], [tmcdonell@cse.unsw.edu.au], [cuda]) +AC_INIT([Haskell CUDA bindings], [0.4.1.0], [tmcdonell@cse.unsw.edu.au], [cuda]) AC_CONFIG_SRCDIR([Foreign/CUDA.hs]) AC_CONFIG_FILES([cuda.buildinfo]) AC_PROG_CC diff --git a/cuda.cabal b/cuda.cabal --- a/cuda.cabal +++ b/cuda.cabal @@ -1,5 +1,5 @@ Name: cuda -Version: 0.4.0.2 +Version: 0.4.1.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 @@ -70,7 +70,7 @@ Build-tools: c2hs >= 0.16, hsc2hs Build-depends: base >= 3 && < 5, bytestring, extensible-exceptions Extensions: - ghc-options: -Wall -O2 + ghc-options: -Wall -O2 -funbox-strict-fields -fwarn-tabs source-repository head