cuda 0.5.1.1 → 0.6.0.0
raw patch · 13 files changed
+470/−82 lines, 13 filesdep +cudadep +prettysetup-changed
Dependencies added: cuda, pretty
Files
- Foreign/CUDA/Analysis/Device.chs +2/−3
- Foreign/CUDA/Driver/Error.chs +29/−4
- Foreign/CUDA/Driver/Exec.chs +2/−2
- Foreign/CUDA/Driver/Marshal.chs +54/−0
- Foreign/CUDA/Driver/Module.chs +112/−34
- Foreign/CUDA/Runtime/Error.chs +1/−2
- Foreign/CUDA/Runtime/Exec.chs +52/−17
- Foreign/CUDA/Runtime/Marshal.chs +55/−0
- Setup.hs +19/−3
- configure +4/−3
- configure.ac +8/−7
- cuda.cabal +20/−7
- examples/src/deviceQueryDrv/DeviceQuery.hs +112/−0
Foreign/CUDA/Analysis/Device.chs view
@@ -97,11 +97,9 @@ #endif 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+#if CUDA_VERSION >= 4000 unifiedAddressing :: !Bool -- ^ Device shares a unified address space with the host-#else- canMapHostMemory :: !Bool -- ^ Device can use pinned memory #endif } deriving (Show)@@ -153,6 +151,7 @@ Compute 2 1 -> DeviceResources 32 1536 8 48 48 49152 128 32768 64 2 63 Warp -- Fermi GF10x Compute 3 0 -> DeviceResources 32 2048 16 64 192 49152 256 65536 256 4 63 Warp -- Kepler GK10x Compute 3 5 -> DeviceResources 32 2048 16 64 192 49152 256 65536 256 4 255 Warp -- Kepler GK11x+ Compute 5 0 -> DeviceResources 32 2048 32 64 128 65536 256 65536 256 4 255 Warp -- Maxwell GM10x -- Something might have gone wrong, or the library just needs to be -- updated for the next generation of hardware, in which case we just want
Foreign/CUDA/Driver/Error.chs view
@@ -1,5 +1,6 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ForeignFunctionInterface #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Error@@ -13,10 +14,18 @@ module Foreign.CUDA.Driver.Error where +-- Friends+import Foreign.CUDA.Internal.C2HS -- System import Data.Typeable import Control.Exception+import Control.Monad+import Foreign.C+import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import System.IO.Unsafe #include "cbits/stubs.h" {# context lib="cuda" #}@@ -31,8 +40,11 @@ -- {# enum CUresult as Status { underscoreToCase- , CUDA_SUCCESS as Success- , CUDA_ERROR_NO_BINARY_FOR_GPU as NoBinaryForGPU }+ , CUDA_SUCCESS as Success+ , CUDA_ERROR_NO_BINARY_FOR_GPU as NoBinaryForGPU+ , CUDA_ERROR_INVALID_PTX as InvalidPTX+ , CUDA_ERROR_INVALID_PC as InvalidPC+ } with prefix="CUDA_ERROR" deriving (Eq, Show) #} @@ -40,6 +52,17 @@ -- Return a descriptive error string associated with a particular error code -- describe :: Status -> String+#if CUDA_VERSION >= 6000+describe status+ = unsafePerformIO $ resultIfOk =<< cuGetErrorString status++{# fun unsafe cuGetErrorString+ { cFromEnum `Status'+ , alloca- `String' ppeek* } -> `Status' cToEnum #}+ where+ ppeek = peek >=> peekCString++#else describe Success = "no error" describe InvalidValue = "invalid argument" describe OutOfMemory = "out of memory"@@ -106,6 +129,7 @@ describe NotSupported = "not supported" #endif describe Unknown = "unknown error"+#endif --------------------------------------------------------------------------------@@ -140,6 +164,7 @@ -------------------------------------------------------------------------------- -- Helper Functions --------------------------------------------------------------------------------+ -- | -- Return the results of a function on successful execution, otherwise throw an
Foreign/CUDA/Driver/Exec.chs view
@@ -67,7 +67,7 @@ -- Kernel function parameters -- data FunParam where- IArg :: !Int -> FunParam+ IArg :: !Int32 -> FunParam FArg :: !Float -> FunParam VArg :: Storable a => !a -> FunParam @@ -302,7 +302,7 @@ {# fun unsafe cuParamSeti { useFun `Fun' , `Int'- , `Int' } -> `Status' cToEnum #}+ , `Int32' } -> `Status' cToEnum #} {-# INLINE cuParamSetf #-} {# fun unsafe cuParamSetf
Foreign/CUDA/Driver/Marshal.chs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_HADDOCK prune #-} --------------------------------------------------------------------------------@@ -21,6 +22,10 @@ -- * Device Allocation mallocArray, allocaArray, free, + -- * Unified Memory Allocation+ AttachFlag(..),+ mallocManagedArray,+ -- * Marshalling peekArray, peekArrayAsync, peekListArray, pokeArray, pokeArrayAsync, pokeListArray,@@ -70,7 +75,17 @@ } CUmemhostalloc_option; #endc +#if CUDA_VERSION >= 6000+#c+typedef enum CUmemAttachFlags_option_enum {+ CU_MEM_ATTACH_OPTION_GLOBAL = CU_MEM_ATTACH_GLOBAL,+ CU_MEM_ATTACH_OPTION_HOST = CU_MEM_ATTACH_HOST,+ CU_MEM_ATTACH_OPTION_SINGLE = CU_MEM_ATTACH_SINGLE+} CUmemAttachFlags_option;+#endc+#endif + -------------------------------------------------------------------------------- -- Host Allocation --------------------------------------------------------------------------------@@ -224,6 +239,45 @@ {-# INLINE cuMemFree #-} {# fun unsafe cuMemFree { useDeviceHandle `DevicePtr a' } -> `Status' cToEnum #}+++--------------------------------------------------------------------------------+-- Unified memory allocations+--------------------------------------------------------------------------------++-- |+-- Options for unified memory allocations+--+#if CUDA_VERSION >= 6000+{# enum CUmemAttachFlags_option as AttachFlag+ { underscoreToCase }+ with prefix="CU_MEM_ATTACH_OPTION" deriving (Eq, Show) #}+#else+data AttachFlag+#endif++-- |+-- Allocates memory that will be automatically managed by the Unified Memory+-- system+--+{-# INLINEABLE mallocManagedArray #-}+mallocManagedArray :: Storable a => [AttachFlag] -> Int -> IO (DevicePtr a)+#if CUDA_VERSION < 6000+mallocManagedArray _ _ = requireSDK 6.0 "mallocManagedArray"+#else+mallocManagedArray !flags = doMalloc undefined+ where+ doMalloc :: Storable a' => a' -> Int -> IO (DevicePtr a')+ doMalloc x !n = resultIfOk =<< cuMemAllocManaged (n * sizeOf x) flags++{-# INLINE cuMemAllocManaged #-}+{# fun unsafe cuMemAllocManaged+ { alloca'- `DevicePtr a' peekDeviceHandle*+ , `Int'+ , combineBitMasks `[AttachFlag]' } -> `Status' cToEnum #}+ where+ alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)+#endif --------------------------------------------------------------------------------
Foreign/CUDA/Driver/Module.chs view
@@ -14,14 +14,23 @@ -- * Module Management Module, JITOption(..), JITTarget(..), JITResult(..),- getFun, getPtr, getTex, loadFile, loadData, loadDataEx, unload + -- ** Querying module inhabitants+ getFun, getPtr, getTex,++ -- ** Loading and unloading modules+ loadFile,+ loadData, loadDataFromPtr,+ loadDataEx, loadDataFromPtrEx,+ unload+ ) where #include "cbits/stubs.h" {# context lib="cuda" #} -- Friends+import Foreign.CUDA.Analysis.Device import Foreign.CUDA.Ptr import Foreign.CUDA.Driver.Error import Foreign.CUDA.Driver.Exec@@ -36,9 +45,14 @@ import Control.Monad (liftM) import Control.Exception (throwIO)+import Data.Maybe (mapMaybe) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Internal as B +#if CUDA_VERSION < 5050+import Debug.Trace (trace)+#endif -------------------------------------------------------------------------------- -- Data Types@@ -48,6 +62,7 @@ -- A reference to a Module object, containing collections of device functions -- newtype Module = Module { useModule :: {# type CUmodule #}}+ deriving (Eq, Show) -- |@@ -57,8 +72,11 @@ = 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+ | Target !Compute -- ^ compilation target, otherwise determined from context+ | FallbackStrategy !JITFallback -- ^ fallback strategy if matching cubin not found+ | GenerateDebugInfo -- ^ generate debug info (-g) (requires cuda >= 5.5)+ | GenerateLineInfo -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)+ | Verbose -- ^ verbose log messages (requires cuda >= 5.5) deriving (Show) -- |@@ -67,8 +85,8 @@ data JITResult = JITResult { jitTime :: !Float, -- ^ milliseconds spent compiling PTX- jitInfoLog :: !ByteString, -- ^ information about PTX asembly- jitErrorLog :: !ByteString -- ^ compilation errors+ jitInfoLog :: !ByteString, -- ^ information about PTX assembly+ jitModule :: !Module -- ^ compilation error log or compiled module } deriving (Show) @@ -138,7 +156,7 @@ -- | -- Load the contents of the specified file (either a ptx or cubin file) to--- create a new module, and load that module into the current context+-- create a new module, and load that module into the current context. -- {-# INLINEABLE loadFile #-} loadFile :: FilePath -> IO Module@@ -152,60 +170,116 @@ -- | -- Load the contents of the given image into a new module, and load that module--- into the current context. The image (typically) is the contents of a cubin or--- ptx file as a NULL-terminated string.+-- into the current context. The image is (typically) the contents of a cubin or+-- PTX file. --+-- Note that the 'ByteString' will be copied into a temporary staging area so+-- that it can be passed to C.+-- {-# INLINEABLE loadData #-} loadData :: ByteString -> IO Module-loadData !img = resultIfOk =<< cuModuleLoadData img+loadData !img =+ B.useAsCString img (\p -> loadDataFromPtr (castPtr p)) +-- |+-- As 'loadData', but read the image data from the given pointer. The image is a+-- NULL-terminated sequence of bytes.+--+{-# INLINEABLE loadDataFromPtr #-}+loadDataFromPtr :: Ptr Word8 -> IO Module+loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img+ {-# INLINE cuModuleLoadData #-} {# fun unsafe cuModuleLoadData- { alloca- `Module' peekMod*- , useByteString* `ByteString' } -> ` Status' cToEnum #}+ { alloca- `Module' peekMod*+ , castPtr `Ptr Word8' } -> ` Status' cToEnum #} -- |--- Load a module with online compiler options. The actual attributes of the+-- Load the contents of the given image into a module with online compiler+-- options, and load the module into the current context. The image is+-- (typically) the contents of a cubin or PTX file. The actual attributes of the -- compiled kernel can be probed using 'requires'. --+-- Note that the 'ByteString' will be copied into a temporary staging area so+-- that it can be passed to C.+-- {-# INLINEABLE loadDataEx #-}-loadDataEx :: ByteString -> [JITOption] -> IO (Module, JITResult)+loadDataEx :: ByteString -> [JITOption] -> IO JITResult loadDataEx !img !options =- allocaArray logSize $ \p_ilog ->- allocaArray logSize $ \p_elog ->+ B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)++-- |+-- As 'loadDataEx', but read the image data from the given pointer. The image is+-- a NULL-terminated sequence of bytes.+--+{-# INLINEABLE loadDataFromPtrEx #-}+loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult+loadDataFromPtrEx !img !options = do+ fp_ilog <- B.mallocByteString logSize++ allocaArray logSize $ \p_elog -> do+ withForeignPtr fp_ilog $ \p_ilog -> do+ let (opt,val) = unzip $- [ (JIT_WALL_TIME, 0) -- must be first+ [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below , (JIT_INFO_LOG_BUFFER_SIZE_BYTES, logSize) , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize) , (JIT_INFO_LOG_BUFFER, unsafeCoerce (p_ilog :: CString))- , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString)) ] ++ map unpack options in+ , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString)) ] ++ mapMaybe unpack options - withArray (map cFromEnum opt) $ \p_opts ->+ withArray (map cFromEnum opt) $ \p_opts -> do withArray (map unsafeCoerce val) $ \p_vals -> do (s,mdl) <- cuModuleLoadDataEx img (length opt) p_opts p_vals- infoLog <- B.packCString p_ilog- errLog <- B.packCString p_elog- time <- peek (castPtr p_vals)- resultIfOk (s, (mdl, JITResult time infoLog errLog)) + case s of+ Success -> do+ time <- peek (castPtr p_vals)+ infoLog <- B.fromForeignPtr (castForeignPtr fp_ilog) 0 `fmap` c_strnlen p_ilog logSize+ return $! JITResult time infoLog mdl++ _ -> do+ errLog <- peekCString p_elog+ cudaError (unlines [describe s, errLog])+ where logSize = 2048 - unpack (MaxRegisters x) = (JIT_MAX_REGISTERS, x)- unpack (ThreadsPerBlock x) = (JIT_THREADS_PER_BLOCK, x)- unpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL, x)- unpack (Target x) = (JIT_TARGET, fromEnum x)+ unpack (MaxRegisters x) = Just (JIT_MAX_REGISTERS, x)+ unpack (ThreadsPerBlock x) = Just (JIT_THREADS_PER_BLOCK, x)+ unpack (OptimisationLevel x) = Just (JIT_OPTIMIZATION_LEVEL, x)+ unpack (Target x) = Just (JIT_TARGET, jitTargetOfCompute x)+ unpack (FallbackStrategy x) = Just (JIT_FALLBACK_STRATEGY, fromEnum x)+#if CUDA_VERSION >= 5050+ unpack GenerateDebugInfo = Just (JIT_GENERATE_DEBUG_INFO, fromEnum True)+ unpack GenerateLineInfo = Just (JIT_GENERATE_LINE_INFO, fromEnum True)+ unpack Verbose = Just (JIT_LOG_VERBOSE, fromEnum True)+#else+ unpack x = trace ("Warning: JITOption '" ++ show x ++ "' requires at least cuda-5.5") Nothing+#endif + jitTargetOfCompute (Compute x y)+ = fromEnum+ $ case (x,y) of+ (1,0) -> Compute10+ (1,1) -> Compute11+ (1,2) -> Compute12+ (1,3) -> Compute13+ (2,0) -> Compute20+ (2,1) -> Compute21+ (3,0) -> Compute30+ (3,5) -> Compute35+ _ -> error ("Unknown JIT Target for Compute " ++ show (Compute x y)) + {-# INLINE cuModuleLoadDataEx #-} {# fun unsafe cuModuleLoadDataEx- { alloca- `Module' peekMod*- , useByteString* `ByteString'- , `Int'- , id `Ptr CInt'- , id `Ptr (Ptr ())' } -> `Status' cToEnum #}+ { alloca- `Module' peekMod*+ , castPtr `Ptr Word8'+ , `Int'+ , id `Ptr CInt'+ , id `Ptr (Ptr ())' } -> `Status' cToEnum #} -- |@@ -236,7 +310,11 @@ peekMod :: Ptr {# type CUmodule #} -> IO Module peekMod = liftM Module . peek -{-# INLINE useByteString #-}-useByteString :: ByteString -> (Ptr a -> IO b) -> IO b-useByteString !bs !act = B.useAsCString bs $ \ !p -> act (castPtr p)+{-# INLINE c_strnlen' #-}+foreign import ccall unsafe "string.h strnlen" c_strnlen'+ :: CString -> CSize -> IO CSize++{-# INLINE c_strnlen #-}+c_strnlen :: CString -> Int -> IO Int+c_strnlen str maxlen = cIntConv `fmap` c_strnlen' str (cIntConv maxlen)
Foreign/CUDA/Runtime/Error.chs view
@@ -20,13 +20,12 @@ ) where - -- Friends import Foreign.CUDA.Internal.C2HS -- System-import Foreign hiding ( unsafePerformIO ) import Foreign.C+import Foreign.Ptr import Data.Typeable import Control.Exception import System.IO.Unsafe
Foreign/CUDA/Runtime/Exec.chs view
@@ -15,8 +15,8 @@ module Foreign.CUDA.Runtime.Exec ( -- * Kernel Execution- FunAttributes(..), FunParam(..), CacheConfig(..),- attributes, setConfig, setParams, setCacheConfig, launch+ Fun, FunAttributes(..), FunParam(..), CacheConfig(..),+ attributes, setConfig, setParams, setCacheConfig, launch, launchKernel, ) where @@ -43,7 +43,20 @@ -- Data Types -------------------------------------------------------------------------------- +-- |+-- A @__global__@ device function. --+-- Note that the use of a string naming a function was deprecated in CUDA 4.1+-- and removed in CUDA 5.0.+--+#if CUDART_VERSION >= 5000+type Fun = FunPtr ()+#else+type Fun = String+#endif+++-- -- Function Attributes -- {# pointer *cudaFuncAttributes as ^ foreign -> FunAttributes nocode #}@@ -109,13 +122,13 @@ -- itemises the requirements to successfully launch the given kernel. -- {-# INLINEABLE attributes #-}-attributes :: String -> IO FunAttributes+attributes :: Fun -> IO FunAttributes attributes !fn = resultIfOk =<< cudaFuncGetAttributes fn {-# INLINE cudaFuncGetAttributes #-} {# fun unsafe cudaFuncGetAttributes- { alloca- `FunAttributes' peek*- , withCString_* `String' } -> `Status' cToEnum #}+ { alloca- `FunAttributes' peek*+ , withFun* `Fun' } -> `Status' cToEnum #} -- |@@ -151,6 +164,7 @@ -- Set the argument parameters that will be passed to the next kernel -- invocation. This is used in conjunction with 'setConfig' to control kernel -- execution.+-- {-# INLINEABLE setParams #-} setParams :: [FunParam] -> IO () setParams = foldM_ k 0@@ -200,7 +214,7 @@ -- synchronisation point for streamed kernel launches -- {-# INLINEABLE setCacheConfig #-}-setCacheConfig :: String -> CacheConfig -> IO ()+setCacheConfig :: Fun -> CacheConfig -> IO () #if CUDART_VERSION < 3000 setCacheConfig _ _ = requireSDK 3.0 "setCacheConfig" #else@@ -208,32 +222,53 @@ {-# INLINE cudaFuncSetCacheConfig #-} {# fun unsafe cudaFuncSetCacheConfig- { withCString_* `String'- , cFromEnum `CacheConfig' } -> `Status' cToEnum #}+ { withFun* `Fun'+ , cFromEnum `CacheConfig' } -> `Status' cToEnum #} #endif -- |--- Invoke the named kernel on the device, which must have been declared--- @__global__@. This must be preceded by a call to 'setConfig' and (if--- appropriate) 'setParams'.+-- Invoke the @__global__@ kernel function on the device. This must be preceded+-- by a call to 'setConfig' and (if appropriate) 'setParams'. -- {-# INLINEABLE launch #-}-launch :: String -> IO ()+launch :: Fun -> IO () launch !fn = nothingIfOk =<< cudaLaunch fn {-# INLINE cudaLaunch #-} {# fun unsafe cudaLaunch- { withCString_* `String' } -> `Status' cToEnum #}+ { withFun* `Fun' } -> `Status' cToEnum #} +-- |+-- Invoke a kernel on a @(gx * gy)@ 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'.+--+{-# INLINEABLE launchKernel #-}+launchKernel+ :: Fun -- ^ Device function symbol+ -> (Int,Int) -- ^ grid dimensions+ -> (Int,Int,Int) -- ^ thread block shape+ -> Int64 -- ^ shared memory per block (bytes)+ -> Maybe Stream -- ^ (optional) execution stream+ -> [FunParam]+ -> IO ()+launchKernel !fn !grid !block !sm !mst !args = do+ setConfig grid block sm mst+ setParams args+ launch fn+ -------------------------------------------------------------------------------- -- Internals -------------------------------------------------------------------------------- --- CUDA 5.0 changed the types of some attributes from char* to void*+-- CUDA 5.0 changed the type of a kernel function from char* to void* ---{-# INLINE withCString_ #-}-withCString_ :: String -> (Ptr a -> IO b) -> IO b-withCString_ !str !fn = withCString str (fn . castPtr)+withFun :: Fun -> (Ptr a -> IO b) -> IO b+#if CUDART_VERSION >= 5000+withFun fn action = action (castFunPtrToPtr fn)+#else+withFun = withCString+#endif
Foreign/CUDA/Runtime/Marshal.chs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} -------------------------------------------------------------------------------- -- |@@ -19,6 +20,10 @@ -- * Device Allocation mallocArray, allocaArray, free, + -- * Unified Memory Allocation+ AttachFlag(..),+ mallocManagedArray,+ -- * Marshalling peekArray, peekArrayAsync, peekListArray, pokeArray, pokeArrayAsync, pokeListArray,@@ -60,7 +65,17 @@ } cudaMemHostAlloc_option; #endc +#if CUDART_VERSION >= 6000+#c+typedef enum cudaMemAttachFlags_option_enum {+ CUDA_MEM_ATTACH_OPTION_GLOBAL = cudaMemAttachGlobal,+ CUDA_MEM_ATTACH_OPTION_HOST = cudaMemAttachHost,+ CUDA_MEM_ATTACH_OPTION_SINGLE = cudaMemAttachSingle+} cudaMemAttachFlags_option;+#endc+#endif + -------------------------------------------------------------------------------- -- Host Allocation --------------------------------------------------------------------------------@@ -165,6 +180,46 @@ { dptr `DevicePtr a' } -> `Status' cToEnum #} where dptr = useDevicePtr . castDevPtr+++--------------------------------------------------------------------------------+-- Unified memory allocation+--------------------------------------------------------------------------------++-- |+-- Options for unified memory allocations+--+#if CUDART_VERSION >= 6000+{# enum cudaMemAttachFlags_option as AttachFlag+ { underscoreToCase }+ with prefix="CUDA_MEM_ATTACH_OPTION" deriving (Eq, Show) #}+#else+data AttachFlag+#endif++-- |+-- Allocates memory that will be automatically managed by the Unified Memory+-- system+--+{-# INLINEABLE mallocManagedArray #-}+mallocManagedArray :: Storable a => [AttachFlag] -> Int -> IO (DevicePtr a)+#if CUDART_VERSION < 6000+mallocManagedArray _ _ = requireSDK 6.0 "mallocManagedArray"+#else+mallocManagedArray !flags = doMalloc undefined+ where+ doMalloc :: Storable a' => a' -> Int -> IO (DevicePtr a')+ doMalloc x !n = resultIfOk =<< cudaMallocManaged (fromIntegral n * fromIntegral (sizeOf x)) flags++{-# INLINE cudaMallocManaged #-}+{# fun unsafe cudaMallocManaged+ { alloca'- `DevicePtr a' dptr*+ , cIntConv `Int64'+ , combineBitMasks `[AttachFlag]' } -> `Status' cToEnum #}+ where+ alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)+ dptr !p = (castDevPtr . DevicePtr) `fmap` peek p+#endif --------------------------------------------------------------------------------
Setup.hs view
@@ -11,6 +11,8 @@ import Distribution.Simple.PreProcess hiding (ppC2hs) import Control.Exception+import Control.Monad+import System.Exit import System.FilePath import System.Directory import System.Environment@@ -27,12 +29,26 @@ where preprocessors = hookedPreProcessors autoconfUserHooks customHooks = autoconfUserHooks {- postConf = defaultPostConf,+ preConf = preConfHook,+ postConf = postConfHook, hookedPreProcessors = ("chs",ppC2hs) : filter (\x -> fst x /= "chs") preprocessors } - defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()- defaultPostConf args flags pkg_descr lbi+ preConfHook :: Args -> ConfigFlags -> IO HookedBuildInfo+ preConfHook args flags = do+ let verbosity = fromFlag (configVerbosity flags)++ confExists <- doesFileExist "configure"+ unless confExists $ do+ code <- rawSystemExitCode verbosity "autoconf" []+ case code of+ ExitSuccess -> return ()+ ExitFailure c -> die $ "autoconf exited with code " ++ show c++ preConf autoconfUserHooks args flags++ postConfHook :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()+ postConfHook args flags pkg_descr lbi = let verbosity = fromFlag (configVerbosity flags) in do noExtraFlags args
configure view
@@ -3097,7 +3097,7 @@ # if test "$NVCC" != ""; then cuda_prefix="$(dirname "$(dirname "$NVCC")")"- cuda_c2hsflags="--cpp="$NVCC" --cppopts=-E "+ cuda_c2hsflags="--cpp="$NVCC" --cppopts=-E --cppopts=-arch=sm_20 " else echo "WARNING: Cannot find the CUDA compiler 'nvcc'. This is likely to cause problems." cuda_prefix="/usr/local/cuda"@@ -3105,15 +3105,16 @@ # Location of the toolkit binaries and libraries #+cuda_frameworks="" cuda_inc_path="${cuda_prefix}/include" CPPFLAGS+=" -I${cuda_inc_path} "-cuda_frameworks="" case $target_os in darwin*) cuda_lib_path="${cuda_prefix}/lib" cuda_frameworks="CUDA"- LDFLAGS+=" -Xlinker -rpath ${cuda_lib_path} -F/Library/Frameworks -framework ${cuda_frameworks}"+ LDFLAGS+=" -F/Library/Frameworks -framework ${cuda_frameworks}"+ #LDFLAGS+=" -Xlinker -rpath ${cuda_lib_path} " #CPPFLAGS+=" -arch ${target_cpu} " ;; *)
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell CUDA bindings], [0.5.1.0], [tmcdonell@cse.unsw.edu.au], [cuda])+AC_INIT([Haskell CUDA bindings], [0.6.0.0], [tmcdonell@cse.unsw.edu.au], [cuda]) AC_CONFIG_SRCDIR([Foreign/CUDA.hs]) AC_CONFIG_FILES([cuda.buildinfo]) AC_PROG_CC@@ -11,11 +11,11 @@ # prefix to the include and library search directories. Additionally, set nvcc # as the C preprocessor for c2hs (only, or it won't try to link cudart) #-AC_ARG_WITH([compiler], [ --with-compiler=HC use HC as the Haskell compiler], +AC_ARG_WITH([compiler], [ --with-compiler=HC use HC as the Haskell compiler], [GHC=$withval], [AC_PATH_PROG(GHC, ghc)])-AC_ARG_WITH([nvcc], [ --with-nvcc=NVCC use NVCC as the CUDA compiler], +AC_ARG_WITH([nvcc], [ --with-nvcc=NVCC use NVCC as the CUDA compiler], [NVCC=$withval], [AC_PATH_PROG(NVCC, nvcc, [], [$PATH:/usr/local/cuda/bin])])-AC_ARG_WITH([gcc], [ --with-gcc=CC use CC as the C compiler], +AC_ARG_WITH([gcc], [ --with-gcc=CC use CC as the C compiler], [CC=$withval]) # If NVCC is detected in the path, set the location of the toolkit relative to@@ -23,7 +23,7 @@ # if test "$NVCC" != ""; then cuda_prefix="$(dirname "$(dirname "$NVCC")")"- cuda_c2hsflags="--cpp="$NVCC" --cppopts=-E "+ cuda_c2hsflags="--cpp="$NVCC" --cppopts=-E --cppopts=-arch=sm_20 " else echo "WARNING: Cannot find the CUDA compiler 'nvcc'. This is likely to cause problems." cuda_prefix="/usr/local/cuda"@@ -31,15 +31,16 @@ # Location of the toolkit binaries and libraries #+cuda_frameworks="" cuda_inc_path="${cuda_prefix}/include" CPPFLAGS+=" -I${cuda_inc_path} "-cuda_frameworks="" case $target_os in darwin*) cuda_lib_path="${cuda_prefix}/lib" cuda_frameworks="CUDA"- LDFLAGS+=" -Xlinker -rpath ${cuda_lib_path} -F/Library/Frameworks -framework ${cuda_frameworks}"+ LDFLAGS+=" -F/Library/Frameworks -framework ${cuda_frameworks}"+ #LDFLAGS+=" -Xlinker -rpath ${cuda_lib_path} " #CPPFLAGS+=" -arch ${target_cpu} " ;; *)
cuda.cabal view
@@ -1,5 +1,5 @@ Name: cuda-Version: 0.5.1.1+Version: 0.6.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@@ -13,23 +13,26 @@ The configure script will look for your CUDA installation in the standard places, and if the nvcc compiler is found in your PATH, relative to that. .- /NOTE:/ Mavericks users (OS X 10.9) should use CUDA 5.5.28 and upwards.- .- This release is for version 5.0 of the CUDA toolkit.+ This release is for version 6.0 of the CUDA toolkit. License: BSD3 License-file: LICENSE-Copyright: Copyright (c) [2009..2013]. Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+Copyright: Copyright (c) [2009..2014]. Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> Author: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> Maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> Homepage: https://github.com/tmcdonell/cuda Bug-reports: https://github.com/tmcdonell/cuda/issues Category: Foreign-Cabal-version: >= 1.6+Cabal-version: >= 1.8 Tested-with: GHC >= 7.6 Build-type: Custom-Extra-tmp-files: cuda.buildinfo config.status config.log++Extra-tmp-files: cuda.buildinfo+ config.status+ config.log+ autom4te.cache+ Extra-source-files: configure configure.ac config.guess@@ -76,6 +79,16 @@ Extensions: ghc-options: -Wall -O2 -funbox-strict-fields -fwarn-tabs ghc-prof-options: -fprof-auto -fprof-cafs+++Test-suite deviceQuery+ Type: exitcode-stdio-1.0+ Main-is: DeviceQuery.hs+ hs-source-dirs: examples/src/deviceQueryDrv++ Build-depends: base >= 4 && < 5,+ cuda,+ pretty source-repository head
+ examples/src/deviceQueryDrv/DeviceQuery.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE RecordWildCards #-}++import Numeric+import Control.Monad+import Text.Printf+import Text.PrettyPrint++import Foreign.CUDA.Analysis as CUDA+import qualified Foreign.CUDA.Driver as CUDA+++main :: IO ()+main = do+ 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)++ CUDA.initialise []+ numDevices <- CUDA.count++ if numDevices == 0+ then printf "There are no available devices that support CUDA\n"+ else printf "Detected %d CUDA capable device%s\n" numDevices (if numDevices > 1 then "s" else "")++ forM_ [0 .. numDevices-1] $ \n -> do+ deviceProp <- CUDA.props =<< CUDA.device n+ printf "\nDevice %d: %s\n" n (deviceName deviceProp)+ statDevice deviceProp+++statDevice :: DeviceProperties -> IO ()+statDevice dev@DeviceProperties{..} =+ let+ DeviceResources{..} = deviceResources dev++ pad v = take width $ v ++ repeat ' '+ width = maximum $ map (length . fst) props+ table = nest 2 $ vcat $ map (\(k,v) -> text (pad k) <+> v) props++ grid (x,y) = int x <+> char 'x' <+> int y+ cube (x,y,z) = int x <+> char 'x' <+> int y <+> char 'x' <+> int z++ bool True = text "Yes"+ bool False = text "No"++ props =+ [("CUDA capability:", text $ show computeCapability)+ ,("CUDA cores:", text $ printf "%d cores in %d multiprocessors (%d cores/MP)" (coresPerMP * multiProcessorCount) multiProcessorCount coresPerMP)+ ,("Global memory:", text $ showBytes totalGlobalMem)+ ,("Constant memory:", text $ showBytes totalConstMem)+ ,("Shared memory per block:", text $ showBytes sharedMemPerBlock)+ ,("Registers per block:", int regsPerBlock)+ ,("Warp size:", int warpSize)+ ,("Maximum threads per multiprocessor:", int maxThreadsPerMultiProcessor)+ ,("Maximum threads per block:", int maxThreadsPerBlock)+ ,("Maximum grid dimensions:", cube maxGridSize)+ ,("Maximum block dimensions:", cube maxBlockSize)+ ,("GPU clock rate:", text $ showFreq clockRate)+ ,("Memory clock rate:", text $ showFreq memClockRate)+ ,("Memory bus width:", text $ showFreq memBusWidth)+ ,("L2 cache size:", text $ showBytes cacheMemL2)+ ,("Maximum texture dimensions", empty)+ ,(" 1D:", int maxTextureDim1D)+ ,(" 2D:", grid maxTextureDim2D)+ ,(" 3D:", cube maxTextureDim3D)+ ,("Texture alignment:", text $ showBytes textureAlignment)+ ,("Maximum memory pitch:", text $ showBytes memPitch)+ ,("Concurrent kernel execution:", bool concurrentKernels)+ ,("Concurrent copy and execution:", bool deviceOverlap <> text (printf ", with %d copy engine%s" asyncEngineCount (if asyncEngineCount > 1 then "s" else "")))+ ,("Runtime limit on kernel execution:", bool kernelExecTimeoutEnabled)+ ,("Integrated GPU sharing host memory:", bool integrated)+ ,("Host page-locked memory mapping:", bool canMapHostMemory)+ ,("ECC memory support:", bool eccEnabled)+ ,("Unified addressing (UVA):", bool unifiedAddressing)+ ,("PCI bus/location:", int (busID pciInfo) <> char '/' <> int (deviceID pciInfo))+ ,("Compute mode:", text (show computeMode))+ ]+ in+ putStrLn . render+ $ hang table 4+ $ case computeMode of+ Default -> text "Multiple host threads can use the device simultaneously"+ Exclusive -> text "Only one host thread in a process is able to use this device"+ Prohibited -> text "No host thread can use this device"+ ExclusiveProcess -> text "Multiple threads in one process can use the device simultaneously"+++showFreq :: Integral i => i -> String+showFreq x = showFFloatSIBase Nothing 1000 (fromIntegral x :: Double) "Hz"++showBytes :: Integral i => i -> String+showBytes x = showFFloatSIBase (Just 0) 1024 (fromIntegral x :: Double) "B"++showFFloatSIBase :: RealFloat a => Maybe Int -> a -> a -> ShowS+showFFloatSIBase p b n+ = showString+ $ showFFloat p n' (' ':si_unit)+ where+ n' = n / (b ^^ pow)+ pow = (-4) `max` floor (logBase b n) `min` 4 :: Int+ si_unit = case pow of+ -4 -> "p"+ -3 -> "n"+ -2 -> "µ"+ -1 -> "m"+ 0 -> ""+ 1 -> "k"+ 2 -> "M"+ 3 -> "G"+ 4 -> "T"+ _ -> error "out of range!"+