cuda 0.9.0.3 → 0.10.0.0
raw patch · 49 files changed
+2077/−686 lines, 49 filesdep +uuid-typesdep ~basedep ~bytestringsetup-changed
Dependencies added: uuid-types
Dependency ranges changed: base, bytestring
Files
- CHANGELOG.markdown +19/−0
- Setup.hs +8/−4
- cbits/stubs.c +76/−0
- cbits/stubs.h +7/−0
- cuda.cabal +20/−12
- examples/src/deviceQueryDrv/DeviceQuery.hs +96/−49
- src/Foreign/C/Extra.hs +38/−0
- src/Foreign/CUDA/Analysis.hs +1/−1
- src/Foreign/CUDA/Analysis/Device.chs +85/−44
- src/Foreign/CUDA/Analysis/Occupancy.hs +1/−1
- src/Foreign/CUDA/Driver.hs +2/−2
- src/Foreign/CUDA/Driver/Context.hs +1/−1
- src/Foreign/CUDA/Driver/Context/Base.chs +1/−1
- src/Foreign/CUDA/Driver/Context/Config.chs +3/−3
- src/Foreign/CUDA/Driver/Context/Peer.chs +3/−3
- src/Foreign/CUDA/Driver/Context/Primary.chs +1/−1
- src/Foreign/CUDA/Driver/Device.chs +157/−158
- src/Foreign/CUDA/Driver/Error.chs +6/−2
- src/Foreign/CUDA/Driver/Event.chs +37/−4
- src/Foreign/CUDA/Driver/Exec.chs +6/−5
- src/Foreign/CUDA/Driver/Graph/Base.chs +77/−0
- src/Foreign/CUDA/Driver/Graph/Build.chs +689/−0
- src/Foreign/CUDA/Driver/Graph/Capture.chs +128/−0
- src/Foreign/CUDA/Driver/Graph/Exec.chs +132/−0
- src/Foreign/CUDA/Driver/IPC/Event.chs +1/−1
- src/Foreign/CUDA/Driver/IPC/Marshal.chs +1/−1
- src/Foreign/CUDA/Driver/Marshal.chs +35/−6
- src/Foreign/CUDA/Driver/Module.hs +1/−1
- src/Foreign/CUDA/Driver/Module/Base.chs +4/−45
- src/Foreign/CUDA/Driver/Module/Link.chs +6/−3
- src/Foreign/CUDA/Driver/Module/Query.chs +62/−17
- src/Foreign/CUDA/Driver/Profiler.chs +1/−1
- src/Foreign/CUDA/Driver/Stream.chs +204/−25
- src/Foreign/CUDA/Driver/Texture.chs +1/−1
- src/Foreign/CUDA/Driver/Unified.chs +2/−2
- src/Foreign/CUDA/Driver/Utils.chs +1/−1
- src/Foreign/CUDA/Internal/C2HS.hs +33/−6
- src/Foreign/CUDA/Path.chs +1/−1
- src/Foreign/CUDA/Ptr.hs +43/−5
- src/Foreign/CUDA/Runtime.hs +1/−1
- src/Foreign/CUDA/Runtime/Device.chs +66/−96
- src/Foreign/CUDA/Runtime/Error.chs +1/−1
- src/Foreign/CUDA/Runtime/Event.chs +7/−6
- src/Foreign/CUDA/Runtime/Exec.chs +1/−1
- src/Foreign/CUDA/Runtime/Marshal.chs +1/−1
- src/Foreign/CUDA/Runtime/Stream.chs +8/−6
- src/Foreign/CUDA/Runtime/Texture.chs +1/−1
- src/Foreign/CUDA/Runtime/Utils.chs +1/−1
- src/Foreign/CUDA/Types.chs +0/−165
CHANGELOG.markdown view
@@ -4,6 +4,24 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/). +## [0.10.0.0] - 2018-10-02+### Added+ * Device properties for SM7+ * Functions from CUDA-9.2+ * `Device.uuid`+ * `Stream.getContext`++ * Functions from CUDA-10.0+ * `Foreign.CUDA.Driver.Graph*`++ * Additional bindings from older CUDA releases++### Changed+ * Replace uses of `String` with `ShortByteString`++### Removed+ * Support for ghc-7.6+ ## [0.9.0.3] - 2018-03-12 ### Fixed * Build fix for Cabal-2.2 (ghc-8.4)@@ -115,6 +133,7 @@ * Add functions from CUDA-6.5 +[0.10.0.0]: https://github.com/tmcdonell/cuda/compare/0.9.0.3...v0.10.0.0 [0.9.0.3]: https://github.com/tmcdonell/cuda/compare/0.9.0.2...0.9.0.3 [0.9.0.2]: https://github.com/tmcdonell/cuda/compare/0.9.0.1...0.9.0.2 [0.9.0.1]: https://github.com/tmcdonell/cuda/compare/0.9.0.0...0.9.0.1
Setup.hs view
@@ -259,7 +259,7 @@ -> [FilePath] -> IO [FilePath] cudaGhciLibrariesWindows platform installPath libraries = do- candidates <- mapM importLibraryToDLLFileName [ cudaLibraryPath platform installPath </> lib <.> "lib" | lib <- libraries ]+ candidates <- mapM (importLibraryToDLLFileName platform) [ cudaLibraryPath platform installPath </> lib <.> "lib" | lib <- libraries ] return [ dropExtension dll | Just dll <- candidates ] @@ -283,8 +283,8 @@ -- The function is meant to be used on Windows. Other platforms may or may -- not work. ---importLibraryToDLLFileName :: FilePath -> IO (Maybe FilePath)-importLibraryToDLLFileName importLibPath = do+importLibraryToDLLFileName :: Platform -> FilePath -> IO (Maybe FilePath)+importLibraryToDLLFileName platform importLibPath = do -- Sample output nm generates on cudart.lib -- -- nvcuda.dll:@@ -298,7 +298,11 @@ -- U nvcuda_NULL_THUNK_DATA -- nmOutput <- getProgramInvocationOutput normal (simpleProgramInvocation "nm" [importLibPath])- return $ find (isInfixOf ("" <.> dllExtension)) (lines nmOutput)+#if MIN_VERSION_Cabal(2,3,0)+ return $ find (isInfixOf ("" <.> dllExtension platform)) (lines nmOutput)+#else+ return $ find (isInfixOf ("" <.> dllExtension)) (lines nmOutput)+#endif -- Slightly modified version of `words` from base - it takes predicate saying on
cbits/stubs.c view
@@ -393,3 +393,79 @@ } #endif +#if CUDA_VERSION >= 10000+CUresult CUDAAPI cuGraphAddHostNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUhostFn fn, void* userData)+{+ CUDA_HOST_NODE_PARAMS nodeParams;+ nodeParams.fn = fn;+ nodeParams.userData = userData;++ return cuGraphAddHostNode(phGraphNode, hGraph, dependencies, numDependencies, &nodeParams);+}++CUresult CUDAAPI cuGraphAddKernelNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUfunction func, unsigned int gridDimX, unsigned int gridDimY, unsigned int gridDimZ, unsigned int blockDimX, unsigned int blockDimY, unsigned int blockDimZ, unsigned int sharedMemBytes, void** kernelParams)+{+ CUDA_KERNEL_NODE_PARAMS nodeParams;+ nodeParams.func = func;+ nodeParams.gridDimX = gridDimX;+ nodeParams.gridDimY = gridDimY;+ nodeParams.gridDimZ = gridDimZ;+ nodeParams.blockDimX = blockDimX;+ nodeParams.blockDimY = blockDimY;+ nodeParams.blockDimZ = blockDimZ;+ nodeParams.sharedMemBytes = sharedMemBytes;+ nodeParams.kernelParams = kernelParams;+ nodeParams.extra = NULL;++ return cuGraphAddKernelNode(phGraphNode, hGraph, dependencies, numDependencies, &nodeParams);+}++CUresult CUDAAPI cuGraphAddMemcpyNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUcontext ctx, size_t srcXInBytes, size_t srcY, size_t srcZ, size_t srcLOD, CUmemorytype srcMemoryType, const void *srcPtr, size_t srcPitch, size_t srcHeight, size_t dstXInBytes, size_t dstY, size_t dstZ, size_t dstLOD, CUmemorytype dstMemoryType, void *dstPtr, size_t dstPitch, size_t dstHeight, size_t widthInBytes, size_t height, size_t depth)+{+ CUDA_MEMCPY3D copyParams;++ copyParams.srcXInBytes = srcXInBytes;+ copyParams.srcY = srcY;+ copyParams.srcZ = srcZ;+ copyParams.srcLOD = srcLOD;+ copyParams.srcMemoryType = srcMemoryType;+ copyParams.srcHost = (void*) srcPtr;+ copyParams.srcDevice = (CUdeviceptr) srcPtr;+ copyParams.srcArray = (CUarray) srcPtr;+ copyParams.reserved0 = NULL;+ copyParams.srcPitch = srcPitch;+ copyParams.srcHeight = srcHeight;++ copyParams.dstXInBytes = dstXInBytes;+ copyParams.dstY = dstY;+ copyParams.dstZ = dstZ;+ copyParams.dstLOD = dstLOD;+ copyParams.dstMemoryType = dstMemoryType;+ copyParams.dstHost = (void*) dstPtr;+ copyParams.dstDevice = (CUdeviceptr) dstPtr;+ copyParams.dstArray = (CUarray) dstPtr;+ copyParams.reserved1 = NULL;+ copyParams.dstPitch = dstPitch;+ copyParams.dstHeight = dstHeight;++ copyParams.WidthInBytes = widthInBytes;+ copyParams.Height = height;+ copyParams.Depth = depth;++ return cuGraphAddMemcpyNode(phGraphNode, hGraph, dependencies, numDependencies, ©Params, ctx);+}++CUresult CUDAAPI cuGraphAddMemsetNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUcontext ctx, CUdeviceptr dst, unsigned int elementSize, size_t height, size_t pitch, unsigned int value, size_t width)+{+ CUDA_MEMSET_NODE_PARAMS memsetParams;+ memsetParams.dst = dst;+ memsetParams.elementSize = elementSize;+ memsetParams.height = height;+ memsetParams.pitch = pitch;+ memsetParams.value = value;+ memsetParams.width = width;++ return cuGraphAddMemsetNode(phGraphNode, hGraph, dependencies, numDependencies, &memsetParams, ctx);+}+#endif+
cbits/stubs.h view
@@ -218,6 +218,13 @@ CUresult CUDAAPI cuLinkAddFile(CUlinkState state, CUjitInputType type, const char *path, unsigned int numOptions, CUjit_option *options, void **optionValues); #endif +#if CUDA_VERSION >= 10000+CUresult CUDAAPI cuGraphAddHostNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUhostFn fn, void* userData);+CUresult CUDAAPI cuGraphAddKernelNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUfunction func, unsigned int gridDimX, unsigned int gridDimY, unsigned int gridDimZ, unsigned int blockDimX, unsigned int blockDimY, unsigned int blockDimZ, unsigned int sharedMemBytes, void** kernelParams);+CUresult CUDAAPI cuGraphAddMemcpyNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUcontext ctx, size_t srcXInBytes, size_t srcY, size_t srcZ, size_t srcLOD, CUmemorytype srcMemoryType, const void *srcPtr, size_t srcPitch, size_t srcHeight, size_t dstXInBytes, size_t dstY, size_t dstZ, size_t dstLOD, CUmemorytype dstMemoryType, void *dstPtr, size_t dstPitch, size_t dstHeight, size_t widthInBytes, size_t height, size_t depth);+CUresult CUDAAPI cuGraphAddMemsetNode_simple(CUgraphNode *phGraphNode, CUgraph hGraph, CUgraphNode *dependencies, size_t numDependencies, CUcontext ctx, CUdeviceptr dst, unsigned int elementSize, size_t height, size_t pitch, unsigned int value, size_t width);+#endif+ #ifdef __cplusplus } #endif
cuda.cabal view
@@ -1,5 +1,5 @@ Name: cuda-Version: 0.9.0.3+Version: 0.10.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@@ -28,8 +28,9 @@ . * "Foreign.CUDA.Runtime" .- See the <https://travis-ci.org/tmcdonell/cuda travis-ci.org> build matrix- for tested CUDA library versions.+ Tested with library versions up to CUDA-9.2. See also the+ <https://travis-ci.org/tmcdonell/cuda travis-ci.org> build matrix for+ version compatibility. . [/NOTES:/] .@@ -57,14 +58,14 @@ License: BSD3 License-file: LICENSE-Copyright: Copyright (c) [2009..2017]. 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>+Copyright: Copyright (c) [2009..2018]. Trevor L. McDonell <trevor.mcdonell@gmail.com>+Author: Trevor L. McDonell <trevor.mcdonell@gmail.com>+Maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com> Homepage: https://github.com/tmcdonell/cuda Bug-reports: https://github.com/tmcdonell/cuda/issues Category: Foreign Cabal-version: >= 1.24-Tested-with: GHC >= 7.6+Tested-with: GHC >= 7.8 Build-type: Custom @@ -77,7 +78,7 @@ custom-setup setup-depends:- base >= 4.6+ base >= 4.7 , Cabal >= 1.24 , directory >= 1.0 , filepath >= 1.0@@ -88,7 +89,6 @@ Foreign.CUDA Foreign.CUDA.Path Foreign.CUDA.Ptr- Foreign.CUDA.Types -- Kernel and device analysis Foreign.CUDA.Analysis@@ -106,6 +106,10 @@ Foreign.CUDA.Driver.Error Foreign.CUDA.Driver.Event Foreign.CUDA.Driver.Exec+ Foreign.CUDA.Driver.Graph.Base+ Foreign.CUDA.Driver.Graph.Build+ Foreign.CUDA.Driver.Graph.Capture+ Foreign.CUDA.Driver.Graph.Exec Foreign.CUDA.Driver.IPC.Event Foreign.CUDA.Driver.IPC.Marshal Foreign.CUDA.Driver.Marshal@@ -130,6 +134,9 @@ Foreign.CUDA.Runtime.Texture Foreign.CUDA.Runtime.Utils + -- Extras+ Foreign.C.Extra+ Other-modules: Foreign.CUDA.Internal.C2HS Text.Show.Describe@@ -140,10 +147,11 @@ Build-tools: c2hs >= 0.21 Build-depends:- base >= 4 && < 5- , bytestring+ base >= 4.7 && < 5+ , bytestring >= 0.10.4 , filepath >= 1.0 , template-haskell+ , uuid-types >= 1.0 default-language: Haskell98 Extensions:@@ -181,6 +189,6 @@ source-repository this type: git location: https://github.com/tmcdonell/cuda- tag: 0.9.0.3+ tag: v0.10.0.0 -- vim: nospell
examples/src/deviceQueryDrv/DeviceQuery.hs view
@@ -1,13 +1,16 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} module Main where -import Numeric import Control.Monad-import Text.Printf-import Text.PrettyPrint+import Numeric import Prelude hiding ( (<>) )+import Text.PrettyPrint+import Text.Printf +import Foreign.CUDA.Driver.Device ( Device(..) ) import Foreign.CUDA.Analysis as CUDA import qualified Foreign.CUDA.Driver as CUDA @@ -26,64 +29,108 @@ 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+ infos <- forM [0 .. numDevices-1] $ \n -> do+ dev <- CUDA.device n+ prp <- CUDA.props dev+ return (n, dev, prp) + forM_ infos $ \(n, dev, prp) -> do+ p2p <- statP2P dev prp infos+ printf "\nDevice %d: %s\n%s\n" n (deviceName prp) (statDevice prp)+ unless (null p2p) $ printf "%s\n" p2p -statDevice :: DeviceProperties -> IO ()++statDevice :: DeviceProperties -> String 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"+ grid (x,y) = int x <+> char 'x' <+> int y+ cube (x,y,z) = int x <+> char 'x' <+> int y <+> char 'x' <+> int z 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 * 1000)- ,("Memory clock rate:", text . showFreq $ memClockRate * 1000)- ,("Memory bus width:", int memBusWidth <> text "-bit")- ,("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))+ [("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 * 1000)+ ,("Memory clock rate:", text . showFreq $ memClockRate * 1000)+ ,("Memory bus width:", int memBusWidth <> text "-bit")+ ,("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)]+++#if __GLASGOW_HASKELL__ > 710+ $(if CUDA.libraryVersion >= 8000 then [|+ [("Single to double precision performance:", text $ printf "%d : 1" singleToDoublePerfRatio)+ ,("Supports compute pre-emption:", bool preemption)]|] else [|[]|])+++ $(if CUDA.libraryVersion >= 9000 then [|+ [("Supports cooperative launch:", bool cooperativeLaunch)+ ,("Supports multi-device cooperative launch:", bool cooperativeLaunchMultiDevice)]|] else [|[]|])+++#endif+ [("PCI bus/location:", int (busID pciInfo) <> char '/' <> int (deviceID pciInfo))+ ,("Compute mode:", text (show computeMode)) ] in- putStrLn . render- $ hang table 4+ render+ $ hang (table props) 4 $ text (describe computeMode) ++statP2P :: Device -> DeviceProperties -> [(Int, Device, DeviceProperties)] -> IO String+statP2P dev prp infos+ | CUDA.libraryVersion < 4000 = return []++ -- Only Fermi and later can support P2P+ | computeCapability prp < Compute 2 0 = return []+ | otherwise+ = let+ go [] = return []+ go ((m, peer, pp):is) =+ if dev == peer+ then go is+ else do+ access <- CUDA.accessible dev peer+ rest <- go is+ return $ (printf " Device %d (%s):" m (deviceName pp), bool access) : rest+ in do+ access <- go infos+ return+ $ if null access+ then []+ else render+ $ table (("Peer-to-Peer access to:", empty) : access)+++table :: [(String, Doc)] -> Doc+table kvs+ = nest 2+ $ vcat+ $ map (\(k,v) -> text (pad k) <+> v) kvs+ where+ pad v = take width $ v ++ repeat ' '+ width = maximum $ map (length . fst) kvs++bool :: Bool -> Doc+bool True = text "Yes"+bool False = text "No" showFreq :: Integral i => i -> String showFreq x = showFFloatSIBase Nothing 1000 (fromIntegral x :: Double) "Hz"
+ src/Foreign/C/Extra.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.C.Extra+-- Copyright : [2018] Trevor L. McDonell+-- License : BSD+--+--------------------------------------------------------------------------------++module Foreign.C.Extra (++ c_strnlen,++) where++import Foreign.C+++#if defined(WIN32)+{-# INLINE c_strnlen' #-}+c_strnlen' :: CString -> CSize -> IO CSize+c_strnlen' str size = do+ str' <- peekCStringLen (str, fromIntegral size)+ return $ stringLen 0 str'+ where+ stringLen acc [] = acc+ stringLen acc ('\0':_) = acc+ stringLen acc (_:xs) = stringLen (acc+1) xs+#else+foreign import ccall unsafe "string.h strnlen" c_strnlen'+ :: CString -> CSize -> IO CSize+#endif++{-# INLINE c_strnlen #-}+c_strnlen :: CString -> Int -> IO Int+c_strnlen str maxlen = fromIntegral `fmap` c_strnlen' str (fromIntegral maxlen)+
src/Foreign/CUDA/Analysis.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Meta-module exporting CUDA analysis routines
src/Foreign/CUDA/Analysis/Device.chs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis.Device--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Common device functions@@ -69,69 +69,77 @@ -- 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 -- ^ Maximum number of threads per block+ 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 -- ^ Maximum number of threads per block #if CUDA_VERSION >= 4000- , maxThreadsPerMultiProcessor :: !Int -- ^ Maximum number of threads per multiprocessor+ , maxThreadsPerMultiProcessor :: !Int -- ^ Maximum number of threads per multiprocessor #endif- , maxBlockSize :: !(Int,Int,Int) -- ^ Maximum size of each dimension of a block- , maxGridSize :: !(Int,Int,Int) -- ^ Maximum size of each dimension of a grid+ , maxBlockSize :: !(Int,Int,Int) -- ^ Maximum size of each dimension of a block+ , maxGridSize :: !(Int,Int,Int) -- ^ Maximum 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 -- ^ Maximum pitch in bytes allowed by memory copies+ , clockRate :: !Int -- ^ Clock frequency in kilohertz+ , multiProcessorCount :: !Int -- ^ Number of multiprocessors on the device+ , memPitch :: !Int64 -- ^ Maximum 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- , pciInfo :: !PCI -- ^ PCI device information for the device- , tccDriverEnabled :: !Bool -- ^ Whether this is a Tesla device using the TCC driver+ , asyncEngineCount :: !Int -- ^ Number of asynchronous engines+ , cacheMemL2 :: !Int -- ^ Size of the L2 cache in bytes+ , pciInfo :: !PCI -- ^ PCI device information for the device+ , tccDriverEnabled :: !Bool -- ^ Whether this is a Tesla device using the TCC driver #endif- , kernelExecTimeoutEnabled :: !Bool -- ^ Whether there is a runtime limit on kernels- , integrated :: !Bool -- ^ As opposed to discrete- , canMapHostMemory :: !Bool -- ^ Device can use pinned memory+ , kernelExecTimeoutEnabled :: !Bool -- ^ Whether there is a runtime limit on kernels+ , integrated :: !Bool -- ^ As opposed to discrete+ , canMapHostMemory :: !Bool -- ^ Device can use pinned memory #if CUDA_VERSION >= 4000- , unifiedAddressing :: !Bool -- ^ Device shares a unified address space with the host+ , unifiedAddressing :: !Bool -- ^ Device shares a unified address space with the host #endif #if CUDA_VERSION >= 5050- , streamPriorities :: !Bool -- ^ Device supports stream priorities+ , streamPriorities :: !Bool -- ^ Device supports stream priorities #endif #if CUDA_VERSION >= 6000- , globalL1Cache :: !Bool -- ^ Device supports caching globals in L1 cache- , localL1Cache :: !Bool -- ^ Device supports caching locals in L1 cache- , managedMemory :: !Bool -- ^ Device supports allocating managed memory on this system- , multiGPUBoard :: !Bool -- ^ Device is on a multi-GPU board- , multiGPUBoardGroupID :: !Int -- ^ Unique identifier for a group of devices associated with the same board+ , globalL1Cache :: !Bool -- ^ Device supports caching globals in L1 cache+ , localL1Cache :: !Bool -- ^ Device supports caching locals in L1 cache+ , managedMemory :: !Bool -- ^ Device supports allocating managed memory on this system+ , multiGPUBoard :: !Bool -- ^ Device is on a multi-GPU board+ , multiGPUBoardGroupID :: !Int -- ^ Unique identifier for a group of devices associated with the same board #endif+#if CUDA_VERSION >= 8000+ , preemption :: !Bool -- ^ Device supports compute pre-emption+ , singleToDoublePerfRatio :: !Int -- ^ Ratio of single precision performance (in floating-point operations per second) to double precision performance+#endif+#if CUDA_VERSION >= 9000+ , cooperativeLaunch :: !Bool -- ^ Device supports launching cooperative kernels+ , cooperativeLaunchMultiDevice :: !Bool -- ^ Device can participate in cooperative multi-device kernels+#endif } deriving (Show) 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) @@ -158,6 +166,7 @@ , sharedMemAllocUnit :: !Int -- ^ Shared memory allocation unit size (bytes) , warpAllocUnit :: !Int -- ^ Warp allocation granularity , warpRegAllocUnit :: !Int -- ^ Warp register allocation granularity+ , maxGridsPerDevice :: !Int -- ^ Maximum number of resident grids per device (concurrent kernels) } @@ -187,6 +196,7 @@ , sharedMemAllocUnit = 512 , warpAllocUnit = 2 , warpRegAllocUnit = 256+ , maxGridsPerDevice = 1 } Compute 1 2 -> resources (Compute 1 3) -- Tesla G9x Compute 1 3 -> (resources (Compute 1 1)) -- Tesla GT200@@ -213,12 +223,13 @@ , sharedMemAllocUnit = 128 , warpAllocUnit = 2 , warpRegAllocUnit = 64+ , maxGridsPerDevice = 16 } Compute 2 1 -> (resources (Compute 2 0)) -- Fermi GF10x { coresPerMP = 48 } - Compute 3 0 -> DeviceResources+ Compute 3 0 -> DeviceResources -- Kepler GK10x { threadsPerWarp = 32 , coresPerMP = 192 , warpsPerMP = 64@@ -234,10 +245,15 @@ , sharedMemAllocUnit = 256 , warpAllocUnit = 4 , warpRegAllocUnit = 256+ , maxGridsPerDevice = 16 } Compute 3 2 -> (resources (Compute 3 5)) -- Jetson TK1+ { maxRegPerBlock = 32768+ , maxGridsPerDevice = 4+ } Compute 3 5 -> (resources (Compute 3 0)) -- Kepler GK11x { maxRegPerThread = 255+ , maxGridsPerDevice = 32 } Compute 3 7 -> (resources (Compute 3 5)) -- Kepler GK21x { sharedMemPerMP = 114688@@ -260,6 +276,7 @@ , sharedMemAllocUnit = 256 , warpAllocUnit = 4 , warpRegAllocUnit = 256+ , maxGridsPerDevice = 32 } Compute 5 2 -> (resources (Compute 5 0)) -- Maxwell GM20x { sharedMemPerMP = 98304@@ -269,6 +286,7 @@ Compute 5 3 -> (resources (Compute 5 0)) -- Maxwell GM20B { maxRegPerBlock = 32768 , warpAllocUnit = 2+ , maxGridsPerDevice = 16 } Compute 6 0 -> DeviceResources -- Pascal GP100@@ -287,17 +305,40 @@ , sharedMemAllocUnit = 256 , warpAllocUnit = 2 , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128 } Compute 6 1 -> (resources (Compute 6 0)) -- Pascal GP10x { coresPerMP = 128 , sharedMemPerMP = 98304 , warpAllocUnit = 4+ , maxGridsPerDevice = 32 }- Compute 6 2 -> (resources (Compute 6 0)) -- Pascal ??+ Compute 6 2 -> (resources (Compute 6 0)) -- Pascal GP10B { coresPerMP = 128 , warpsPerMP = 128 , threadBlocksPerMP = 4096+ , maxRegPerBlock = 32768 , warpAllocUnit = 4+ , maxGridsPerDevice = 16+ }++ Compute 7 _ -> DeviceResources -- Volta GV100+ { threadsPerWarp = 32+ , coresPerMP = 64+ , warpsPerMP = 64+ , threadsPerMP = 2048+ , threadBlocksPerMP = 32+ , sharedMemPerMP = 98304+ , maxSharedMemPerBlock = 49152 -- XXX: or 96KB?+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 256+ , warpAllocUnit = 2+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128 } -- Something might have gone wrong, or the library just needs to be
src/Foreign/CUDA/Analysis/Occupancy.hs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis.Occupancy--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Occupancy calculations for CUDA kernels
src/Foreign/CUDA/Driver.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- This module defines an interface to the CUDA driver API. The Driver API@@ -232,7 +232,7 @@ import Foreign.CUDA.Driver.Context hiding ( useContext, device ) import Foreign.CUDA.Driver.Device hiding ( useDevice ) import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Exec+import Foreign.CUDA.Driver.Exec hiding ( useFun ) import Foreign.CUDA.Driver.Marshal hiding ( useDeviceHandle, peekDeviceHandle ) import Foreign.CUDA.Driver.Module import Foreign.CUDA.Driver.Unified
src/Foreign/CUDA/Driver/Context.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Context management for low-level driver interface
src/Foreign/CUDA/Driver/Context/Base.chs view
@@ -9,7 +9,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context.Base--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Context management for the low-level driver interface
src/Foreign/CUDA/Driver/Context/Config.chs view
@@ -9,7 +9,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context.Config--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Context configuration for the low-level driver interface@@ -46,7 +46,7 @@ import Foreign.CUDA.Driver.Context.Base import Foreign.CUDA.Driver.Error import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Types+import Foreign.CUDA.Driver.Stream ( Stream, StreamPriority ) -- System import Control.Monad@@ -158,7 +158,7 @@ {-# INLINE cuCtxSetLimit #-} {# fun unsafe cuCtxSetLimit { cFromEnum `Limit'- , cIntConv `Int' } -> `Status' cToEnum #}+ , `Int' } -> `Status' cToEnum #} #endif
src/Foreign/CUDA/Driver/Context/Peer.chs view
@@ -9,7 +9,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context.Peer--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Direct peer context access functions for the low-level driver interface.@@ -50,7 +50,7 @@ data PeerFlag instance Enum PeerFlag where #ifdef USE_EMPTY_CASE- toEnum x = case x of {}+ toEnum x = error ("PeerFlag.toEnum: Cannot match " ++ show x) fromEnum x = case x of {} #endif @@ -61,7 +61,7 @@ data PeerAttribute instance Enum PeerAttribute where #ifdef USE_EMPTY_CASE- toEnum x = case x of {}+ toEnum x = error ("PeerAttribute.toEnum: Cannot match " ++ show x) fromEnum x = case x of {} #endif #else
src/Foreign/CUDA/Driver/Context/Primary.chs view
@@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context.Primary--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Primary context management for low-level driver interface. The primary
src/Foreign/CUDA/Driver/Device.chs view
@@ -2,13 +2,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} #ifdef USE_EMPTY_CASE {-# LANGUAGE EmptyCase #-} #endif -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Device--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Device management for low-level driver interface@@ -20,7 +22,7 @@ -- * Device Management Device(..), DeviceProperties(..), DeviceAttribute(..), Compute(..), ComputeMode(..), InitFlag,- initialise, capability, device, attribute, count, name, props, totalMem+ initialise, capability, device, attribute, count, name, props, uuid, totalMem, ) where @@ -33,10 +35,12 @@ import Foreign.CUDA.Internal.C2HS -- System+import Control.Applicative+import Control.Monad ( liftM )+import Data.Bits+import Data.UUID.Types import Foreign import Foreign.C-import Control.Monad ( liftM )-import Control.Applicative import Prelude @@ -89,17 +93,17 @@ poke _ _ = error "no instance for Foreign.Storable.poke DeviceProperties" peek p = do- tb <- cIntConv `fmap` {#get CUdevprop.maxThreadsPerBlock#} p- sm <- cIntConv `fmap` {#get CUdevprop.sharedMemPerBlock#} p- cm <- cIntConv `fmap` {#get CUdevprop.totalConstantMemory#} p- ws <- cIntConv `fmap` {#get CUdevprop.SIMDWidth#} p- mp <- cIntConv `fmap` {#get CUdevprop.memPitch#} p- rb <- cIntConv `fmap` {#get CUdevprop.regsPerBlock#} p- cl <- cIntConv `fmap` {#get CUdevprop.clockRate#} p- ta <- cIntConv `fmap` {#get CUdevprop.textureAlign#} p+ tb <- fromIntegral `fmap` {#get CUdevprop.maxThreadsPerBlock#} p+ sm <- fromIntegral `fmap` {#get CUdevprop.sharedMemPerBlock#} p+ cm <- fromIntegral `fmap` {#get CUdevprop.totalConstantMemory#} p+ ws <- fromIntegral `fmap` {#get CUdevprop.SIMDWidth#} p+ mp <- fromIntegral `fmap` {#get CUdevprop.memPitch#} p+ rb <- fromIntegral `fmap` {#get CUdevprop.regsPerBlock#} p+ cl <- fromIntegral `fmap` {#get CUdevprop.clockRate#} p+ ta <- fromIntegral `fmap` {#get CUdevprop.textureAlign#} p - [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxThreadsDim#} p- [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxGridSize#} p+ [t1,t2,t3] <- peekArrayWith fromIntegral 3 =<< {#get CUdevprop.maxThreadsDim#} p+ [g1,g2,g3] <- peekArrayWith fromIntegral 3 =<< {#get CUdevprop.maxGridSize#} p return CUDevProp {@@ -124,7 +128,7 @@ data InitFlag instance Enum InitFlag where #ifdef USE_EMPTY_CASE- toEnum x = case x of {}+ toEnum x = error ("InitFlag.toEnum: Cannot match " ++ show x) fromEnum x = case x of {} #endif @@ -141,14 +145,16 @@ -- {-# INLINEABLE initialise #-} initialise :: [InitFlag] -> IO ()-initialise !flags = nothingIfOk =<< cuInit flags <* enable_constructors+initialise !flags = do+ enable_constructors+ cuInit flags {-# INLINE enable_constructors #-} {# fun unsafe enable_constructors { } -> `()' #} {-# INLINE cuInit #-} {# fun unsafe cuInit- { combineBitMasks `[InitFlag]' } -> `Status' cToEnum #}+ { combineBitMasks `[InitFlag]' } -> `()' checkStatus*- #} --------------------------------------------------------------------------------@@ -167,14 +173,15 @@ #else -- Deprecated as of CUDA-5.0 ---capability !dev =- (\(!s,!a,!b) -> resultIfOk (s,Compute a b)) =<< cuDeviceComputeCapability dev+capability !dev = uncurry Compute <$> cuDeviceComputeCapability dev {-# INLINE cuDeviceComputeCapability #-} {# fun unsafe cuDeviceComputeCapability { alloca- `Int' peekIntConv* , alloca- `Int' peekIntConv*- , useDevice `Device' } -> `Status' cToEnum #}+ , useDevice `Device'+ }+ -> `()' checkStatus*- #} #endif @@ -184,14 +191,13 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g8bdd1cc7201304b01357b8034f6587cb> -- {-# INLINEABLE device #-}-device :: Int -> IO Device-device !d = resultIfOk =<< cuDeviceGet d--{-# INLINE cuDeviceGet #-}-{# fun unsafe cuDeviceGet+{# fun unsafe cuDeviceGet as device { alloca- `Device' dev*- , cIntConv `Int' } -> `Status' cToEnum #}- where dev = liftM Device . peek+ , `Int'+ }+ -> `()' checkStatus*- #}+ where+ dev = liftM Device . peek -- |@@ -201,13 +207,14 @@ -- {-# INLINEABLE attribute #-} attribute :: Device -> DeviceAttribute -> IO Int-attribute !d !a = resultIfOk =<< cuDeviceGetAttribute a d--{-# INLINE cuDeviceGetAttribute #-}-{# fun unsafe cuDeviceGetAttribute- { alloca- `Int' peekIntConv*- , cFromEnum `DeviceAttribute'- , useDevice `Device' } -> `Status' cToEnum #}+attribute !d !a = cuDeviceGetAttribute a d+ where+ {# fun unsafe cuDeviceGetAttribute+ { alloca- `Int' peekIntConv*+ , cFromEnum `DeviceAttribute'+ , useDevice `Device'+ }+ -> `()' checkStatus*- #} -- |@@ -216,12 +223,10 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g52b5ce05cb8c5fb6831b2c0ff2887c74> -- {-# INLINEABLE count #-}-count :: IO Int-count = resultIfOk =<< cuDeviceGetCount--{-# INLINE cuDeviceGetCount #-}-{# fun unsafe cuDeviceGetCount- { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}+{# fun unsafe cuDeviceGetCount as count+ { alloca- `Int' peekIntConv*+ }+ -> `()' checkStatus*- #} -- |@@ -230,19 +235,63 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1gef75aa30df95446a845f2a7b9fffbb7f> -- {-# INLINEABLE name #-}-name :: Device -> IO String-name !d = resultIfOk =<< cuDeviceGetName d--{-# INLINE cuDeviceGetName #-}-{# fun unsafe cuDeviceGetName+{# fun unsafe cuDeviceGetName as name { allocaS- `String'& peekS*- , useDevice `Device' } -> `Status' cToEnum #}+ , useDevice `Device'+ }+ -> `()' checkStatus*- #} where len = 512- allocaS a = allocaBytes len $ \p -> a (p, cIntConv len)+ allocaS a = allocaBytes len $ \p -> a (p, fromIntegral len) peekS s _ = peekCString s +-- | Returns a UUID for the device+--+-- Requires CUDA-9.2+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g987b46b884c101ed5be414ab4d9e60e4>+--+-- @since 0.10.0.0+--+{-# INLINE uuid #-}+uuid :: Device -> IO UUID+#if CUDA_VERSION < 9020+uuid = requireSDK 'uuid 9.2+#else+uuid !dev =+ allocaBytes 16 $ \ptr -> do+ cuDeviceGetUuid ptr dev+ unpack ptr+ where+ {-# INLINE cuDeviceGetUuid #-}+ {# fun unsafe cuDeviceGetUuid+ { `Ptr ()'+ , useDevice `Device'+ } -> `()' checkStatus*- #}++ {-# INLINE unpack #-}+ unpack :: Ptr () -> IO UUID+ unpack !p = do+ let !q = castPtr p+ a <- word <$> peekElemOff q 0 <*> peekElemOff q 1 <*> peekElemOff q 2 <*> peekElemOff q 3+ b <- word <$> peekElemOff q 4 <*> peekElemOff q 5 <*> peekElemOff q 6 <*> peekElemOff q 7+ c <- word <$> peekElemOff q 8 <*> peekElemOff q 9 <*> peekElemOff q 10 <*> peekElemOff q 11+ d <- word <$> peekElemOff q 12 <*> peekElemOff q 13 <*> peekElemOff q 14 <*> peekElemOff q 15+ return $! fromWords a b c d++ {-# INLINE word #-}+ word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+ word !a !b !c !d+ = (fromIntegral a `shiftL` 24)+ .|. (fromIntegral b `shiftL` 16)+ .|. (fromIntegral c `shiftL` 8)+ .|. (fromIntegral d )+#endif+++-- TODO: cuDeviceGetLuid, introduced CUDA-10.0 (windows only)+ -- | -- Return the properties of the selected device --@@ -257,127 +306,79 @@ -- functionality subsumed by the latter, which we use below. -- p <- resultIfOk =<< cuDeviceGetProperties d- let cm = cuTotalConstMem p- sm = cuSharedMemPerBlock p- rb = cuRegsPerBlock p- ws = cuWarpSize p- tb = cuMaxThreadsPerBlock p- bs = cuMaxBlockSize p- gs = cuMaxGridSize p- cl = cuClockRate p- mp = cuMemPitch p- ta = cuTextureAlignment p+ let totalConstMem = cuTotalConstMem p+ sharedMemPerBlock = cuSharedMemPerBlock p+ regsPerBlock = cuRegsPerBlock p+ warpSize = cuWarpSize p+ maxThreadsPerBlock = cuMaxThreadsPerBlock p+ maxBlockSize = cuMaxBlockSize p+ maxGridSize = cuMaxGridSize p+ clockRate = cuClockRate p+ memPitch = cuMemPitch p+ textureAlignment = cuTextureAlignment p #else- cm <- fromIntegral <$> attribute d TotalConstantMemory- sm <- fromIntegral <$> attribute d SharedMemoryPerBlock- mp <- fromIntegral <$> attribute d MaxPitch- ta <- fromIntegral <$> attribute d TextureAlignment- cl <- attribute d ClockRate- ws <- attribute d WarpSize- rb <- attribute d RegistersPerBlock- tb <- attribute d MaxThreadsPerBlock- bs <- (,,) <$> attribute d MaxBlockDimX- <*> attribute d MaxBlockDimY- <*> attribute d MaxBlockDimZ- gs <- (,,) <$> attribute d MaxGridDimX- <*> attribute d MaxGridDimY- <*> attribute d MaxGridDimZ+ totalConstMem <- fromIntegral <$> attribute d TotalConstantMemory+ sharedMemPerBlock <- fromIntegral <$> attribute d SharedMemoryPerBlock+ memPitch <- fromIntegral <$> attribute d MaxPitch+ textureAlignment <- fromIntegral <$> attribute d TextureAlignment+ clockRate <- attribute d ClockRate+ warpSize <- attribute d WarpSize+ regsPerBlock <- attribute d RegistersPerBlock+ maxThreadsPerBlock <- attribute d MaxThreadsPerBlock+ maxBlockSize <- (,,) <$> attribute d MaxBlockDimX <*> attribute d MaxBlockDimY <*> attribute d MaxBlockDimZ+ maxGridSize <- (,,) <$> attribute d MaxGridDimX <*> attribute d MaxGridDimY <*> attribute d MaxGridDimZ #endif -- The rest of the properties. --- n <- name d- cc <- capability d- gm <- totalMem d- pc <- attribute d MultiprocessorCount- md <- toEnum `fmap` attribute d ComputeMode- ov <- toBool `fmap` attribute d GpuOverlap- ke <- toBool `fmap` attribute d KernelExecTimeout- tg <- toBool `fmap` attribute d Integrated- hm <- toBool `fmap` attribute d CanMapHostMemory+ deviceName <- name d+ computeCapability <- capability d+ totalGlobalMem <- totalMem d+ multiProcessorCount <- attribute d MultiprocessorCount+ computeMode <- toEnum <$> attribute d ComputeMode+ deviceOverlap <- toBool <$> attribute d GpuOverlap+ kernelExecTimeoutEnabled <- toBool <$> attribute d KernelExecTimeout+ integrated <- toBool <$> attribute d Integrated+ canMapHostMemory <- toBool <$> attribute d CanMapHostMemory #if CUDA_VERSION >= 3000- ck <- toBool `fmap` attribute d ConcurrentKernels- ee <- toBool `fmap` attribute d EccEnabled- u1 <- attribute d MaximumTexture1dWidth- u21 <- attribute d MaximumTexture2dWidth- u22 <- attribute d MaximumTexture2dHeight- u31 <- attribute d MaximumTexture3dWidth- u32 <- attribute d MaximumTexture3dHeight- u33 <- attribute d MaximumTexture3dDepth+ concurrentKernels <- toBool <$> attribute d ConcurrentKernels+ eccEnabled <- toBool <$> attribute d EccEnabled+ maxTextureDim1D <- attribute d MaximumTexture1dWidth+ maxTextureDim2D <- (,) <$> attribute d MaximumTexture2dWidth <*> attribute d MaximumTexture2dHeight+ maxTextureDim3D <- (,,) <$> attribute d MaximumTexture3dWidth <*> attribute d MaximumTexture3dHeight <*> attribute d MaximumTexture3dDepth #endif #if CUDA_VERSION >= 4000- ae <- attribute d AsyncEngineCount- l2 <- attribute d L2CacheSize- tm <- attribute d MaxThreadsPerMultiprocessor- mw <- attribute d GlobalMemoryBusWidth- mc <- attribute d MemoryClockRate- pb <- attribute d PciBusId- pd <- attribute d PciDeviceId- pm <- attribute d PciDomainId- ua <- toBool `fmap` attribute d UnifiedAddressing- tcc <- toBool `fmap` attribute d TccDriver+ asyncEngineCount <- attribute d AsyncEngineCount+ cacheMemL2 <- attribute d L2CacheSize+ maxThreadsPerMultiProcessor <- attribute d MaxThreadsPerMultiprocessor+ memBusWidth <- attribute d GlobalMemoryBusWidth+ memClockRate <- attribute d MemoryClockRate+ pciInfo <- PCI <$> attribute d PciBusId <*> attribute d PciDeviceId <*> attribute d PciDomainId+ unifiedAddressing <- toBool <$> attribute d UnifiedAddressing+ tccDriverEnabled <- toBool <$> attribute d TccDriver #endif #if CUDA_VERSION >= 5050- sp <- toBool `fmap` attribute d StreamPrioritiesSupported+ streamPriorities <- toBool <$> attribute d StreamPrioritiesSupported #endif #if CUDA_VERSION >= 6000- gl1 <- toBool `fmap` attribute d GlobalL1CacheSupported- ll1 <- toBool `fmap` attribute d LocalL1CacheSupported- mm <- toBool `fmap` attribute d ManagedMemory- mg <- toBool `fmap` attribute d MultiGpuBoard- mid <- attribute d MultiGpuBoardGroupId-#endif-- return DeviceProperties- {- deviceName = n- , computeCapability = cc- , totalGlobalMem = gm- , totalConstMem = cm- , sharedMemPerBlock = sm- , regsPerBlock = rb- , warpSize = ws- , maxThreadsPerBlock = tb- , maxBlockSize = bs- , maxGridSize = gs- , clockRate = cl- , multiProcessorCount = pc- , memPitch = mp- , textureAlignment = ta- , computeMode = md- , deviceOverlap = ov- , kernelExecTimeoutEnabled = ke- , integrated = tg- , canMapHostMemory = hm-#if CUDA_VERSION >= 3000- , concurrentKernels = ck- , eccEnabled = ee- , maxTextureDim1D = u1- , maxTextureDim2D = (u21,u22)- , maxTextureDim3D = (u31,u32,u33)-#endif-#if CUDA_VERSION >= 4000- , asyncEngineCount = ae- , cacheMemL2 = l2- , maxThreadsPerMultiProcessor = tm- , memBusWidth = mw- , memClockRate = mc- , pciInfo = PCI pb pd pm- , tccDriverEnabled = tcc- , unifiedAddressing = ua+ globalL1Cache <- toBool <$> attribute d GlobalL1CacheSupported+ localL1Cache <- toBool <$> attribute d LocalL1CacheSupported+ managedMemory <- toBool <$> attribute d ManagedMemory+ multiGPUBoard <- toBool <$> attribute d MultiGpuBoard+ multiGPUBoardGroupID <- attribute d MultiGpuBoardGroupId #endif-#if CUDA_VERSION >= 5050- , streamPriorities = sp+#if CUDA_VERSION >= 8000+ preemption <- toBool <$> attribute d ComputePreemptionSupported+ singleToDoublePerfRatio <- attribute d SingleToDoublePrecisionPerfRatio #endif-#if CUDA_VERSION >= 6000- , globalL1Cache = gl1- , localL1Cache = ll1- , managedMemory = mm- , multiGPUBoard = mg- , multiGPUBoardGroupID = mid+#if CUDA_VERSION >= 9000+ cooperativeLaunch <- toBool <$> attribute d CooperativeLaunch+ cooperativeLaunchMultiDevice <- toBool <$> attribute d CooperativeMultiDeviceLaunch #endif- } + return DeviceProperties{..}++ #if CUDA_VERSION < 5000 -- Deprecated as of CUDA-5.0 {-# INLINE cuDeviceGetProperties #-}@@ -393,11 +394,9 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1gc6a0d6551335a3780f9f3c967a0fde5d> -- {-# INLINEABLE totalMem #-}-totalMem :: Device -> IO Int64-totalMem !d = resultIfOk =<< cuDeviceTotalMem d--{-# INLINE cuDeviceTotalMem #-}-{# fun unsafe cuDeviceTotalMem+{# fun unsafe cuDeviceTotalMem as totalMem { alloca- `Int64' peekIntConv*- , useDevice `Device' } -> `Status' cToEnum #}+ , useDevice `Device'+ }+ -> `()' checkStatus*- #}
src/Foreign/CUDA/Driver/Error.chs view
@@ -4,7 +4,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Error--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Error handling@@ -17,7 +17,7 @@ Status(..), CUDAException(..), describe, cudaError, cudaErrorIO, requireSDK,- resultIfOk, nothingIfOk,+ resultIfOk, nothingIfOk, checkStatus, ) where @@ -209,4 +209,8 @@ case status of Success -> return () _ -> throwIO (ExitCode status)++{-# INLINE checkStatus #-}+checkStatus :: CInt -> IO ()+checkStatus = nothingIfOk . cToEnum
src/Foreign/CUDA/Driver/Event.chs view
@@ -3,10 +3,13 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase #-}+#endif -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Event--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Event management for low-level driver interface@@ -25,16 +28,46 @@ {# context lib="cuda" #} -- Friends-import Foreign.CUDA.Types import Foreign.CUDA.Internal.C2HS import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Stream ( Stream(..), defaultStream ) -- System import Foreign import Foreign.C import Data.Maybe-import Control.Monad ( liftM )-import Control.Exception ( throwIO )+import Control.Monad ( liftM )+import Control.Exception ( throwIO )+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- Events are markers that can be inserted into the CUDA execution stream and+-- later queried.+--+newtype Event = Event { useEvent :: {# type CUevent #}}+ deriving (Eq, Show)++-- |+-- Event creation flags+--+{# enum CUevent_flags as EventFlag+ { underscoreToCase+ }+ with prefix="CU_EVENT" deriving (Eq, Show, Bounded) #}++-- |+-- Possible option flags for waiting for events+--+data WaitFlag+instance Enum WaitFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("WaitFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif --------------------------------------------------------------------------------
src/Foreign/CUDA/Driver/Exec.chs view
@@ -7,7 +7,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Exec--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Kernel execution control for low-level driver interface@@ -17,7 +17,7 @@ module Foreign.CUDA.Driver.Exec ( -- * Kernel Execution- Fun(Fun), FunParam(..), FunAttribute(..), SharedMem(..),+ Fun(..), FunParam(..), FunAttribute(..), SharedMem(..), requires, setCacheConfigFun, setSharedMemConfigFun,@@ -353,6 +353,7 @@ #endif -- TODO: cuLaunchCooperativeKernelMultiDevice introduced CUDA-9.0+-- TODO: cuLaunchHostFunc introduced CUDA-10.0 -------------------------------------------------------------------------------- -- Deprecated@@ -402,8 +403,8 @@ {-# INLINE cuFuncSetSharedSize #-} {# fun unsafe cuFuncSetSharedSize- { useFun `Fun'- , cIntConv `Integer' } -> `Status' cToEnum #}+ { useFun `Fun'+ , fromInteger `Integer' } -> `Status' cToEnum #} -- |@@ -441,7 +442,7 @@ {# fun unsafe cuParamSetf { useFun `Fun' , `Int'- , `Float' } -> `Status' cToEnum #}+ , CFloat `Float' } -> `Status' cToEnum #} {-# INLINE cuParamSetv #-} {# fun unsafe cuParamSetv
+ src/Foreign/CUDA/Driver/Graph/Base.chs view
@@ -0,0 +1,77 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Base+-- Copyright : [2018] Trevor L. McDonell+-- License : BSD+--+-- Graph execution functions for the low-level driver interface+--+-- Requires CUDA-10+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Graph.Base+ where++#include "cbits/stubs.h"+{# context lib="cuda" #}++import Foreign.Storable+import Foreign.Ptr+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++#if CUDA_VERSION < 10000+data Graph+#else+newtype Graph = Graph { useGraph :: {# type CUgraph #}}+ deriving (Eq, Show)+#endif++data GraphFlag+instance Enum GraphFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("GraphFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++#if CUDA_VERSION < 10000+data Node+data NodeType++instance Enum NodeType where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("NodeType.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif+#else+newtype Node = Node { useNode :: {# type CUgraphNode #}}+ deriving (Eq, Show, Storable)++{# enum CUgraphNodeType as NodeType+ { underscoreToCase+ , CU_GRAPH_NODE_TYPE_GRAPH as Subgraph+ }+ with prefix="CU_GRAPH_NODE_TYPE" deriving (Eq, Show, Bounded) #}+#endif+++#if CUDA_VERSION < 10000+data Executable+#else+newtype Executable = Executable { useExecutable :: {# type CUgraphExec #}}+ deriving (Eq, Show)+#endif+
+ src/Foreign/CUDA/Driver/Graph/Build.chs view
@@ -0,0 +1,689 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Build+-- Copyright : [2018] Trevor L. McDonell+-- License : BSD+--+-- Graph construction functions for the low-level driver interface+--+-- Requires CUDA-10+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Graph.Build (++ Graph(..), Node(..), NodeType(..), HostCallback,+ create, destroy, clone, remove,++ -- ** Construction+ addChild,+ addEmpty,+ addHost,+ addKernel,+ addMemcpy,+ addMemset,+ addDependencies,+ removeDependencies,++ -- ** Querying+ getType,+ getChildGraph,+ getEdges,+ getNodes,+ getRootNodes,+ getDependencies,+ getDependents,+ findInClone,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++import Foreign.CUDA.Driver.Context.Base ( Context(..) )+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Exec ( Fun(..), FunParam(..) )+import Foreign.CUDA.Driver.Graph.Base+import Foreign.CUDA.Driver.Marshal ( useDeviceHandle )+import Foreign.CUDA.Driver.Stream ( Stream(..) )+import Foreign.CUDA.Driver.Unified ( MemoryType(..) )+import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Ptr ( DevicePtr(..) )++import Control.Monad ( liftM )+import Unsafe.Coerce++import Data.Word+import Foreign+import Foreign.C+import Foreign.Storable+++-- | Callback function executed on the host+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TYPES.html#group__CUDA__TYPES_1g262cd3570ff5d396db4e3dabede3c355>+--+-- @since 0.10.0.0+--+#if CUDA_VERSION < 10000+type HostCallback = FunPtr ()+#else+type HostCallback = {# type CUhostFn #}+#endif+++--------------------------------------------------------------------------------+-- Graph creation+--------------------------------------------------------------------------------++-- | Create an empty task graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gd885f719186010727b75c3315f865fdf>+--+-- @since 0.10.0.0+--+{-# INLINEABLE create #-}+#if CUDA_VERSION < 10000+create :: [GraphFlag] -> IO Graph+create = requireSDK 'create 10.0+#else+{# fun unsafe cuGraphCreate as create+ { alloca- `Graph' peekGraph*+ , combineBitMasks `[GraphFlag]'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Destroy a graph, as well as all of its nodes+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g718cfd9681f078693d4be2426fd689c8>+--+-- @since 0.10.0.0+{-# INLINEABLE destroy #-}+#if CUDA_VERSION < 10000+destroy :: Graph -> IO ()+destroy = requireSDK 'destroy 10.0+#else+{# fun unsafe cuGraphDestroy as destroy+ { useGraph `Graph'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Clone a graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g3603974654e463f2231c71d9b9d1517e>+--+-- @since 0.10.0.0+--+{-# INLINEABLE clone #-}+#if CUDA_VERSION < 10000+clone :: Graph -> IO Graph+clone = requireSDK 'clone 10.0+#else+{# fun unsafe cuGraphClone as clone+ { alloca- `Graph' peekGraph*+ , useGraph `Graph'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Remove a node from the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g00ed16434d983d8f0011683eacaf19b9>+--+-- @since 0.10.0.0+--+{-# INLINEABLE remove #-}+#if CUDA_VERSION < 10000+remove :: Node -> IO ()+remove = requireSDK 'remove 10.0+#else+{# fun unsafe cuGraphDestroyNode as remove+ { useNode `Node'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Create a child graph node and add it to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g3f27c2e56e3d568b09f00d438e61ceb1>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addChild #-}+addChild :: Graph -> Graph -> [Node] -> IO Node+#if CUDA_VERSION < 10000+addChild = requireSDK 'addChild 10.0+#else+addChild parent child dependencies = cuGraphAddChildGraphNode parent dependencies child+ where+ {# fun unsafe cuGraphAddChildGraphNode+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ , useGraph `Graph'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Add dependency edges to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g81bf1a6965f881be6ad8d21cfe0ee44f>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addDependencies #-}+addDependencies :: Graph -> [(Node,Node)] -> IO ()+#if CUDA_VERSION < 10000+addDependencies = requireSDK 'addDependencies 10.0+#else+addDependencies !g !deps = cuGraphAddDependencies g from to+ where+ (from, to) = unzip deps++ {# fun unsafe cuGraphAddDependencies+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArrayLen* `[Node]'&+ }+ -> `()' checkStatus*- #}+#endif+++-- | Remove dependency edges from the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g8ab696a6b3ccd99db47feba7e97fb579>+--+-- @since 0.10.0.0+--+{-# INLINE removeDependencies #-}+removeDependencies :: Graph -> [(Node,Node)] -> IO ()+#if CUDA_VERSION < 10000+removeDependencies = requireSDK 'removeDependencies 10.0+#else+removeDependencies !g !deps = cuGraphRemoveDependencies g from to+ where+ (from, to) = unzip deps++ {# fun unsafe cuGraphRemoveDependencies+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArrayLen* `[Node]'&+ }+ -> `()' checkStatus*- #}+#endif+++-- | Create an empty node and add it to the graph.+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g8a8681dbe97dbbb236ea5ebf3abe2ada>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addEmpty #-}+#if CUDA_VERSION < 10000+addEmpty :: Graph -> [Node] -> IO Node+addEmpty = requireSDK 'addEmpty 10.0+#else+{# fun unsafe cuGraphAddEmptyNode as addEmpty+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ }+ -> `()' checkStatus*- #}+#endif+++-- | Creates a host execution node and adds it to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g1ba15c2fe1afb8897091ecec4202b597>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addHost #-}+#if CUDA_VERSION < 10000+addHost :: Graph -> [Node] -> HostCallback -> Ptr () -> IO Node+addHost = requireSDK 'addHost 10.0+#else+{# fun unsafe cuGraphAddHostNode_simple as addHost+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ , id `HostCallback'+ , `Ptr ()'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Create a kernel execution node and adds it to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g886a9096293238937f2f3bc7f2d57635>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addKernel #-}+addKernel+ :: Graph+ -> [Node]+ -> Fun+ -> (Int, Int, Int) -- ^ grid dimension+ -> (Int, Int, Int) -- ^ thread block dimensions+ -> Int -- ^ shared memory (bytes)+ -> [FunParam]+ -> IO Node+#if CUDA_VERSION < 10000+addKernel = requireSDK 'addKernel 10.0+#else+addKernel !g !ns !fun (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !args+ = withMany withFP args+ $ \pa -> withArray pa+ $ \pp -> cuGraphAddKernelNode_simple g ns fun gx gy gz tx ty tz sm pp+ where+ withFP :: FunParam -> (Ptr () -> 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++ {# fun unsafe cuGraphAddKernelNode_simple+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ , useFun `Fun'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , id `Ptr (Ptr ())'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Create a memcpy node and add it to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gdd521e1437c1c3ea8822f66a32ff1f94>+--+-- @since 0.10.0.0+--+#if CUDA_VERSION < 10000+addMemcpy :: Graph -> [Node] -> Context -> Int -> Int -> Int -> Int -> MemoryType -> Ptr a -> Int -> Int -> Int -> Int -> Int -> Int -> MemoryType -> Ptr a -> Int -> Int -> Int -> Int -> Int -> IO Node+addMemcpy = requireSDK 'addMemcpy 10.0+#else+{# fun unsafe cuGraphAddMemcpyNode_simple as addMemcpy+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ , useContext `Context'+ , `Int' -- ^ srcXInBytes+ , `Int' -- ^ srcY+ , `Int' -- ^ srcZ+ , `Int' -- ^ srcLOD+ , cFromEnum `MemoryType' -- ^ source memory type+ , castPtr `Ptr a' -- ^ source ptr+ , `Int' -- ^ srcPitch+ , `Int' -- ^ srcHeight+ , `Int' -- ^ dstXInBytes+ , `Int' -- ^ dstY+ , `Int' -- ^ dstZ+ , `Int' -- ^ dstLOD+ , cFromEnum `MemoryType' -- ^ destination memory type+ , castPtr `Ptr a' -- ^ destination ptr+ , `Int' -- ^ dstPitch+ , `Int' -- ^ dstHeight+ , `Int' -- ^ widthInBytes+ , `Int' -- ^ height+ , `Int' -- ^ depth+ }+ -> `()' checkStatus*- #}+#endif+++-- | Create a memset node and add it to the graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gac7f59961798f14a9f94f9f6b53cc3b7>+--+-- @since 0.10.0.0+--+{-# INLINEABLE addMemset #-}+addMemset+ :: Storable a+ => Graph+ -> [Node]+ -> Context+ -> DevicePtr a+ -> a+ -> Int -- ^ height+ -> Int -- ^ pitch+ -> Int -- ^ width+ -> IO Node+#if CUDA_VERSION < 10000+addMemset = requireSDK 'addMemset 10.0+#else+addMemset !g !ns !ctx !dptr !val !h !p !w =+ cuGraphAddMemsetNode_simple g ns ctx dptr bytes h p val' w+ where+ bytes = sizeOf val++ val' :: Word32+ val' = case bytes of+ 1 -> fromIntegral (unsafeCoerce val :: Word8)+ 2 -> fromIntegral (unsafeCoerce val :: Word16)+ 4 -> fromIntegral (unsafeCoerce val :: Word32)+ _ -> cudaError "can only memset 8-, 16-, and 32-bit values"++ {# fun unsafe cuGraphAddMemsetNode_simple+ { alloca- `Node' peekNode*+ , useGraph `Graph'+ , withNodeArrayLen* `[Node]'&+ , useContext `Context'+ , useDeviceHandle `DevicePtr a'+ , `Int'+ , `Int'+ , `Int'+ , `Word32'+ , `Int'+ }+ -> `()' checkStatus*- #}+#endif+++--------------------------------------------------------------------------------+-- Query+--------------------------------------------------------------------------------++-- | Return the type of a node+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gdb1776d97aa1c9d5144774b29e4b8c3e>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getType #-}+#if CUDA_VERSION < 10000+getType :: Node -> IO NodeType+getType = requireSDK 'getType 10.0+#else+{# fun unsafe cuGraphNodeGetType as getType+ { useNode `Node'+ , alloca- `NodeType' peekEnum*+ }+ -> `()' checkStatus*- #}+#endif+++-- | Retrieve the embedded graph of a child sub-graph node+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gbe9fc9267316b3778ef0db507917b4fd>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getChildGraph #-}+#if CUDA_VERSION < 10000+getChildGraph :: Node -> IO Graph+getChildGraph = requireSDK 'getChildGraph 10.0+#else+{# fun unsafe cuGraphChildGraphNodeGetGraph as getChildGraph+ { useNode `Node'+ , alloca- `Graph' peekGraph*+ }+ -> `()' checkStatus*- #}+#endif+++-- | Return a graph's dependency edges+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g2b7bd71b0b2b8521f141996e0975a0d7>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getEdges #-}+getEdges :: Graph -> IO [(Node, Node)]+#if CUDA_VERSION < 10000+getEdges = requireSDK 'getEdges 10.0+#else+getEdges !g =+ alloca $ \p_count -> do+ cuGraphGetEdges g nullPtr nullPtr p_count+ count <- peekIntConv p_count+ allocaArray count $ \p_from -> do+ allocaArray count $ \p_to -> do+ cuGraphGetEdges g p_from p_to p_count+ from <- peekArray count p_from+ to <- peekArray count p_to+ return $ zip from to+ where+ {# fun unsafe cuGraphGetEdges+ { useGraph `Graph'+ , castPtr `Ptr Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Return a graph's nodes+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gfa35a8e2d2fc32f48dbd67ba27cf27e5>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getNodes #-}+getNodes :: Graph -> IO [Node]+#if CUDA_VERSION < 10000+getNodes = requireSDK 'getNodes 10.0+#else+getNodes !g =+ alloca $ \p_count -> do+ cuGraphGetNodes g nullPtr p_count+ count <- peekIntConv p_count+ allocaArray count $ \p_nodes -> do+ cuGraphGetNodes g p_nodes p_count+ peekArray count p_nodes+ where+ {# fun unsafe cuGraphGetNodes+ { useGraph `Graph'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Returns the root nodes of a graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gf8517646bd8b39ab6359f8e7f0edffbd>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getRootNodes #-}+getRootNodes :: Graph -> IO [Node]+#if CUDA_VERSION < 10000+getRootNodes = requireSDK 'getRootNodes 10.0+#else+getRootNodes g =+ alloca $ \p_count -> do+ cuGraphGetRootNodes g nullPtr p_count+ count <- peekIntConv p_count+ allocaArray count $ \p_nodes -> do+ cuGraphGetRootNodes g p_nodes p_count+ peekArray count p_nodes+ where+ {# fun unsafe cuGraphGetRootNodes+ { useGraph `Graph'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Return the dependencies of a node+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g048f4c0babcbba64a933fc277cd45083>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getDependencies #-}+getDependencies :: Node -> IO [Node]+#if CUDA_VERSION < 10000+getDependencies = requireSDK 'getDependencies 10.0+#else+getDependencies !n =+ alloca $ \p_count -> do+ cuGraphNodeGetDependencies n nullPtr p_count+ count <- peekIntConv p_count+ allocaArray count $ \p_deps -> do+ cuGraphNodeGetDependencies n p_deps p_count+ peekArray count p_deps+ where+ {# fun unsafe cuGraphNodeGetDependencies+ { useNode `Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Return a node's dependent nodes+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g4b73d9e3b386a9c0b094a452b8431f59>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getDependents #-}+getDependents :: Node -> IO [Node]+#if CUDA_VERSION < 10000+getDependents = requireSDK 'getDependents 10.0+#else+getDependents n =+ alloca $ \p_count -> do+ cuGraphNodeGetDependentNodes n nullPtr p_count+ count <- peekIntConv p_count+ allocaArray count $ \p_deps -> do+ cuGraphNodeGetDependentNodes n p_deps p_count+ peekArray count p_deps+ where+ {# fun unsafe cuGraphNodeGetDependentNodes+ { useNode `Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Find a cloned version of a node+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gf21f6c968e346f028737c1118bfd41c2>+--+-- @since 0.10.0.0+--+{-# INLINEABLE findInClone #-}+#if CUDA_VERSION < 10000+findInClone :: Node -> Graph -> IO Node+findInClone = requireSDK 'findInClone 10+#else+{# fun unsafe cuGraphNodeFindInClone as findInClone+ { alloca- `Node' peekNode*+ , useNode `Node'+ , useGraph `Graph'+ }+ -> `()' checkStatus*- #}+#endif+++-- TODO: since CUDA-10.0+-- * cuGraphHostNode[Get/Set]Params+-- * cuGraphKernelNode[Get/Set]Params+-- * cuGraphMemcpyNode[Get/Set]Params+-- * cuGraphMemsetNode[Get/Set]Params++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++#if CUDA_VERSION >= 10000+{-# INLINE peekGraph #-}+peekGraph :: Ptr {# type CUgraph #} -> IO Graph+peekGraph = liftM Graph . peek++{-# INLINE peekNode #-}+peekNode :: Ptr {# type CUgraphNode #} -> IO Node+peekNode = liftM Node . peek++{-# INLINE withNodeArray #-}+withNodeArray :: [Node] -> (Ptr {# type CUgraphNode #} -> IO a) -> IO a+withNodeArray ns f = withArray ns (f . castPtr)++{-# INLINE withNodeArrayLen #-}+withNodeArrayLen :: [Node] -> ((Ptr {# type CUgraphNode #}, CULong) -> IO a) -> IO a+withNodeArrayLen ns f = withArrayLen ns $ \i p -> f (castPtr p, cIntConv i)+#endif+
+ src/Foreign/CUDA/Driver/Graph/Capture.chs view
@@ -0,0 +1,128 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Capture+-- Copyright : [2018] Trevor L. McDonell+-- License : BSD+--+-- Requires CUDA-10+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Graph.Capture (++ Status(..),+ start, stop, status,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++import Foreign.CUDA.Driver.Error hiding ( Status )+import Foreign.CUDA.Driver.Graph.Base+import Foreign.CUDA.Driver.Stream+import Foreign.CUDA.Internal.C2HS++import Control.Monad ( liftM )++import Foreign+import Foreign.C+++#if CUDA_VERSION < 10000+data Status++instance Enum Status where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("Status.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++#else+{# enum CUstreamCaptureStatus as Status+ { underscoreToCase }+ with prefix="CU_STREAM_CAPTURE_STATUS" deriving (Eq, Show, Bounded) #}+#endif+++--------------------------------------------------------------------------------+-- Graph capture+--------------------------------------------------------------------------------++-- | Begin graph capture on a stream+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1gea22d4496b1c8d02d0607bb05743532f>+--+-- @since 0.10.0.0+--+#if CUDA_VERSION < 10000+start :: Stream -> IO ()+start = requireSDK 'start 10.0+#else+{# fun unsafe cuStreamBeginCapture as start+ { useStream `Stream'+ }+ -> `()' checkStatus*- #}+#endif+++-- | End graph capture on a stream+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g03dab8b2ba76b00718955177a929970c>+--+-- @since 0.10.0.0+--+#if CUDA_VERSION < 10000+stop :: Stream -> IO Graph+stop = requireSDK 'stop 10.0+#else+{# fun unsafe cuStreamEndCapture as stop+ { useStream `Stream'+ , alloca- `Graph' peekGraph*+ }+ -> `()' checkStatus*- #}+#endif+++-- | Return a stream's capture status+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g37823c49206e3704ae23c7ad78560bca>+--+-- @since 0.10.0.0+--+#if CUDA_VERSION < 10000+status :: Stream -> IO Status+status = requireSDK 'status 10.0+#else+{# fun unsafe cuStreamIsCapturing as status+ { useStream `Stream'+ , alloca- `Status' peekEnum*+ }+ -> `()' checkStatus*- #}+#endif+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++#if CUDA_VERSION >= 10000+{-# INLINE peekGraph #-}+peekGraph :: Ptr {# type CUgraph #} -> IO Graph+peekGraph = liftM Graph . peek+#endif+
+ src/Foreign/CUDA/Driver/Graph/Exec.chs view
@@ -0,0 +1,132 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Exec+-- Copyright : [2018] Trevor L. McDonell+-- License : BSD+--+-- Graph execution functions for the low-level driver interface+--+-- Requires CUDA-10+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Graph.Exec (++ Executable(..),++ -- ** Execution+ launch,+ instantiate,+ destroy,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Graph.Base+import Foreign.CUDA.Driver.Stream ( Stream(..) )+import Foreign.CUDA.Internal.C2HS++import Foreign+import Foreign.C++import Control.Monad ( liftM )+import Data.ByteString.Char8 ( ByteString )+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Internal as B+++--------------------------------------------------------------------------------+-- Graph execution+--------------------------------------------------------------------------------++-- | Execute a graph in the given stream. Only one instance may execute at+-- a time; to execute a graph concurrently, it must be 'instantiate'd into+-- multiple executables.+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g6b2dceb3901e71a390d2bd8b0491e471>+--+-- @since 0.10.0.0+--+{-# INLINEABLE launch #-}+#if CUDA_VERSION < 10000+launch :: Executable -> Stream -> IO ()+launch _ _ = requireSDK 'launch 10.0+#else+{# fun unsafe cuGraphLaunch as launch+ { useExecutable `Executable'+ , useStream `Stream'+ }+ -> `()' checkStatus*- #}+#endif+++-- | Instantiate the task graph description of a program into an executable+-- graph.+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1g433ae118a751c9f2087f53d7add7bc2c>+--+-- @since 0.10.0.0+--+{-# INLINEABLE instantiate #-}+instantiate :: Graph -> IO Executable+#if CUDA_VERSION < 10000+instantiate _ = requireSDK 'instantiate 10.0+#else+instantiate !g = do+ let logSize = 2048+ allocaArray logSize $ \p_elog -> do+ (s, e, n) <- cuGraphInstantiate g p_elog logSize+ --+ case s of+ Success -> return e+ _ -> do+ errLog <- peekCStringLen (p_elog, logSize)+ cudaErrorIO (unlines [describe s, "phErrorNode = " ++ show n, errLog])++{-# INLINE cuGraphInstantiate #-}+{# fun unsafe cuGraphInstantiate+ { alloca- `Executable' peekExecutable*+ , useGraph `Graph'+ , alloca- `Maybe Node' peekErrNode*+ , castPtr `CString'+ , `Int'+ }+ -> `Status' cToEnum #}+ where+ peekExecutable = liftM Executable . peek+ peekErrNode p = if p == nullPtr+ then return Nothing+ else liftM (Just . Node) (peek p)+#endif+++-- | Destroy an executable graph+--+-- Requires CUDA-10.0+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1ga32ad4944cc5d408158207c978bc43a7>+--+-- @since 0.10.0.0+--+{-# INLINEABLE destroy #-}+#if CUDA_VERSION < 10000+destroy :: Executable -> IO ()+destroy _ = requireSDK 'destroy 10.0+#else+{# fun unsafe cuGraphExecDestroy as destroy+ { useExecutable `Executable'+ }+ -> `()' checkStatus*- #}+#endif+
src/Foreign/CUDA/Driver/IPC/Event.chs view
@@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.IPC.Event--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- IPC event management for low-level driver interface.
src/Foreign/CUDA/Driver/IPC/Marshal.chs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.IPC.Marshal--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- IPC memory management for low-level driver interface.
src/Foreign/CUDA/Driver/Marshal.chs view
@@ -2,12 +2,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK prune #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Marshal--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Memory management for low-level driver interface@@ -28,6 +30,7 @@ AttachFlag(..), mallocManagedArray, prefetchArrayAsync,+ attachArrayAsync, -- * Marshalling peekArray, peekArrayAsync, peekArray2D, peekArray2DAsync, peekListArray,@@ -74,6 +77,10 @@ import Foreign.Storable import qualified Foreign.Marshal as F +import GHC.Ptr+import GHC.Word+import GHC.Base+ #c typedef enum CUmemhostalloc_option_enum { CU_MEMHOSTALLOC_OPTION_PORTABLE = CU_MEMHOSTALLOC_PORTABLE,@@ -354,13 +361,32 @@ {# fun unsafe cuMemPrefetchAsync { useDeviceHandle `DevicePtr a' , `Int'- , `CInt'+ , id `CInt' , useStream `Stream' } -> `Status' cToEnum #} #endif +-- | Attach an array of the given number of elements to a stream asynchronously+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g6e468d680e263e7eba02a56643c50533>+--+-- @since 0.10.0.0+--+{-# INLINEABLE attachArrayAsync #-}+attachArrayAsync :: forall a. Storable a => [AttachFlag] -> Stream -> DevicePtr a -> Int -> IO ()+attachArrayAsync !flags !stream !ptr !n = cuStreamAttachMemAsync stream ptr (n * sizeOf (undefined::a)) flags+ where+ {# fun unsafe cuStreamAttachMemAsync+ { useStream `Stream'+ , useDeviceHandle `DevicePtr a'+ , `Int'+ , combineBitMasks `[AttachFlag]'+ }+ -> `()' checkStatus*- #}++ -------------------------------------------------------------------------------- -- Marshalling --------------------------------------------------------------------------------@@ -990,7 +1016,7 @@ 1 -> nothingIfOk =<< cuMemsetD8 dptr val n 2 -> nothingIfOk =<< cuMemsetD16 dptr val n 4 -> nothingIfOk =<< cuMemsetD32 dptr val n- _ -> cudaError "can only memset 8-, 16-, and 32-bit values"+ _ -> cudaErrorIO "can only memset 8-, 16-, and 32-bit values" -- -- We use unsafe coerce below to reinterpret the bits of the value to memset as,@@ -1037,7 +1063,7 @@ 1 -> nothingIfOk =<< cuMemsetD8Async dptr val n stream 2 -> nothingIfOk =<< cuMemsetD16Async dptr val n stream 4 -> nothingIfOk =<< cuMemsetD32Async dptr val n stream- _ -> cudaError "can only memset 8-, 16-, and 32-bit values"+ _ -> cudaErrorIO "can only memset 8-, 16-, and 32-bit values" where stream = fromMaybe defaultStream mst @@ -1138,11 +1164,14 @@ -- {-# INLINE peekDeviceHandle #-} peekDeviceHandle :: Ptr DeviceHandle -> IO (DevicePtr a)-peekDeviceHandle !p = DevicePtr . intPtrToPtr . fromIntegral <$> peek p+peekDeviceHandle !p = do+ CULLong (W64# w#) <- peek p+ return $! DevicePtr (Ptr (int2Addr# (word2Int# w#))) -- Use a device pointer as an opaque handle type -- {-# INLINE useDeviceHandle #-} useDeviceHandle :: DevicePtr a -> DeviceHandle-useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+useDeviceHandle (DevicePtr (Ptr addr#)) =+ CULLong (W64# (int2Word# (addr2Int# addr#)))
src/Foreign/CUDA/Driver/Module.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Module management for low-level driver interface
src/Foreign/CUDA/Driver/Module/Base.chs view
@@ -7,7 +7,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module.Base--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Module loading for low-level driver interface@@ -39,6 +39,7 @@ import Foreign.CUDA.Analysis.Device import Foreign.CUDA.Driver.Error import Foreign.CUDA.Internal.C2HS+import Foreign.C.Extra -- System import Foreign@@ -223,7 +224,7 @@ _ -> do errLog <- peekCString p_elog- cudaError (unlines [describe s, errLog])+ cudaErrorIO (unlines [describe s, errLog]) {-# INLINE cuModuleLoadDataEx #-}@@ -278,47 +279,5 @@ {-# 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-jitTargetOfCompute (Compute 3 0) = Compute30-jitTargetOfCompute (Compute 3 5) = Compute35-#endif-#if CUDA_VERSION >= 6000-jitTargetOfCompute (Compute 3 2) = Compute32-jitTargetOfCompute (Compute 5 0) = Compute50-#endif-#if CUDA_VERSION >= 6050-jitTargetOfCompute (Compute 3 7) = Compute37-#endif-#if CUDA_VERSION >= 7000-jitTargetOfCompute (Compute 5 2) = Compute52-#endif-jitTargetOfCompute compute = error ("Unknown JIT Target for Compute " ++ show compute)---#if defined(WIN32)-{-# INLINE c_strnlen' #-}-c_strnlen' :: CString -> CSize -> IO CSize-c_strnlen' str size = do- str' <- peekCStringLen (str, fromIntegral size)- return $ stringLen 0 str'- where- stringLen acc [] = acc- stringLen acc ('\0':_) = acc- stringLen acc (_:xs) = stringLen (acc+1) xs-#else-foreign import ccall unsafe "string.h strnlen" c_strnlen'- :: CString -> CSize -> IO CSize-#endif--{-# INLINE c_strnlen #-}-c_strnlen :: CString -> Int -> IO Int-c_strnlen str maxlen = cIntConv `fmap` c_strnlen' str (cIntConv maxlen)+jitTargetOfCompute (Compute x y) = toEnum (10*x + y)
src/Foreign/CUDA/Driver/Module/Link.chs view
@@ -2,11 +2,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module.Link--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Module linking for low-level driver interface@@ -40,6 +41,7 @@ import Foreign.C import Unsafe.Coerce +import GHC.Ptr import Data.ByteString.Char8 ( ByteString ) import qualified Data.ByteString.Char8 as B @@ -203,10 +205,11 @@ #else addDataFromPtr !ls !n !img !t !options = let (opt,val) = unzip $ map jitOptionUnpack options+ name = Ptr "<unknown>"# in withArrayLen (map cFromEnum opt) $ \i p_opts -> withArray (map unsafeCoerce val) $ \ p_vals ->- nothingIfOk =<< cuLinkAddData ls t img n "<unknown>" i p_opts p_vals+ nothingIfOk =<< cuLinkAddData ls t img n name i p_opts p_vals {-# INLINE cuLinkAddData #-} {# fun unsafe cuLinkAddData@@ -214,7 +217,7 @@ , cFromEnum `JITInputType' , castPtr `Ptr Word8' , `Int'- , `String'+ , id `Ptr CChar' , `Int' , id `Ptr CInt' , id `Ptr (Ptr ())'
src/Foreign/CUDA/Driver/Module/Query.chs view
@@ -1,9 +1,11 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module.Query--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Querying module attributes for low-level driver interface@@ -34,8 +36,16 @@ import Foreign.C import Control.Exception ( throwIO ) import Control.Monad ( liftM )+import Data.ByteString.Short ( ShortByteString )+import qualified Data.ByteString.Short as BS+import qualified Data.ByteString.Short.Internal as BI+import qualified Data.ByteString.Internal as BI+import Prelude as P +import GHC.Exts+import GHC.Base ( IO(..) ) + -------------------------------------------------------------------------------- -- Querying module attributes --------------------------------------------------------------------------------@@ -46,15 +56,18 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1ga52be009b0d4045811b30c965e1cb2cf> -- {-# INLINEABLE getFun #-}-getFun :: Module -> String -> IO Fun+getFun :: Module -> ShortByteString -> IO Fun getFun !mdl !fn = resultIfFound "function" fn =<< cuModuleGetFunction mdl fn {-# INLINE cuModuleGetFunction #-} {# fun unsafe cuModuleGetFunction- { alloca- `Fun' peekFun*- , useModule `Module'- , withCString* `String' } -> `Status' cToEnum #}- where peekFun = liftM Fun . peek+ { alloca- `Fun' peekFun*+ , useModule `Module'+ , useAsCString* `ShortByteString'+ }+ -> `Status' cToEnum #}+ where+ peekFun = liftM Fun . peek -- |@@ -63,17 +76,19 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1gf3e43672e26073b1081476dbf47a86ab> -- {-# INLINEABLE getPtr #-}-getPtr :: Module -> String -> IO (DevicePtr a, Int)+getPtr :: Module -> ShortByteString -> IO (DevicePtr a, Int) getPtr !mdl !name = do (!status,!dptr,!bytes) <- cuModuleGetGlobal mdl name resultIfFound "global" name (status,(dptr,bytes)) {-# INLINE cuModuleGetGlobal #-} {# fun unsafe cuModuleGetGlobal- { alloca- `DevicePtr a' peekDeviceHandle*- , alloca- `Int' peekIntConv*- , useModule `Module'- , withCString* `String' } -> `Status' cToEnum #}+ { alloca- `DevicePtr a' peekDeviceHandle*+ , alloca- `Int' peekIntConv*+ , useModule `Module'+ , useAsCString* `ShortByteString'+ }+ -> `Status' cToEnum #} -- |@@ -84,14 +99,16 @@ -- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9607dcbf911c16420d5264273f2b5608> -- {-# INLINEABLE getTex #-}-getTex :: Module -> String -> IO Texture+getTex :: Module -> ShortByteString -> IO Texture getTex !mdl !name = resultIfFound "texture" name =<< cuModuleGetTexRef mdl name {-# INLINE cuModuleGetTexRef #-} {# fun unsafe cuModuleGetTexRef- { alloca- `Texture' peekTex*- , useModule `Module'- , withCString* `String' } -> `Status' cToEnum #}+ { alloca- `Texture' peekTex*+ , useModule `Module'+ , useAsCString* `ShortByteString'+ }+ -> `Status' cToEnum #} --------------------------------------------------------------------------------@@ -99,10 +116,38 @@ -------------------------------------------------------------------------------- {-# INLINE resultIfFound #-}-resultIfFound :: String -> String -> (Status, a) -> IO a+resultIfFound :: String -> ShortByteString -> (Status, a) -> IO a resultIfFound kind name (!status,!result) = case status of Success -> return result- NotFound -> cudaError (kind ++ ' ' : describe status ++ ": " ++ name)+ NotFound -> cudaErrorIO (kind ++ ' ' : describe status ++ ": " ++ unpack name) _ -> throwIO (ExitCode status)+++-- Utilities+-- ---------++-- [Short]ByteStrings are not null-terminated, so can't be passed directly to C.+--+-- unsafeUseAsCString :: ShortByteString -> CString+-- unsafeUseAsCString (BI.SBS ba#) = Ptr (byteArrayContents# ba#)++{-# INLINE useAsCString #-}+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a+useAsCString (BI.SBS ba#) action = IO $ \s0 ->+ case sizeofByteArray# ba# of { n# ->+ case newPinnedByteArray# (n# +# 1#) s0 of { (# s1, mba# #) ->+ case byteArrayContents# (unsafeCoerce# mba#) of { addr# ->+ case copyByteArrayToAddr# ba# 0# addr# n# s1 of { s2 ->+ case writeWord8OffAddr# addr# n# 0## s2 of { s3 ->+ case action (Ptr addr#) of { IO action' ->+ case action' s3 of { (# s4, r #) ->+ case touch# mba# s4 of { s5 ->+ (# s5, r #)+ }}}}}}}}+++{-# INLINE unpack #-}+unpack :: ShortByteString -> [Char]+unpack = P.map BI.w2c . BS.unpack
src/Foreign/CUDA/Driver/Profiler.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Profiler--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Profiler control for low-level driver interface
src/Foreign/CUDA/Driver/Stream.chs view
@@ -1,11 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase #-}+#endif -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Stream--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Stream management for low-level driver interface@@ -15,11 +19,16 @@ module Foreign.CUDA.Driver.Stream ( -- * Stream Management- Stream(..), StreamFlag(..), StreamWriteFlag(..), StreamWaitFlag(..),- create, createWithPriority, destroy, finished, block, getPriority,+ Stream(..), StreamPriority, StreamCallback,+ StreamFlag(..), StreamWriteFlag(..), StreamWaitFlag(..), StreamCallbackFlag,++ create, createWithPriority, destroy, finished, block, callback,+ getFlags, getPriority, getContext, write, wait, defaultStream,+ defaultStreamLegacy,+ defaultStreamPerThread, ) where @@ -28,19 +37,101 @@ -- Friends import Foreign.CUDA.Ptr-import Foreign.CUDA.Types import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Context.Base ( Context(..) ) import Foreign.CUDA.Internal.C2HS -- System-import Control.Exception ( throwIO )-import Control.Monad ( liftM )+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 + --------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A processing stream. All operations in a stream are synchronous and executed+-- in sequence, but operations in different non-default streams may happen+-- out-of-order or concurrently with one another.+--+-- Use 'Event's to synchronise operations between streams.+--+newtype Stream = Stream { useStream :: {# type CUstream #}}+ deriving (Eq, Show)++-- |+-- Priority of an execution stream. Work submitted to a higher priority+-- stream may preempt execution of work already executing in a lower+-- priority stream. Lower numbers represent higher priorities.+--+type StreamPriority = Int++-- |+-- Execution stream creation flags+--+#if CUDA_VERSION < 8000+data StreamFlag+data StreamWriteFlag+data StreamWaitFlag++instance Enum StreamFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("StreamFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++instance Enum StreamWriteFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("StreamWriteFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++instance Enum StreamWaitFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("StreamWaitFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++#else+{# enum CUstream_flags as StreamFlag+ { underscoreToCase }+ with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #}++{# enum CUstreamWriteValue_flags as StreamWriteFlag+ { underscoreToCase }+ with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #}++{# enum CUstreamWaitValue_flags as StreamWaitFlag+ { underscoreToCase }+ with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #}+#endif+++-- | A 'Stream' callback function+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TYPES.html#group__CUDA__TYPES_1ge5743a8c48527f1040107a68205c5ba9>+--+-- @since 0.10.0.0+--+type StreamCallback = {# type CUstreamCallback #}++data StreamCallbackFlag+instance Enum StreamCallbackFlag where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("StreamCallbackFlag.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif+++-------------------------------------------------------------------------------- -- Stream management -------------------------------------------------------------------------------- @@ -88,7 +179,7 @@ {# fun unsafe cuStreamCreateWithPriority { alloca- `Stream' peekStream* , combineBitMasks `[StreamFlag]'- , cIntConv `StreamPriority'+ , fromIntegral `StreamPriority' } -> `Status' cToEnum #} where@@ -169,17 +260,48 @@ #endif +-- | Query the flags of a given stream+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g4d39786855a6bed01215c1907fbbfbb7>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getFlags #-}+{# fun unsafe cuStreamGetFlags as getFlags+ { useStream `Stream'+ , alloca- `[StreamFlag]' extract*+ }+ -> `()' checkStatus*- #}+ where #if CUDA_VERSION < 8000-data StreamWriteFlag-data StreamWaitFlag+ extract _ = return [] #else-{# enum CUstreamWriteValue_flags as StreamWriteFlag- { underscoreToCase }- with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #}+ extract p = extractBitMasks `fmap` peek p+#endif -{# enum CUstreamWaitValue_flags as StreamWaitFlag- { underscoreToCase }- with prefix="CU_STREAM" deriving (Eq, Show, Bounded) #}++-- |+-- Query the context associated with a stream+--+-- Requires CUDA-9.2.+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g5bd5cb26915a2ecf1921807339488484>+--+-- @since 0.10.0.0+--+{-# INLINEABLE getContext #-}+getContext :: Stream -> IO Context+#if CUDA_VERSION < 9020+getContext _ = requireSDK 'getContext 9.2+#else+getContext !st = resultIfOk =<< cuStreamGetCtx st++{-# INLINE cuStreamGetCtx #-}+{# fun unsafe cuStreamGetCtx+ { useStream `Stream'+ , alloca- `Context' peekCtx* } -> `Status' cToEnum #}+ where+ peekCtx = liftM Context . peek #endif @@ -201,7 +323,7 @@ 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"+ _ -> cudaErrorIO "Stream.write: can only write 32- and 64-bit values" {-# INLINE write32 #-} write32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWriteFlag] -> IO ()@@ -218,8 +340,6 @@ , combineBitMasks `[StreamWriteFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr #endif {-# INLINE write64 #-}@@ -237,8 +357,6 @@ , combineBitMasks `[StreamWriteFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr #endif @@ -259,7 +377,7 @@ 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"+ _ -> cudaErrorIO "Stream.wait: can only wait on 32- and 64-bit values" {-# INLINE wait32 #-} wait32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWaitFlag] -> IO ()@@ -275,8 +393,6 @@ , `Word32' , combineBitMasks `[StreamWaitFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr #endif {-# INLINE wait64 #-}@@ -293,7 +409,70 @@ , `Word64' , combineBitMasks `[StreamWaitFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr #endif+++-- | Add a callback to a compute stream. This function will be executed on the+-- host after all currently queued items in the stream have completed.+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g613d97a277d7640f4cb1c03bd51c2483>+--+-- @since 0.10.0.0+--+{-# INLINEABLE callback #-}+{# fun unsafe cuStreamAddCallback as callback+ { useStream `Stream'+ , id `StreamCallback'+ , id `Ptr ()'+ , combineBitMasks `[StreamCallbackFlag]'+ } -> `()' checkStatus*- #}+++-- | The default execution stream. This can be configured to have either+-- 'defaultStreamLegacy' or 'defaultStreamPerThread' synchronisation behaviour.+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>+--+{-# INLINE defaultStream #-}+defaultStream :: Stream+defaultStream = Stream (Ptr (int2Addr# 0#))+++-- | The legacy default stream is an implicit stream which synchronises with all+-- other streams in the same 'Context', except for non-blocking streams.+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>+--+-- @since 0.10.0.0+--+{-# INLINE defaultStreamLegacy #-}+defaultStreamLegacy :: Stream+defaultStreamLegacy = Stream (Ptr (int2Addr# 0x1#))+++-- | The per-thread default stream is an implicit stream local to both the+-- thread and the calling 'Context', and which does not synchronise with other+-- streams (just like explicitly created streams). The per-thread default stream+-- is not a non-blocking stream and will synchronise with the legacy default+-- stream if both are used in the same program.+--+-- <file:///Developer/NVIDIA/CUDA-9.2/doc/html/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>+--+-- @since 0.10.0.0+--+{-# INLINE defaultStreamPerThread #-}+defaultStreamPerThread :: Stream+defaultStreamPerThread = Stream (Ptr (int2Addr# 0x2#))+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++-- Use a device pointer as an opaque handle type+--+{-# INLINE useDeviceHandle #-}+useDeviceHandle :: DevicePtr a -> {# type CUdeviceptr #}+useDeviceHandle (DevicePtr (Ptr addr#)) =+ CULLong (W64# (int2Word# (addr2Int# addr#)))
src/Foreign/CUDA/Driver/Texture.chs view
@@ -4,7 +4,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Texture--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Texture management for low-level driver interface
src/Foreign/CUDA/Driver/Unified.chs view
@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Unified--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2018] Trevor L. McDonell -- License : BSD -- -- Unified addressing functions for the low-level driver interface@@ -101,7 +101,7 @@ import Foreign.CUDA.Driver.Error import Foreign.CUDA.Driver.Marshal import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Types+import Foreign.CUDA.Ptr -- System import Control.Applicative
src/Foreign/CUDA/Driver/Utils.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Utils--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Utility functions
src/Foreign/CUDA/Internal/C2HS.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- C->Haskell Compiler: Marshalling library -- -- Copyright (c) [1999...2005] Manuel M T Chakravarty@@ -56,7 +58,11 @@ import Foreign.C import Control.Monad ( liftM ) +import GHC.Int+import GHC.Word+import GHC.Base + -- Composite marshalling functions -- ------------------------------- @@ -189,19 +195,40 @@ cIntConv :: (Integral a, Integral b) => a -> b cIntConv = fromIntegral +-- This is enough to fix the missing specialisation for mallocArray, but perhaps+-- we should implement a more general solution which avoids the use of+-- fromIntegral entirely (in particular, without relying on orphan instances).+--+{-# RULES+ "fromIntegral/Int->CInt" fromIntegral = \(I# i#) -> CInt (I32# (narrow32Int# i#)) ;+ "fromIntegral/Int->CLLong" fromIntegral = \(I# i#) -> CLLong (I64# i#) ;+ #-}+{-# RULES+ "fromIntegral/Int->CUInt" fromIntegral = \(I# i#) -> CUInt (W32# (narrow32Word# (int2Word# i#))) ;+ "fromIntegral/Int->CULLong" fromIntegral = \(I# i#) -> CULLong (W64# (int2Word# i#)) ;+ #-}++ -- The C 'long' type might be 32- or 64-bits wide+ --+ -- "fromIntegral/Int->CLong" fromIntegral = \(I# i#) -> CLong (I64# i#) ;+ -- "fromIntegral/Int->CULong" fromIntegral = \(I# i#) -> CULong (W64# (int2Word# i#)) ;+ -- |Floating conversion -- {-# INLINE [1] cFloatConv #-} cFloatConv :: (RealFloat a, RealFloat b) => a -> b cFloatConv = realToFrac+ -- As this conversion by default goes via `Rational', it can be very slow... {-# RULES- "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;- "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x;- "cFloatConv/Float->CFloat" forall (x::Float). cFloatConv x = CFloat x;- "cFloatConv/CFloat->Float" forall (x::Float). cFloatConv CFloat x = x;- "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x;- "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x+ "realToFrac/Float->Float" realToFrac = \(x::Float) -> x ;+ "realToFrac/Float->CFloat" realToFrac = \(x::Float) -> CFloat x ;+ "realToFrac/CFloat->Float" realToFrac = \(CFloat x) -> x ;+ #-}+{-# RULES+ "realToFrac/Double->Double" realToFrac = \(x::Double) -> x;+ "realToFrac/Double->CDouble" realToFrac = \(x::Double) -> CDouble x ;+ "realToFrac/CDouble->Double" realToFrac = \(CDouble x) -> x ; #-} -- |Obtain C value from Haskell 'Bool'.
src/Foreign/CUDA/Path.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Path--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2018] Trevor L. McDonell -- License : BSD -- --------------------------------------------------------------------------------
src/Foreign/CUDA/Ptr.hs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Ptr--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Data pointers on the host and device. These can be shared freely between the@@ -36,10 +36,6 @@ ) where --- friends-import Foreign.CUDA.Types---- system import Foreign.Ptr import Foreign.Storable @@ -49,6 +45,22 @@ -------------------------------------------------------------------------------- -- |+-- A reference to data stored on the device.+--+newtype DevicePtr a = DevicePtr { useDevicePtr :: Ptr a }+ deriving (Eq,Ord)++instance Show (DevicePtr a) where+ showsPrec n (DevicePtr p) = showsPrec n p++instance Storable (DevicePtr a) where+ sizeOf _ = sizeOf (undefined :: Ptr a)+ alignment _ = alignment (undefined :: Ptr a)+ peek p = DevicePtr `fmap` peek (castPtr p)+ poke p v = poke (castPtr p) (useDevicePtr v)+++-- | -- Look at the contents of device memory. This takes an IO action that will be -- applied to that pointer, the result of which is returned. It would be silly -- to return the pointer from the action.@@ -125,6 +137,32 @@ -------------------------------------------------------------------------------- -- Host Pointer --------------------------------------------------------------------------------++-- |+-- A reference to page-locked host memory.+--+-- A 'HostPtr' is just a plain 'Ptr', but the memory has been allocated by CUDA+-- into page locked memory. This means that the data can be copied to the GPU+-- via DMA (direct memory access). Note that the use of the system function+-- `mlock` is not sufficient here --- the CUDA version ensures that the+-- /physical/ address stays this same, not just the virtual address.+--+-- To copy data into a 'HostPtr' array, you may use for example 'withHostPtr'+-- together with 'Foreign.Marshal.Array.copyArray' or+-- 'Foreign.Marshal.Array.moveArray'.+--+newtype HostPtr a = HostPtr { useHostPtr :: Ptr a }+ deriving (Eq,Ord)++instance Show (HostPtr a) where+ showsPrec n (HostPtr p) = showsPrec n p++instance Storable (HostPtr a) where+ sizeOf _ = sizeOf (undefined :: Ptr a)+ alignment _ = alignment (undefined :: Ptr a)+ peek p = HostPtr `fmap` peek (castPtr p)+ poke p v = poke (castPtr p) (useHostPtr v)+ -- | -- Apply an IO action to the memory reference living inside the host pointer
src/Foreign/CUDA/Runtime.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Top level bindings to the C-for-CUDA runtime API
src/Foreign/CUDA/Runtime/Device.chs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #ifdef USE_EMPTY_CASE@@ -10,7 +11,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Device--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Device management routines@@ -42,8 +43,10 @@ import Foreign.CUDA.Internal.C2HS -- System+import Control.Applicative import Foreign import Foreign.C+import Prelude #c typedef struct cudaDeviceProp cudaDeviceProp;@@ -86,117 +89,84 @@ poke _ _ = error "no instance for Foreign.Storable.poke DeviceProperties" peek p = do- n <- peekCString =<< {#get cudaDeviceProp.name#} p- gm <- cIntConv `fmap` {#get cudaDeviceProp.totalGlobalMem#} p- sm <- cIntConv `fmap` {#get cudaDeviceProp.sharedMemPerBlock#} p- rb <- cIntConv `fmap` {#get cudaDeviceProp.regsPerBlock#} p- ws <- cIntConv `fmap` {#get cudaDeviceProp.warpSize#} p- mp <- cIntConv `fmap` {#get cudaDeviceProp.memPitch#} p- tb <- cIntConv `fmap` {#get cudaDeviceProp.maxThreadsPerBlock#} p- cl <- cIntConv `fmap` {#get cudaDeviceProp.clockRate#} p- cm <- cIntConv `fmap` {#get cudaDeviceProp.totalConstMem#} p- v1 <- fromIntegral `fmap` {#get cudaDeviceProp.major#} p- v2 <- fromIntegral `fmap` {#get cudaDeviceProp.minor#} p- ta <- cIntConv `fmap` {#get cudaDeviceProp.textureAlignment#} p- ov <- cToBool `fmap` {#get cudaDeviceProp.deviceOverlap#} p- pc <- cIntConv `fmap` {#get cudaDeviceProp.multiProcessorCount#} p- ke <- cToBool `fmap` {#get cudaDeviceProp.kernelExecTimeoutEnabled#} p- tg <- cToBool `fmap` {#get cudaDeviceProp.integrated#} p- hm <- cToBool `fmap` {#get cudaDeviceProp.canMapHostMemory#} p- md <- cToEnum `fmap` {#get cudaDeviceProp.computeMode#} p+ deviceName <- peekCString =<< {#get cudaDeviceProp.name#} p+ computeCapability <- Compute <$> (fromIntegral <$> {#get cudaDeviceProp.major#} p)+ <*> (fromIntegral <$> {#get cudaDeviceProp.minor#} p)+ totalGlobalMem <- cIntConv <$> {#get cudaDeviceProp.totalGlobalMem#} p+ sharedMemPerBlock <- cIntConv <$> {#get cudaDeviceProp.sharedMemPerBlock#} p+ regsPerBlock <- cIntConv <$> {#get cudaDeviceProp.regsPerBlock#} p+ warpSize <- cIntConv <$> {#get cudaDeviceProp.warpSize#} p+ memPitch <- cIntConv <$> {#get cudaDeviceProp.memPitch#} p+ maxThreadsPerBlock <- cIntConv <$> {#get cudaDeviceProp.maxThreadsPerBlock#} p+ clockRate <- cIntConv <$> {#get cudaDeviceProp.clockRate#} p+ totalConstMem <- cIntConv <$> {#get cudaDeviceProp.totalConstMem#} p+ textureAlignment <- cIntConv <$> {#get cudaDeviceProp.textureAlignment#} p+ deviceOverlap <- cToBool <$> {#get cudaDeviceProp.deviceOverlap#} p+ multiProcessorCount <- cIntConv <$> {#get cudaDeviceProp.multiProcessorCount#} p+ kernelExecTimeoutEnabled <- cToBool <$> {#get cudaDeviceProp.kernelExecTimeoutEnabled#} p+ integrated <- cToBool <$> {#get cudaDeviceProp.integrated#} p+ canMapHostMemory <- cToBool <$> {#get cudaDeviceProp.canMapHostMemory#} p+ computeMode <- cToEnum <$> {#get cudaDeviceProp.computeMode#} p #if CUDART_VERSION >= 3000- ck <- cToBool `fmap` {#get cudaDeviceProp.concurrentKernels#} p- u1 <- cIntConv `fmap` {#get cudaDeviceProp.maxTexture1D#} p+ concurrentKernels <- cToBool <$> {#get cudaDeviceProp.concurrentKernels#} p+ maxTextureDim1D <- cIntConv <$> {#get cudaDeviceProp.maxTexture1D#} p #endif+#if CUDART_VERSION >= 3000 && CUDART_VERSION < 3010+ -- XXX: not visible from CUDA runtime API 3.0 (only accessible from the driver API)+ let eccEnabled = False+#endif #if CUDART_VERSION >= 3010- ee <- cToBool `fmap` {#get cudaDeviceProp.ECCEnabled#} p+ eccEnabled <- cToBool <$> {#get cudaDeviceProp.ECCEnabled#} p #endif #if CUDART_VERSION >= 4000- ae <- cIntConv `fmap` {#get cudaDeviceProp.asyncEngineCount#} p- l2 <- cIntConv `fmap` {#get cudaDeviceProp.l2CacheSize#} p- tm <- cIntConv `fmap` {#get cudaDeviceProp.maxThreadsPerMultiProcessor#} p- mw <- cIntConv `fmap` {#get cudaDeviceProp.memoryBusWidth#} p- mc <- cIntConv `fmap` {#get cudaDeviceProp.memoryClockRate#} p- pb <- cIntConv `fmap` {#get cudaDeviceProp.pciBusID#} p- pd <- cIntConv `fmap` {#get cudaDeviceProp.pciDeviceID#} p- pm <- cIntConv `fmap` {#get cudaDeviceProp.pciDomainID#} p- tc <- cToBool `fmap` {#get cudaDeviceProp.tccDriver#} p- ua <- cToBool `fmap` {#get cudaDeviceProp.unifiedAddressing#} p+ asyncEngineCount <- cIntConv <$> {#get cudaDeviceProp.asyncEngineCount#} p+ cacheMemL2 <- cIntConv <$> {#get cudaDeviceProp.l2CacheSize#} p+ maxThreadsPerMultiProcessor <- cIntConv <$> {#get cudaDeviceProp.maxThreadsPerMultiProcessor#} p+ memBusWidth <- cIntConv <$> {#get cudaDeviceProp.memoryBusWidth#} p+ memClockRate <- cIntConv <$> {#get cudaDeviceProp.memoryClockRate#} p+ pciInfo <- PCI <$> (cIntConv <$> {#get cudaDeviceProp.pciBusID#} p)+ <*> (cIntConv <$> {#get cudaDeviceProp.pciDeviceID#} p)+ <*> (cIntConv <$> {#get cudaDeviceProp.pciDomainID#} p)+ tccDriverEnabled <- cToBool <$> {#get cudaDeviceProp.tccDriver#} p+ unifiedAddressing <- cToBool <$> {#get cudaDeviceProp.unifiedAddressing#} p #endif- [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxThreadsDim#} p- [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxGridSize#} p+ [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxThreadsDim#} p+ [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxGridSize#} p+ let maxBlockSize = (t1,t2,t3)+ maxGridSize = (g1,g2,g3) #if CUDART_VERSION >= 3000- [u21,u22] <- peekArrayWith cIntConv 2 =<< {#get cudaDeviceProp.maxTexture2D#} p- [u31,u32,u33] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxTexture3D#} p+ [u21,u22] <- peekArrayWith cIntConv 2 =<< {#get cudaDeviceProp.maxTexture2D#} p+ [u31,u32,u33] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxTexture3D#} p+ let maxTextureDim2D = (u21,u22)+ maxTextureDim3D = (u31,u32,u33) #endif #if CUDART_VERSION >= 5050- sp <- cToBool `fmap` {#get cudaDeviceProp.streamPrioritiesSupported#} p+ streamPriorities <- cToBool <$> {#get cudaDeviceProp.streamPrioritiesSupported#} p #endif #if CUDART_VERSION >= 6000- gl1 <- cToBool `fmap` {#get cudaDeviceProp.globalL1CacheSupported#} p- ll1 <- cToBool `fmap` {#get cudaDeviceProp.localL1CacheSupported#} p- mm <- cToBool `fmap` {#get cudaDeviceProp.managedMemory#} p- mg <- cToBool `fmap` {#get cudaDeviceProp.isMultiGpuBoard#} p- mid <- cIntConv `fmap` {#get cudaDeviceProp.multiGpuBoardGroupID#} p-#endif-- return DeviceProperties- {- deviceName = n- , computeCapability = Compute v1 v2- , totalGlobalMem = gm- , totalConstMem = cm- , sharedMemPerBlock = sm- , regsPerBlock = rb- , warpSize = ws- , maxThreadsPerBlock = tb- , maxBlockSize = (t1,t2,t3)- , maxGridSize = (g1,g2,g3)- , clockRate = cl- , multiProcessorCount = pc- , memPitch = mp- , textureAlignment = ta- , computeMode = md- , deviceOverlap = ov- , kernelExecTimeoutEnabled = ke- , integrated = tg- , canMapHostMemory = hm-#if CUDART_VERSION >= 3000- , concurrentKernels = ck- , maxTextureDim1D = u1- , maxTextureDim2D = (u21,u22)- , maxTextureDim3D = (u31,u32,u33)-#endif-#if CUDART_VERSION >= 3010- , eccEnabled = ee-#endif-#if CUDART_VERSION >= 3000 && CUDART_VERSION < 3010- -- not visible from CUDA runtime API 3.0- , eccEnabled = False+ globalL1Cache <- cToBool <$> {#get cudaDeviceProp.globalL1CacheSupported#} p+ localL1Cache <- cToBool <$> {#get cudaDeviceProp.localL1CacheSupported#} p+ managedMemory <- cToBool <$> {#get cudaDeviceProp.managedMemory#} p+ multiGPUBoard <- cToBool <$> {#get cudaDeviceProp.isMultiGpuBoard#} p+ multiGPUBoardGroupID <- cIntConv <$> {#get cudaDeviceProp.multiGpuBoardGroupID#} p #endif-#if CUDART_VERSION >= 4000- , asyncEngineCount = ae- , cacheMemL2 = l2- , maxThreadsPerMultiProcessor = tm- , memBusWidth = mw- , memClockRate = mc- , tccDriverEnabled = tc- , unifiedAddressing = ua- , pciInfo = PCI pb pd pm+#if CUDART_VERSION >= 8000+#if CUDART_VERSION == 8000+ -- XXX: Not visible from the CUDA runtime API 8.0 (only accessible from the driver API)+ let preemption = False+#else+ preemption <- cToBool <$> {#get cudaDeviceProp.computePreemptionSupported#} p #endif-#if CUDA_VERSION >= 5050- , streamPriorities = sp+ singleToDoublePerfRatio <- cIntConv <$> {#get cudaDeviceProp.singleToDoublePrecisionPerfRatio#} p #endif-#if CUDA_VERSION >= 6000- , globalL1Cache = gl1- , localL1Cache = ll1- , managedMemory = mm- , multiGPUBoard = mg- , multiGPUBoardGroupID = mid+#if CUDART_VERSION >= 9000+ cooperativeLaunch <- cToBool <$> {#get cudaDeviceProp.cooperativeLaunch#} p+ cooperativeLaunchMultiDevice <- cToBool <$> {#get cudaDeviceProp.cooperativeMultiDeviceLaunch#} p #endif- } + return DeviceProperties{..} + -------------------------------------------------------------------------------- -- Device Management --------------------------------------------------------------------------------@@ -340,7 +310,7 @@ data PeerFlag instance Enum PeerFlag where #ifdef USE_EMPTY_CASE- toEnum x = case x of {}+ toEnum x = error ("PeerFlag.toEnum: Cannot match " ++ show x) fromEnum x = case x of {} #endif
src/Foreign/CUDA/Runtime/Error.chs view
@@ -4,7 +4,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Error--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Error handling functions
src/Foreign/CUDA/Runtime/Event.chs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Event--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Event management for C-for-CUDA runtime environment@@ -25,16 +25,17 @@ {# context lib="cudart" #} -- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Runtime.Error+import Foreign.CUDA.Driver.Event ( Event(..), EventFlag(..), WaitFlag )+import Foreign.CUDA.Driver.Stream ( Stream(..), defaultStream ) import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Runtime.Error -- System import Foreign import Foreign.C-import Control.Monad ( liftM )-import Control.Exception ( throwIO )-import Data.Maybe ( fromMaybe )+import Control.Monad ( liftM )+import Control.Exception ( throwIO )+import Data.Maybe ( fromMaybe ) --------------------------------------------------------------------------------
src/Foreign/CUDA/Runtime/Exec.chs view
@@ -6,7 +6,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Exec--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Kernel execution control for C-for-CUDA runtime interface
src/Foreign/CUDA/Runtime/Marshal.chs view
@@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Marshal--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Memory management for CUDA devices
src/Foreign/CUDA/Runtime/Stream.chs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Stream--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Stream management routines@@ -14,23 +14,25 @@ -- * Stream Management Stream(..),- create, destroy, finished, block, defaultStream+ create, destroy, finished, block, + defaultStream, defaultStreamLegacy, defaultStreamPerThread,+ ) where #include "cbits/stubs.h" {# context lib="cudart" #} -- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Runtime.Error+import Foreign.CUDA.Driver.Stream ( Stream(..), defaultStream, defaultStreamLegacy, defaultStreamPerThread ) import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Runtime.Error -- System import Foreign import Foreign.C-import Control.Monad ( liftM )-import Control.Exception ( throwIO )+import Control.Monad ( liftM )+import Control.Exception ( throwIO ) --------------------------------------------------------------------------------
src/Foreign/CUDA/Runtime/Texture.chs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Texture--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Texture references
src/Foreign/CUDA/Runtime/Utils.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Runtime.Utils--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2018] Trevor L. McDonell -- License : BSD -- -- Utility functions
− src/Foreign/CUDA/Types.chs
@@ -1,165 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase #-}-#endif------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Types--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Data types that are equivalent and can be shared freely between the CUDA--- Runtime and Driver APIs.--------------------------------------------------------------------------------------module Foreign.CUDA.Types (-- -- * Pointers- DevicePtr(..), HostPtr(..),-- -- * Events- Event(..), EventFlag(..), WaitFlag,-- -- * Streams- Stream(..), StreamFlag(..), StreamPriority,- defaultStream,--) where---- system-import Foreign.Ptr-import Foreign.Storable--#include "cbits/stubs.h"-{# context lib="cuda" #}-------------------------------------------------------------------------------------- Data pointers------------------------------------------------------------------------------------- |--- A reference to data stored on the device.----newtype DevicePtr a = DevicePtr { useDevicePtr :: Ptr a }- deriving (Eq,Ord)--instance Show (DevicePtr a) where- showsPrec n (DevicePtr p) = showsPrec n p--instance Storable (DevicePtr a) where- sizeOf _ = sizeOf (undefined :: Ptr a)- alignment _ = alignment (undefined :: Ptr a)- peek p = DevicePtr `fmap` peek (castPtr p)- poke p v = poke (castPtr p) (useDevicePtr v)----- |--- A reference to page-locked host memory.------ A 'HostPtr' is just a plain 'Ptr', but the memory has been allocated by CUDA--- into page locked memory. This means that the data can be copied to the GPU--- via DMA (direct memory access). Note that the use of the system function--- `mlock` is not sufficient here --- the CUDA version ensures that the--- /physical/ address stays this same, not just the virtual address.------ To copy data into a 'HostPtr' array, you may use for example 'withHostPtr'--- together with 'Foreign.Marshal.Array.copyArray' or--- 'Foreign.Marshal.Array.moveArray'.----newtype HostPtr a = HostPtr { useHostPtr :: Ptr a }- deriving (Eq,Ord)--instance Show (HostPtr a) where- showsPrec n (HostPtr p) = showsPrec n p--instance Storable (HostPtr a) where- sizeOf _ = sizeOf (undefined :: Ptr a)- alignment _ = alignment (undefined :: Ptr a)- peek p = HostPtr `fmap` peek (castPtr p)- poke p v = poke (castPtr p) (useHostPtr v)-------------------------------------------------------------------------------------- Events------------------------------------------------------------------------------------- |--- Events are markers that can be inserted into the CUDA execution stream and--- later queried.----newtype Event = Event { useEvent :: {# type CUevent #}}- deriving (Eq, Show)---- |--- Event creation flags----{# enum CUevent_flags as EventFlag- { underscoreToCase- , CU_EVENT_DEFAULT as EventDefault- }- with prefix="CU_EVENT" deriving (Eq, Show, Bounded) #}---- |--- Possible option flags for waiting for events----data WaitFlag-instance Enum WaitFlag where-#ifdef USE_EMPTY_CASE- toEnum x = case x of {}- fromEnum x = case x of {}-#endif-------------------------------------------------------------------------------------- Stream management------------------------------------------------------------------------------------- |--- A processing stream. All operations in a stream are synchronous and executed--- in sequence, but operations in different non-default streams may happen--- out-of-order or concurrently with one another.------ Use 'Event's to synchronise operations between streams.----newtype Stream = Stream { useStream :: {# type CUstream #}}- deriving (Eq, Show)----- |--- Priority of an execution stream. Work submitted to a higher priority--- stream may preempt execution of work already executing in a lower--- priority stream. Lower numbers represent higher priorities.----type StreamPriority = Int---- |--- 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--- default stream.----{-# INLINE defaultStream #-}-defaultStream :: Stream-defaultStream = Stream nullPtr-