cuda 0.9.0.3 → 0.13.0.0
raw patch · 57 files changed
Files
- CHANGELOG.markdown +0/−143
- CHANGELOG.md +223/−0
- README.markdown +0/−24
- README.md +175/−0
- Setup.hs +182/−62
- WINDOWS.markdown +0/−54
- WINDOWS.md +54/−0
- cbits/stubs.c +127/−93
- cbits/stubs.h +43/−78
- cuda.cabal +51/−73
- examples/src/deviceQueryDrv/DeviceQuery.hs +108/−48
- src/Foreign/C/Extra.hs +38/−0
- src/Foreign/CUDA.hs +0/−19
- src/Foreign/CUDA/Analysis.hs +1/−1
- src/Foreign/CUDA/Analysis/Device.chs +271/−54
- src/Foreign/CUDA/Analysis/Occupancy.hs +19/−10
- src/Foreign/CUDA/Driver.hs +11/−5
- 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 +165/−158
- src/Foreign/CUDA/Driver/Error.chs +7/−3
- src/Foreign/CUDA/Driver/Event.chs +44/−4
- src/Foreign/CUDA/Driver/Exec.chs +5/−6
- src/Foreign/CUDA/Driver/Graph/Base.chs +77/−0
- src/Foreign/CUDA/Driver/Graph/Build.chs +745/−0
- src/Foreign/CUDA/Driver/Graph/Capture.chs +223/−0
- src/Foreign/CUDA/Driver/Graph/Exec.chs +192/−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 +55/−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 +64/−33
- src/Foreign/CUDA/Driver/Profiler.chs +1/−1
- src/Foreign/CUDA/Driver/Stream.chs +249/−25
- src/Foreign/CUDA/Driver/Texture.chs +0/−308
- src/Foreign/CUDA/Driver/Unified.chs +12/−3
- src/Foreign/CUDA/Driver/Utils.chs +1/−1
- src/Foreign/CUDA/Internal/C2HS.hs +53/−6
- src/Foreign/CUDA/Internal/Describe.hs +18/−0
- src/Foreign/CUDA/Path.chs +1/−1
- src/Foreign/CUDA/Ptr.hs +43/−5
- src/Foreign/CUDA/Runtime.hs +0/−28
- src/Foreign/CUDA/Runtime/Device.chs +0/−464
- src/Foreign/CUDA/Runtime/Error.chs +0/−119
- src/Foreign/CUDA/Runtime/Event.chs +0/−148
- src/Foreign/CUDA/Runtime/Exec.chs +0/−276
- src/Foreign/CUDA/Runtime/Marshal.chs +0/−648
- src/Foreign/CUDA/Runtime/Stream.chs +0/−115
- src/Foreign/CUDA/Runtime/Texture.chs +0/−203
- src/Foreign/CUDA/Runtime/Utils.chs +0/−63
- src/Foreign/CUDA/Types.chs +0/−165
- src/Text/Show/Describe.hs +0/−18
− CHANGELOG.markdown
@@ -1,143 +0,0 @@-# Change Log--Notable changes to the project will be documented in this file.--The format is based on [Keep a Changelog](http://keepachangelog.com/).--## [0.9.0.3] - 2018-03-12-### Fixed- * Build fix for Cabal-2.2 (ghc-8.4)--## [0.9.0.2] - 2018-03-07-### Fixed- * Build fix for Nix ([#53])--## [0.9.0.1] - 2018-02-16-### Fixed- * Build fix for macOS High Sierra (10.13)--## [0.9.0.0] - 2017-11-15-### Fixed- * Build fixes for CUDA-9--### Added- * `Peer.getAttribute`- * `Exec.launchKernelCooperative`--### Changed- * Changed type of `Stream.wait` and `Stream.write` to support 64-bit values--## [0.8.0.1] - 2017-10-24-### Fixed- * Escape backslashes used in -D flags on Windows ([#50])--## [0.8.0.0] - 2017-08-24-### Changed- * Tested with CUDA toolkit 8.0--### Added- * Add operations for unified addressing in the device API- * Add `write` and `wait` operations for streams in the device API- * (internals) The paths this module was configured against are exposed by the- module `Foreign.CUDA.Paths`.--## [0.7.5.3] - 2017-03-23-### Fixed- * Bug fix in occupancy calculator--## [0.7.5.2] - 2017-01-06-### Fixed- * Build fails with library profiling ([#43])- * On Windows, the Cabal installer is looking in the wrong place ([#45])- * Windows install fix ([#47])--## [0.7.5.1] - 2016-10-21-### Fixed- * Re-enable support for Cabal-1.22- * Unknown CUDA device compute capability 6.1 ([#40])- * Compilation fails for CUDA-8 [was: ghc 7.10.3 fail to install] ([#44])--## [0.7.5.0] - 2016-10-07-### Changed- * Tested with CUDA toolkit 7.5--### Added- * Add functions from CUDA-7.5- * Add profiler control functions- * Add function `mallocHostForeignPtr`--## [0.7.0.0] - 2015-11-30-### Changed- * Add support for operations from CUDA-7.0- * Add support for online linking- * Add support for inter-process communication- * Bug fixes, extra documentation, improve library coverage.- * Mac OS X no longer requires the DYLD_LIBRARY_PATH environment variable in- order to compile or run programs that use this package.--## [0.6.7.0] - 2015-09-12-### Added- * Add support for building on Windows (thanks to @mwu-tow)--## [0.6.6.2] - 2015-04-04-### Fixed- * Build fix--## [0.6.6.1] - 2015-04-04 [YANKED]-### Fixed- * Build fixes for ghc-7.6 and ghc-7.10--## [0.6.6.0] - 2015-03-10-### Added- * Add compute-capability data for 3.7, 5.2 devices.--### Changed- * Combine the definition of the 'Event' and 'Stream' data types. As of- CUDA-3.1 these data structures are equivalent, and can be safely shared- between runtime and driver API calls and libraries.-- * Mark FFI imports of potentially long-running API functions as safe. This- allows them to be safely called from Haskell threads without blocking the- entire HEC.--### Removed- * Drop support for CUDA 3.0 and older.--## [0.6.5.1] - 2014-12-02-### Fixed- * Build fix for Mac OS X 10.10 (Yosemite)--## [0.6.5.0] - 2014-09-03-### Changed- * Tested with CUDA toolkit 6.5--### Added- * Add functions from CUDA-6.5---[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-[0.9.0.0]: https://github.com/tmcdonell/cuda/compare/0.8.0.1...0.9.0.0-[0.8.0.1]: https://github.com/tmcdonell/cuda/compare/0.8.0.0...0.8.0.1-[0.8.0.0]: https://github.com/tmcdonell/cuda/compare/0.7.5.3...0.8.0.0-[0.7.5.3]: https://github.com/tmcdonell/cuda/compare/0.7.5.2...0.7.5.3-[0.7.5.2]: https://github.com/tmcdonell/cuda/compare/0.7.5.1...0.7.5.2-[0.7.5.1]: https://github.com/tmcdonell/cuda/compare/0.7.5.0...0.7.5.1-[0.7.5.0]: https://github.com/tmcdonell/cuda/compare/0.7.0.0...0.7.5.0-[0.7.0.0]: https://github.com/tmcdonell/cuda/compare/0.6.7.0...0.7.0.0-[0.6.7.0]: https://github.com/tmcdonell/cuda/compare/0.6.6.2...0.6.7.0-[0.6.6.2]: https://github.com/tmcdonell/cuda/compare/0.6.6.1...0.6.6.2-[0.6.6.1]: https://github.com/tmcdonell/cuda/compare/0.6.6.0...0.6.6.1-[0.6.6.0]: https://github.com/tmcdonell/cuda/compare/0.6.5.1...0.6.6.0-[0.6.5.1]: https://github.com/tmcdonell/cuda/compare/0.6.5.0...0.6.5.1-[0.6.5.0]: https://github.com/tmcdonell/cuda/compare/0.6.0.1...0.6.5.0--[#40]: https://github.com/tmcdonell/cuda/issues/40-[#43]: https://github.com/tmcdonell/cuda/issues/43-[#44]: https://github.com/tmcdonell/cuda/issues/44-[#45]: https://github.com/tmcdonell/cuda/issues/45-[#47]: https://github.com/tmcdonell/cuda/pull/47-[#50]: https://github.com/tmcdonell/cuda/pull/50-[#53]: https://github.com/tmcdonell/cuda/pull/53-
+ CHANGELOG.md view
@@ -0,0 +1,223 @@+# Change Log++Notable changes to the project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/).++**NOTE:** The version numbers of this package roughly align to the latest+version of the CUDA API this package is built against. This means that this+package _DOES NOT_ follow the PVP, or indeed any sensible version scheme,+because NVIDIA are A-OK introducing breaking changes in minor updates.+++## [0.13.0.0] - 2026-03-30+### Added+ * Support for CUDA-13++### Removed+ * Support for the runtime API (`Foreign.CUDA.RUntime`). There is an+ experimental cuda-runtime package in the Git repository; contact us if you+ depend on this.++## [0.12.8.0] - 2025-08-21+### Added+ * Support for CUDA-12+ - Thanks to @noahmartinwilliams on GitHub for helping out!++### Removed+ * The following modules have been deprecated for a long time, and have+ finally been removed in CUDA-12:+ - `Foreign.CUDA.Driver.Texture`+ - `Foreign.CUDA.Runtime.Texture`+ Support for Texture Objects (their replacement) is missing in these+ bindings so far. Contributions welcome.++## [0.11.0.1] - 2023-08-15+### Fixed+ * Build fixes for GHC 9.2 .. 9.6++## [0.11.0.0] - 2021-07-05+### Added+ * Add support for CUDA-11.[0..4]++## [0.10.2.0] - 2020-08-26+### Added+ * Add support for CUDA-10.2+ * Add support for Cabal-3+ * Add device properties for SM7.x, SM8++## [0.10.1.0] - 2019-04-29+### Added+ * Add support for CUDA-10.1++### Changed+ * The function `Foreign.CUDA.Driver.Graph.Capture.start` has an extra+ parameter to specify the capture mode++### Removed+ * The following functions have been deprecated (since at least CUDA-8) and are+ finally removed:+ - `Foreign.CUDA.Runtime.Exec.launch`+ - `Foreign.CUDA.Runtime.Exec.setParams`+ - `Foreign.CUDA.Runtime.Exec.setConfig`++## [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)++## [0.9.0.2] - 2018-03-07+### Fixed+ * Build fix for Nix ([#53])++## [0.9.0.1] - 2018-02-16+### Fixed+ * Build fix for macOS High Sierra (10.13)++## [0.9.0.0] - 2017-11-15+### Fixed+ * Build fixes for CUDA-9++### Added+ * `Peer.getAttribute`+ * `Exec.launchKernelCooperative`++### Changed+ * Changed type of `Stream.wait` and `Stream.write` to support 64-bit values++## [0.8.0.1] - 2017-10-24+### Fixed+ * Escape backslashes used in -D flags on Windows ([#50])++## [0.8.0.0] - 2017-08-24+### Changed+ * Tested with CUDA toolkit 8.0++### Added+ * Add operations for unified addressing in the device API+ * Add `write` and `wait` operations for streams in the device API+ * (internals) The paths this module was configured against are exposed by the+ module `Foreign.CUDA.Paths`.++## [0.7.5.3] - 2017-03-23+### Fixed+ * Bug fix in occupancy calculator++## [0.7.5.2] - 2017-01-06+### Fixed+ * Build fails with library profiling ([#43])+ * On Windows, the Cabal installer is looking in the wrong place ([#45])+ * Windows install fix ([#47])++## [0.7.5.1] - 2016-10-21+### Fixed+ * Re-enable support for Cabal-1.22+ * Unknown CUDA device compute capability 6.1 ([#40])+ * Compilation fails for CUDA-8 [was: ghc 7.10.3 fail to install] ([#44])++## [0.7.5.0] - 2016-10-07+### Changed+ * Tested with CUDA toolkit 7.5++### Added+ * Add functions from CUDA-7.5+ * Add profiler control functions+ * Add function `mallocHostForeignPtr`++## [0.7.0.0] - 2015-11-30+### Changed+ * Add support for operations from CUDA-7.0+ * Add support for online linking+ * Add support for inter-process communication+ * Bug fixes, extra documentation, improve library coverage.+ * Mac OS X no longer requires the DYLD_LIBRARY_PATH environment variable in+ order to compile or run programs that use this package.++## [0.6.7.0] - 2015-09-12+### Added+ * Add support for building on Windows (thanks to @mwu-tow)++## [0.6.6.2] - 2015-04-04+### Fixed+ * Build fix++## [0.6.6.1] - 2015-04-04 [YANKED]+### Fixed+ * Build fixes for ghc-7.6 and ghc-7.10++## [0.6.6.0] - 2015-03-10+### Added+ * Add compute-capability data for 3.7, 5.2 devices.++### Changed+ * Combine the definition of the 'Event' and 'Stream' data types. As of+ CUDA-3.1 these data structures are equivalent, and can be safely shared+ between runtime and driver API calls and libraries.++ * Mark FFI imports of potentially long-running API functions as safe. This+ allows them to be safely called from Haskell threads without blocking the+ entire HEC.++### Removed+ * Drop support for CUDA 3.0 and older.++## [0.6.5.1] - 2014-12-02+### Fixed+ * Build fix for Mac OS X 10.10 (Yosemite)++## [0.6.5.0] - 2014-09-03+### Changed+ * Tested with CUDA toolkit 6.5++### Added+ * Add functions from CUDA-6.5++[next]: https://github.com/tmcdonell/cuda/compare/v0.11.0.1...HEAD+[0.11.0.1]: https://github.com/tmcdonell/cuda/compare/v0.11.0.0...v0.11.0.1+[0.11.0.0]: https://github.com/tmcdonell/cuda/compare/v0.10.2.0...v0.11.0.0+[0.10.2.0]: https://github.com/tmcdonell/cuda/compare/v0.10.1.0...v0.10.2.0+[0.10.1.0]: https://github.com/tmcdonell/cuda/compare/v0.10.0.0...v0.10.1.0+[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+[0.9.0.0]: https://github.com/tmcdonell/cuda/compare/0.8.0.1...0.9.0.0+[0.8.0.1]: https://github.com/tmcdonell/cuda/compare/0.8.0.0...0.8.0.1+[0.8.0.0]: https://github.com/tmcdonell/cuda/compare/0.7.5.3...0.8.0.0+[0.7.5.3]: https://github.com/tmcdonell/cuda/compare/0.7.5.2...0.7.5.3+[0.7.5.2]: https://github.com/tmcdonell/cuda/compare/0.7.5.1...0.7.5.2+[0.7.5.1]: https://github.com/tmcdonell/cuda/compare/0.7.5.0...0.7.5.1+[0.7.5.0]: https://github.com/tmcdonell/cuda/compare/0.7.0.0...0.7.5.0+[0.7.0.0]: https://github.com/tmcdonell/cuda/compare/0.6.7.0...0.7.0.0+[0.6.7.0]: https://github.com/tmcdonell/cuda/compare/0.6.6.2...0.6.7.0+[0.6.6.2]: https://github.com/tmcdonell/cuda/compare/0.6.6.1...0.6.6.2+[0.6.6.1]: https://github.com/tmcdonell/cuda/compare/0.6.6.0...0.6.6.1+[0.6.6.0]: https://github.com/tmcdonell/cuda/compare/0.6.5.1...0.6.6.0+[0.6.5.1]: https://github.com/tmcdonell/cuda/compare/0.6.5.0...0.6.5.1+[0.6.5.0]: https://github.com/tmcdonell/cuda/compare/0.6.0.1...0.6.5.0++[#40]: https://github.com/tmcdonell/cuda/issues/40+[#43]: https://github.com/tmcdonell/cuda/issues/43+[#44]: https://github.com/tmcdonell/cuda/issues/44+[#45]: https://github.com/tmcdonell/cuda/issues/45+[#47]: https://github.com/tmcdonell/cuda/pull/47+[#50]: https://github.com/tmcdonell/cuda/pull/50+[#53]: https://github.com/tmcdonell/cuda/pull/53+
− README.markdown
@@ -1,24 +0,0 @@-Haskell FFI Bindings to CUDA-============================--[](https://travis-ci.org/tmcdonell/cuda)-[](https://ci.appveyor.com/project/tmcdonell/cuda)-[](https://stackage.org/lts/package/cuda)-[](https://stackage.org/nightly/package/cuda)-[](https://hackage.haskell.org/package/cuda)--The CUDA library provides a direct, general purpose C-like SPMD programming-model for NVIDIA graphics cards (G8x series onwards). This is a collection of-bindings to allow you to call and control, although not write, such functions-from Haskell-land. You will need to install the CUDA driver and developer-toolkit.-- <http://developer.nvidia.com/object/cuda.html>--The configure step will look for your CUDA installation in the standard places,-and if the `nvcc` compiler is found in your `PATH`, relative to that.--For important information on installing on Windows, see:-- <https://github.com/tmcdonell/cuda/blob/master/WINDOWS.markdown>-
+ README.md view
@@ -0,0 +1,175 @@+Haskell FFI Bindings to CUDA+============================++[](https://github.com/tmcdonell/cuda/actions/workflows/ci-linux.yml)+[](https://github.com/tmcdonell/cuda/actions/workflows/ci-windows.yml)+[](https://stackage.org/lts/package/cuda)+[](https://stackage.org/nightly/package/cuda)+[](https://hackage.haskell.org/package/cuda)++The CUDA library provides a direct, general purpose C-like SPMD programming+model for NVIDIA graphics cards (G8x series onwards). This is a collection of+bindings to allow you to call and control, although not write, such functions+from Haskell-land. You will need to install the CUDA driver and developer+toolkit.++ <http://developer.nvidia.com/object/cuda.html>++The configure step will look for your CUDA installation in the standard places,+and if the `nvcc` compiler is found in your `PATH`, relative to that.++For important information on installing on Windows, see:++ <https://github.com/tmcdonell/cuda/blob/master/WINDOWS.md>+++## Missing functionality++This library is currently in **maintenance mode**. While we are happy to+release updates to keep the existing interface working with newer CUDA versions+(as long as the underlying APIs remain available), no binding of new features+is planned at the moment. Get in touch if you want to contribute.++Here is an incomplete historical list of missing bindings. Pull requests welcome!++### CUDA-9++- cuLaunchCooperativeKernelMultiDevice++### CUDA-10.0++- cuDeviceGetLuid (windows only?)+- cuLaunchHostFunc+- cuGraphHostNode[Get/Set]Params+- cuGraphKernelNode[Get/Set]Params+- cuGraphMemcpyNode[Get/Set]Params+- cuGraphMemsetNode[Get/Set]Params++### CUDA-10.2++- cuDeviceGetNvSciSyncAttributes+- cuMemAddressFree+- cuMemAddressReserve+- cuMemCreate+- cuMemExportToShareableHandle+- cuMemGetAccess+- cuMemGetAllocationGranularity+- cuMemGetAllocationPrepertiesFromHandle+- cuMemImportFromShareableHandle+- cuMemMap+- cuMemRelease+- cuMemSetAccess+- cuMemUnmap+- cuGraphExecHostNodeSetParams+- cuGraphExecMemcpyNodeSetParams+- cuGraphExecMemsetNodeSetParams+- cuGraphExecUpdate++### CUDA-11.0++- cuCtxResetPersistentingL2Cache+- cuMemRetainAllocationHandle+- cuStreamCopyAttributes+- cuStreamGetAttribute+- cuStreamSetAttribute+- cuGraphKernelNodeCopyAttributes+- cuGraphKernelNodeGetAttribute+- cuGraphKernelNodeSetAttribute+- cuOccupancyAvailableDynamicSMemPerBlock++### CUDA-11.1++- cuDeviceGetTexture1DLinearMaxWidth+- cuArrayGetSparseProperties+- cuMipmappedArrayGetSparseProperties+- cuMemMapArrayAsync+- cuEventRecordWithFlags+- cuGraphAddEventRecordNode+- cuGraphAddEventWaitNode+- cuGraphEventRecordNodeGetEvent+- cuGraphEventRecordNodeSetEvent+- cuGraphEventWaitNodeGetEvent+- cuGraphEventWaitNodeSetEvent+- cuGraphExecChildGraphNodeSetParams+- cuGraphExecEventRecordNodeSetEvent+- cuGraphExecEventWaitNodeSetEvent+- cuGraphUpload++### CUDA-11.2++- cuDeviceGetDefaultMemPool+- cuDeviceGetMemPool+- cuDeviceSetMemPool+- cuArrayGetPlane+- cuMemAllocAsync+- cuMemAllocFromPoolAsync+- cuMemFreeAsync+- cuMemPoolCreate+- cuMemPoolDestroy+- cuMemPoolExportPointer+- cuMemPoolExportToShareableHandle+- cuMemPoolGetAccess+- cuMemPoolGetAttribute+- cuMemPoolImportFromShareableHandle+- cuMemPoolImportPointer+- cuMemPoolSetAccess+- cuMemPoolSetAttribute+- cuMemPoolTrimTo+- cuGraphAddExternalSemaphoresSignalNode+- cuGraphAddExternalSemaphoresWaitNode+- cuGraphExecExternalSemaphoresSignalNodeSetParams+- cuGraphExecExternalSemaphoresWaitNodeSetParams+- cuGraphExternalSemaphoresSignalNodeGetParams+- cuGraphExternalSemaphoresSignalNodeSetParams+- cuGraphExternalSemaphoresWaitNodeGetParams+- cuGraphExternalSemaphoresWaitNodeSetParams++### CUDA-11.3++- cuStreamGetCaptureInfo_v2+- cuFuncGetModule+- cuGraphDebugDotPrint+- cuGraphReleaseUserObject+- cuGraphRetainUserObject+- cuUserObjectCreate+- cuUserObjectRelease+- cuUserObjectRetain+- cuGetProcAddress++### CUDA-11.4++- cuDeviceGetUuid_v2+- cuCtxCreate_v3+- cuCtxGetExecAffinity+- cuDeviceGetGraphMemAttribute+- cuDeviceGraphMemTrim+- cuDeviceSetGraphMemAttribute+- cuGraphAddMemAllocNode+- cuGraphAddMemFreeNode+- cuGraphInstantiateWithFlags+- cuGraphMemAllocNodeGetParams+- cuGraphMemFreeNodeGetParams++### CUDA >= 12++A lot. PRs welcome.++- CUDA-12.3+ - Edge data in the driver Graph API (`cuGraphAddDependencies_v2` etc.)+++# Old compatibility notes++The setup script for this package requires at least Cabal-1.24. If you run into trouble with this:++* Cabal users: ensure you are using a new `cabal` executable and have run `cabal update` anywhere in the last few years. If you have previously run `cabal install` on libraries and have a broken environment as a result, remove `~/.ghc/<platfom>/environments/default`.+* Stack users: one may attempt @stack setup --upgrade-cabal@.++Due to an interaction between GHC-8 and unified virtual address spaces in+CUDA, this package does not currently work with GHCi on ghc-8.0.1 (compiled+programs should work). See the following for more details:++* <https://github.com/tmcdonell/cuda/issues/39>+* <https://ghc.haskell.org/trac/ghc/ticket/12573>++The bug should be fixed in ghc-8.0.2 and beyond.
Setup.hs view
@@ -1,13 +1,22 @@+-- Decouple from GHC's default language setting, so that it's easier+-- to maintain compatibility with old GHCs.+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} -- The MIN_VERSION_Cabal macro was introduced with Cabal-1.24 (??) #ifndef MIN_VERSION_Cabal #define MIN_VERSION_Cabal(major1,major2,minor) 0 #endif -import Distribution.PackageDescription+import Distribution.PackageDescription hiding ( Flag ) import Distribution.Simple import Distribution.Simple.BuildPaths import Distribution.Simple.Command@@ -30,12 +39,29 @@ #else import Distribution.PackageDescription.Parse #endif+#if MIN_VERSION_Cabal(3,8,0)+import Distribution.Simple.PackageDescription+#endif+#if MIN_VERSION_Cabal(3,14,0)+-- Note [Cabal 3.14]+--+-- If you change any path stuff, either test that the package still works with+-- Cabal 3.12 or stop declaring support for it in cuda.cabal. (If you do the+-- latter, also remove all of the other conditionals in this file.)+-- Note that supporting old versions of Cabal is useful for being able to run+-- e.g. Accelerate on old GPU clusters, which is nice.+import Distribution.Utils.Path (SymbolicPath, FileOrDir(File, Dir), Lib, Include, Pkg, CWD, makeSymbolicPath, interpretSymbolicPath, makeRelativePathEx)+import qualified Distribution.Types.LocalBuildConfig as LBC+#else+#endif import Control.Exception import Control.Monad+import Data.Char (isDigit) import Data.Function import Data.List import Data.Maybe+import Data.String (fromString) import System.Directory import System.Environment import System.FilePath@@ -63,9 +89,9 @@ main :: IO () main = defaultMainWithHooks customHooks where+ -- Be careful changing flags/paths stuff here; see Note [Cabal 3.14]. readHook get_verbosity a flags = do- noExtraFlags a- getHookedBuildInfo (fromFlag (get_verbosity flags))+ getHookedBuildInfo (flagToMaybe (workingDirFlag flags)) (fromFlag (get_verbosity flags)) preprocessors = hookedPreProcessors simpleUserHooks @@ -84,14 +110,16 @@ , preReg = readHook regVerbosity , preUnreg = readHook regVerbosity , postConf = postConfHook- , hookedPreProcessors = ("chs", ppC2hs) : filter (\x -> fst x /= "chs") preprocessors+ , hookedPreProcessors = (fromString "chs", ppC2hs) : filter (\x -> fst x /= fromString "chs") preprocessors } -- The hook just loads the HookedBuildInfo generated by postConfHook, -- unless there is user-provided info that overwrites it. -- preBuildHook :: Args -> BuildFlags -> IO HookedBuildInfo- preBuildHook _ flags = getHookedBuildInfo $ fromFlag $ buildVerbosity flags+ preBuildHook _ flags = getHookedBuildInfo cwd verbosity+ where cwd = flagToMaybe (workingDirFlag flags)+ verbosity = fromFlag (buildVerbosity flags) -- The hook scans system in search for CUDA Toolkit. If the toolkit is not -- found, an error is raised. Otherwise the toolkit location is used to@@ -100,13 +128,14 @@ postConfHook :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () postConfHook args flags pkg_descr lbi = do let+ cwd = flagToMaybe (workingDirFlag flags) verbosity = fromFlagOrDefault normal (configVerbosity flags) profile = fromFlagOrDefault False (configProfLib flags) currentPlatform = hostPlatform lbi compilerId_ = compilerId (compiler lbi) --- noExtraFlags args generateAndStoreBuildInfo+ cwd verbosity profile currentPlatform@@ -116,7 +145,7 @@ generatedBuildInfoFilePath validateLinker verbosity currentPlatform $ withPrograms lbi --- actualBuildInfoToUse <- getHookedBuildInfo verbosity+ actualBuildInfoToUse <- getHookedBuildInfo cwd verbosity let pkg_descr' = updatePackageDescription actualBuildInfoToUse pkg_descr postConf simpleUserHooks args flags pkg_descr' lbi @@ -129,27 +158,29 @@ -- visible to underlying build tools. -- libraryBuildInfo- :: Verbosity+ :: Maybe CWDPath+ -> Verbosity -> Bool -> FilePath -> Platform -> Version- -> [FilePath]- -> [FilePath]+ -> [ExtraLibsPath]+ -> [ExtraIncludesPath] -> IO HookedBuildInfo-libraryBuildInfo verbosity profile installPath platform@(Platform arch os) ghcVersion extraLibs extraIncludes = do+libraryBuildInfo cwd verbosity profile installPath platform@(Platform arch os) ghcVersion extraLibs extraIncludes = do let- libraryPaths = cudaLibraryPath platform installPath : extraLibs- includePaths = cudaIncludePath platform installPath : extraIncludes+ -- Be careful changing flags/paths stuff here; see Note [Cabal 3.14].+ libraryPaths = map makeSymbolicPath (cudaLibraryPaths platform installPath) ++ extraLibs+ includePaths = makeSymbolicPath (cudaIncludePath platform installPath) : extraIncludes takeFirstExisting paths = do- existing <- filterM doesDirectoryExist libraryPaths+ existing <- filterM (doesDirectoryExist . interpretSymbolicPath cwd) libraryPaths case existing of (p0:_) -> return p0 _ -> die' verbosity $ "Could not find path: " ++ show paths -- This can only be defined once, so take the first path which exists- canonicalLibraryPath <- takeFirstExisting libraryPaths+ canonicalLibraryPath <- interpretSymbolicPath cwd <$> takeFirstExisting libraryPaths let -- OS-specific escaping for -D path defines@@ -161,16 +192,16 @@ extraLibDirs' = libraryPaths ccOptions' = [ "-DCUDA_INSTALL_PATH=\"" ++ escDefPath installPath ++ "\"" , "-DCUDA_LIBRARY_PATH=\"" ++ escDefPath canonicalLibraryPath ++ "\""- ] ++ map ("-I" ++) includePaths- ldOptions' = map ("-L" ++) libraryPaths+ ] ++ map (("-I" ++) . interpretSymbolicPath cwd) includePaths+ ldOptions' = map (("-L" ++) . interpretSymbolicPath cwd) libraryPaths ghcOptions = map ("-optc"++) ccOptions' ++ map ("-optl"++) ldOptions' ++ if os /= Windows && not profile- then map ("-optl-Wl,-rpath,"++) extraLibDirs'+ then map (("-optl-Wl,-rpath," ++) . interpretSymbolicPath cwd) extraLibDirs' else [] extraLibs' = cudaLibraries platform- frameworks' = [ "CUDA" | os == OSX ]- frameworkDirs' = [ "/Library/Frameworks" | os == OSX ]+ frameworks' = [ makeRelativePathEx "CUDA" | os == OSX ]+ frameworkDirs' = [ makeSymbolicPath "/Library/Frameworks" | os == OSX ] -- options or c2hs archFlag = case arch of@@ -196,7 +227,11 @@ , extraLibDirs = extraLibDirs' , frameworks = frameworks' , extraFrameworkDirs = frameworkDirs'+#if MIN_VERSION_Cabal(3,0,0)+ , options = PerCompilerFlavor (if os /= Windows then ghcOptions else []) []+#else , options = [(GHC, ghcOptions) | os /= Windows]+#endif , customFieldsBI = [c2hsExtraOptions] } @@ -210,18 +245,21 @@ cudaIncludePath _ installPath = installPath </> "include" --- Return the location of the libraries relative to the base CUDA installation.+-- Return the potential locations of the libraries relative to the base CUDA installation. ---cudaLibraryPath :: Platform -> FilePath -> FilePath-cudaLibraryPath (Platform arch os) installPath = installPath </> libpath+cudaLibraryPaths :: Platform -> FilePath -> [FilePath]+cudaLibraryPaths (Platform arch os) installPath = [ installPath </> path | path <- libpaths ] where- libpath =+ libpaths = case (os, arch) of- (Windows, I386) -> "lib/Win32"- (Windows, X86_64) -> "lib/x64"- (OSX, _) -> "lib" -- MacOS does not distinguish 32- vs. 64-bit paths- (_, X86_64) -> "lib64" -- treat all others similarly- _ -> "lib"+ (Windows, I386) -> ["lib/Win32"]+ (Windows, X86_64) -> ["lib/x64"]+ (OSX, _) -> ["lib"] -- MacOS does not distinguish 32- vs. 64-bit paths+ (_, X86_64) -> ["lib64", "lib"] -- prefer lib64 for 64-bit systems+#if MIN_VERSION_Cabal(2,4,0)+ (_, AArch64) -> ["lib64", "lib"]+#endif+ _ -> ["lib"] -- otherwise -- On Windows and OSX we use different libraries depending on whether we are@@ -231,7 +269,7 @@ cudaLibraries (Platform _ os) = case os of OSX -> ["cudadevrt", "cudart_static"]- _ -> ["cudart", "cuda"]+ _ -> ["cuda"] cudaGHCiLibraries :: Platform@@ -241,7 +279,7 @@ cudaGHCiLibraries platform@(Platform _ os) installPath libraries = case os of Windows -> cudaGhciLibrariesWindows platform installPath libraries- OSX -> return ["cudart"]+ OSX -> return ["cuda"] _ -> return [] -- Windows compatibility function.@@ -259,7 +297,9 @@ -> [FilePath] -> IO [FilePath] cudaGhciLibrariesWindows platform installPath libraries = do- candidates <- mapM importLibraryToDLLFileName [ cudaLibraryPath platform installPath </> lib <.> "lib" | lib <- libraries ]+ candidates <- mapM (importLibraryToDLLFileName platform)+ [ libPath </> lib <.> "lib" | libPath <- cudaLibraryPaths platform installPath+ , lib <- libraries ] return [ dropExtension dll | Just dll <- candidates ] @@ -283,8 +323,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 +338,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@@ -385,7 +429,7 @@ windowsHelpPage :: String-windowsHelpPage = "https://github.com/tmcdonell/cuda/blob/master/WINDOWS.markdown"+windowsHelpPage = "https://github.com/tmcdonell/cuda/blob/master/cuda/WINDOWS.md" windowsLinkerBugMsg :: FilePath -> String windowsLinkerBugMsg ldPath = printf (unlines msg) windowsHelpPage ldPath@@ -414,17 +458,18 @@ -- Runs CUDA detection procedure and stores .buildinfo to a file. -- generateAndStoreBuildInfo- :: Verbosity+ :: Maybe CWDPath+ -> Verbosity -> Bool -> Platform -> CompilerId- -> [FilePath]- -> [FilePath]+ -> [ExtraLibsPath]+ -> [ExtraIncludesPath] -> FilePath -> IO ()-generateAndStoreBuildInfo verbosity profile platform (CompilerId _ghcFlavor ghcVersion) extraLibs extraIncludes path = do+generateAndStoreBuildInfo cwd verbosity profile platform (CompilerId _ghcFlavor ghcVersion) extraLibs extraIncludes path = do installPath <- findCUDAInstallPath verbosity platform- hbi <- libraryBuildInfo verbosity profile installPath platform ghcVersion extraLibs extraIncludes+ hbi <- libraryBuildInfo cwd verbosity profile installPath platform ghcVersion extraLibs extraIncludes storeHookedBuildInfo verbosity path hbi storeHookedBuildInfo@@ -451,10 +496,10 @@ -> Platform -> IO FilePath findCUDAInstallPath verbosity platform = do- result <- findFirstValidLocation verbosity platform (candidateCUDAInstallPaths verbosity platform)+ result <- findFirstValidLocation verbosity platform =<< candidateCUDAInstallPaths verbosity platform case result of Just installPath -> do- notice verbosity $ printf "Found CUDA toolkit at: %s" installPath+ notice verbosity $ printf "Found CUDA toolkit at: %s (set CUDA_PATH to override this)" installPath return installPath Nothing -> die' verbosity cudaNotFoundMsg @@ -538,19 +583,15 @@ candidateCUDAInstallPaths :: Verbosity -> Platform- -> [(IO FilePath, String)]-candidateCUDAInstallPaths verbosity platform =- [ (getEnv "CUDA_PATH", "environment variable CUDA_PATH")- , (findInPath, "nvcc compiler executable in PATH")- , (return defaultPath, printf "default install location (%s)" defaultPath)- , (getEnv "CUDA_PATH_V9_1", "environment variable CUDA_PATH_V9_1")- , (getEnv "CUDA_PATH_V9_0", "environment variable CUDA_PATH_V9_0")- , (getEnv "CUDA_PATH_V8_0", "environment variable CUDA_PATH_V8_0")- , (getEnv "CUDA_PATH_V7_5", "environment variable CUDA_PATH_V7_5")- , (getEnv "CUDA_PATH_V7_0", "environment variable CUDA_PATH_V7_0")- , (getEnv "CUDA_PATH_V6_5", "environment variable CUDA_PATH_V6_5")- , (getEnv "CUDA_PATH_V6_0", "environment variable CUDA_PATH_V6_0")- ]+ -> IO [(IO FilePath, String)]+candidateCUDAInstallPaths verbosity platform = do+ let defaults =+ [ (getEnv "CUDA_PATH", "environment variable CUDA_PATH")+ , (findInPath, "nvcc compiler executable in PATH")+ , (return defaultPath, printf "default install location (%s)" defaultPath)+ ]+ verVars <- versionedVars+ return $ defaults ++ verVars where findInPath :: IO FilePath findInPath = do@@ -562,7 +603,22 @@ defaultPath :: FilePath defaultPath = defaultCUDAInstallPath platform + versionedVars :: IO [(IO FilePath, String)]+ versionedVars = do+ pairs <- getEnvironment+ let sorted = sort (mapMaybe (\(k, v) -> (,k,v) <$> parseCudaPathVerVar k) pairs)+ return [(return v, "environment variable " ++ k) | (_, k, v) <- sorted] + parseCudaPathVerVar :: String -> Maybe (Int, Int)+ parseCudaPathVerVar var+ | ("CUDA_PATH_V", s1) <- splitAt 11 var+ , (n1, '_':n2) <- span isDigit s1, not (null n1)+ , all isDigit n2, not (null n2)+ = Just (read n1, read n2)+ | otherwise+ = Nothing++ -- NOTE: this function throws an exception when there is no `nvcc` in PATH. -- The exception contains a meaningful message. --@@ -598,21 +654,22 @@ -- (generated one should be always present, as it is created in the post-conf step) -- getHookedBuildInfo- :: Verbosity+ :: Maybe CWDPath+ -> Verbosity -> IO HookedBuildInfo-getHookedBuildInfo verbosity = do- doesCustomBuildInfoExists <- doesFileExist customBuildInfoFilePath+getHookedBuildInfo cwd verbosity = do+ doesCustomBuildInfoExists <- doesFileExist (customBuildInfoFilePath) if doesCustomBuildInfoExists then do notice verbosity $ printf "The user-provided buildinfo from file %s will be used. To use default settings, delete this file.\n" customBuildInfoFilePath- readHookedBuildInfo verbosity customBuildInfoFilePath+ readHookedBuildInfoWithCWD verbosity cwd (makeSymbolicPath customBuildInfoFilePath) else do doesGeneratedBuildInfoExists <- doesFileExist generatedBuildInfoFilePath if doesGeneratedBuildInfoExists then do notice verbosity $ printf "Using build information from '%s'.\n" generatedBuildInfoFilePath notice verbosity $ printf "Provide a '%s' file to override this behaviour.\n" customBuildInfoFilePath- readHookedBuildInfo verbosity generatedBuildInfoFilePath+ readHookedBuildInfoWithCWD verbosity cwd (makeSymbolicPath generatedBuildInfoFilePath) else die' verbosity $ printf "Unexpected failure. Neither the default %s nor custom %s exist.\n" generatedBuildInfoFilePath customBuildInfoFilePath @@ -631,6 +688,9 @@ #endif = PreProcessor { platformIndependent = False,+#if MIN_VERSION_Cabal(3,8,0)+ ppOrdering = unsorted,+#endif runPreProcessor = \(inBaseDir, inRelativeFile) (outBaseDir, outRelativeFile) verbosity -> runDbProgram verbosity c2hsProgram (withPrograms lbi) . filter (not . null) $@@ -645,7 +705,7 @@ getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] getCppOptions bi lbi = hcDefines (compiler lbi)- ++ ["-I" ++ dir | dir <- includeDirs bi]+ ++ ["-I" ++ interpretSymbolicPath (lbiCWD lbi) dir | dir <- includeDirs bi] ++ [opt | opt@('-':c:_) <- ccOptions bi, c `elem` "DIU"] hcDefines :: Compiler -> [String]@@ -677,5 +737,65 @@ #if !MIN_VERSION_Cabal(2,0,0) die' :: Verbosity -> String -> IO a die' _ = die+#endif+++-- Compatibility across Cabal 3.14 symbolic paths.+-- If we want to drop pre-Cabal-3.14 compatibility at some point, this should all be merged in above.++lbiCWD :: LocalBuildInfo -> Maybe CWDPath++#if MIN_VERSION_Cabal(3,14,0)+type ExtraLibsPath = SymbolicPath Pkg ('Dir Lib)+type ExtraIncludesPath = SymbolicPath Pkg ('Dir Include)+type CWDPath = SymbolicPath CWD ('Dir Pkg)++regVerbosity :: RegisterFlags -> Flag Verbosity+regVerbosity = setupVerbosity . registerCommonFlags++workingDirFlag :: HasCommonFlags flags => flags -> Flag CWDPath+workingDirFlag = setupWorkingDir . getCommonFlags++lbiCWD = flagToMaybe . setupWorkingDir . configCommonFlags . LBC.configFlags . LBC.packageBuildDescr . localBuildDescr++-- makeSymbolicPath is an actual useful function in Cabal 3.14+-- makeRelativePathEx is an actual useful function in Cabal 3.14+-- interpretSymbolicPath is an actual useful function in Cabal 3.14++class HasCommonFlags flags where getCommonFlags :: flags -> CommonSetupFlags+instance HasCommonFlags BuildFlags where getCommonFlags = buildCommonFlags+instance HasCommonFlags CleanFlags where getCommonFlags = cleanCommonFlags+instance HasCommonFlags ConfigFlags where getCommonFlags = configCommonFlags+instance HasCommonFlags CopyFlags where getCommonFlags = copyCommonFlags+instance HasCommonFlags InstallFlags where getCommonFlags = installCommonFlags+instance HasCommonFlags HscolourFlags where getCommonFlags = hscolourCommonFlags+instance HasCommonFlags HaddockFlags where getCommonFlags = haddockCommonFlags+instance HasCommonFlags RegisterFlags where getCommonFlags = registerCommonFlags++readHookedBuildInfoWithCWD :: Verbosity -> Maybe CWDPath -> SymbolicPath Pkg 'File -> IO HookedBuildInfo+readHookedBuildInfoWithCWD = readHookedBuildInfo+#else+type ExtraLibsPath = FilePath+type ExtraIncludesPath = FilePath+type CWDPath = ()++-- regVerbosity is still present as an actual field in Cabal 3.12++workingDirFlag :: flags -> Flag CWDPath+workingDirFlag _ = NoFlag++lbiCWD _ = Nothing++makeSymbolicPath :: FilePath -> FilePath+makeSymbolicPath = id++makeRelativePathEx :: FilePath -> FilePath+makeRelativePathEx = id++interpretSymbolicPath :: Maybe CWDPath -> FilePath -> FilePath+interpretSymbolicPath _ = id++readHookedBuildInfoWithCWD :: Verbosity -> Maybe CWDPath -> FilePath -> IO HookedBuildInfo+readHookedBuildInfoWithCWD verb _ path = readHookedBuildInfo verb path #endif
− WINDOWS.markdown
@@ -1,54 +0,0 @@-Using the CUDA package on Windows-=================================--The CUDA package works on Windows and is actively maintained. If you encounter-any other issues, please report them.--Note that if you build your applications for the Windows 64-bit architecture,-you'll need to update your `ld.exe` as described below.---Windows 64-bit-----------------There is a known issue with the version of `ld.exe` that ships with the 64-bit-versions of (at least) GHC-7.8.4 and GHC-7.10.2. The version of `ld.exe` that-ships with these GHC distributions does not properly link against MS-style-dynamic libraries (such as those that ship with the CUDA toolkit), causing the-application to crash at runtime once those library routines are called. The-configure step will fail if it detects an old version of `ld.exe` (< 2.25.1),-which are known to be broken.--If you are using the 64-bit GHC distributions mentioned above, you will need to-apply the following steps. This bug does not affect 32-bit GHC distributions.-The bug has been fixed in MinGW binutils `ld.exe` >= 2.25.1, so it is expected-that newer releases of GHC will not have this issue.--The problem is fixed by replacing the linker binary `ld.exe` with the newer-(patched) version, available as part of the MSys2 binutils package here:--> <http://repo.msys2.org/mingw/x86_64/mingw-w64-x86_64-binutils-2.25.1-1-any.pkg.tar.xz>--The updated `ld.exe` binary must replace the version at the path:--> `GHC_PATH\mingw\x86_64-w64-mingw32\bin\`--Note that there is another copy of `ld.exe` located at `GHC_PATH\mingw\bin\`,-but this version does not seem to be used, so replacing it as well is not-necessary. It is not sufficient to replace whatever version of `ld.exe` appears-first in your `PATH`.--Please note that having another MinGW installation in `PATH` before the one-shipped with GHC may break things, particularly if you mix 32/64-bit-distributions of MinGW and GHC.--For further discussion of the bug, see:-- * [CUDA package issue][cuda31]- * [GHC issue][ghc10885]- * [binutils issue][binutils16598]-- [cuda31]: https://github.com/tmcdonell/cuda/issues/31- [ghc10885]: https://ghc.haskell.org/trac/ghc/ticket/10885- [binutils16598]: https://sourceware.org/bugzilla/show_bug.cgi?id=16598-
+ WINDOWS.md view
@@ -0,0 +1,54 @@+Using the CUDA package on Windows+=================================++The CUDA package works on Windows and is actively maintained. If you encounter+any other issues, please report them.++Note that if you build your applications for the Windows 64-bit architecture,+you'll need to update your `ld.exe` as described below.+++Windows 64-bit+--------------++There is a known issue with the version of `ld.exe` that ships with the 64-bit+versions of (at least) GHC-7.8.4 and GHC-7.10.2. The version of `ld.exe` that+ships with these GHC distributions does not properly link against MS-style+dynamic libraries (such as those that ship with the CUDA toolkit), causing the+application to crash at runtime once those library routines are called. The+configure step will fail if it detects an old version of `ld.exe` (< 2.25.1),+which are known to be broken.++If you are using the 64-bit GHC distributions mentioned above, you will need to+apply the following steps. This bug does not affect 32-bit GHC distributions.+The bug has been fixed in MinGW binutils `ld.exe` >= 2.25.1, so it is expected+that newer releases of GHC will not have this issue.++The problem is fixed by replacing the linker binary `ld.exe` with the newer+(patched) version, available as part of the MSys2 binutils package here:++> <http://repo.msys2.org/mingw/x86_64/mingw-w64-x86_64-binutils-2.25.1-1-any.pkg.tar.xz>++The updated `ld.exe` binary must replace the version at the path:++> `GHC_PATH\mingw\x86_64-w64-mingw32\bin\`++Note that there is another copy of `ld.exe` located at `GHC_PATH\mingw\bin\`,+but this version does not seem to be used, so replacing it as well is not+necessary. It is not sufficient to replace whatever version of `ld.exe` appears+first in your `PATH`.++Please note that having another MinGW installation in `PATH` before the one+shipped with GHC may break things, particularly if you mix 32/64-bit+distributions of MinGW and GHC.++For further discussion of the bug, see:++ * [CUDA package issue][cuda31]+ * [GHC issue][ghc10885]+ * [binutils issue][binutils16598]++ [cuda31]: https://github.com/tmcdonell/cuda/issues/31+ [ghc10885]: https://ghc.haskell.org/trac/ghc/ticket/10885+ [binutils16598]: https://sourceware.org/bugzilla/show_bug.cgi?id=16598+
cbits/stubs.c view
@@ -3,52 +3,9 @@ */ #include "cbits/stubs.h"---cudaError_t-cudaConfigureCallSimple-(- int gridX, int gridY,- int blockX, int blockY, int blockZ,- size_t sharedMem,- cudaStream_t stream-)-{- dim3 gridDim = {gridX, gridY, 1};- dim3 blockDim = {blockX,blockY,blockZ};-- return cudaConfigureCall(gridDim, blockDim, sharedMem, stream);-}--CUresult-cuTexRefSetAddress2DSimple-(- CUtexref tex,- CUarray_format format,- unsigned int numChannels,- CUdeviceptr dptr,- size_t width,- size_t height,- size_t pitch-)-{- CUDA_ARRAY_DESCRIPTOR desc;- desc.Format = format;- desc.NumChannels = numChannels;- desc.Width = width;- desc.Height = height;-- return cuTexRefSetAddress2D(tex, &desc, dptr, pitch);-}+#include <string.h> // memset -CUresult-cuMemcpy2DHtoD-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-)+CUresult cuMemcpy2DHtoD(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height) { CUDA_MEMCPY2D desc; @@ -75,15 +32,7 @@ return cuMemcpy2D(&desc); } -CUresult-cuMemcpy2DHtoDAsync-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-)+CUresult cuMemcpy2DHtoDAsync(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream) { CUDA_MEMCPY2D desc; @@ -110,14 +59,7 @@ return cuMemcpy2DAsync(&desc, hStream); } -CUresult-cuMemcpy2DDtoH-(- void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-)+CUresult cuMemcpy2DDtoH(void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height) { CUDA_MEMCPY2D desc; @@ -144,15 +86,7 @@ return cuMemcpy2D(&desc); } -CUresult-cuMemcpy2DDtoHAsync-(- void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-)+CUresult cuMemcpy2DDtoHAsync(void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream) { CUDA_MEMCPY2D desc; @@ -179,14 +113,7 @@ return cuMemcpy2DAsync(&desc, hStream); } -CUresult-cuMemcpy2DDtoD-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-)+CUresult cuMemcpy2DDtoD(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height) { CUDA_MEMCPY2D desc; @@ -213,15 +140,7 @@ return cuMemcpy2D(&desc); } -CUresult-cuMemcpy2DDtoDAsync-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-)+CUresult cuMemcpy2DDtoDAsync(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream) { CUDA_MEMCPY2D desc; @@ -260,7 +179,13 @@ CUresult CUDAAPI cuCtxCreate(CUcontext *pctx, unsigned int flags, CUdevice dev) {+#if CUDA_VERSION >= 13000+ CUctxCreateParams params;+ memset(¶ms, 0, sizeof params);+ return cuCtxCreate_v4(pctx, ¶ms, flags, dev);+#else return cuCtxCreate_v2(pctx, flags, dev);+#endif } CUresult CUDAAPI cuModuleGetGlobal(CUdeviceptr *dptr, size_t *bytes, CUmodule hmod, const char *name)@@ -337,11 +262,6 @@ { return cuMemsetD32_v2(dstDevice, ui, N); }--CUresult CUDAAPI cuTexRefSetAddress(size_t *ByteOffset, CUtexref hTexRef, CUdeviceptr dptr, size_t bytes)-{- return cuTexRefSetAddress_v2(ByteOffset, hTexRef, dptr, bytes);-} #endif #if CUDA_VERSION >= 4000@@ -393,3 +313,117 @@ } #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++#if CUDA_VERSION >= 10010+CUresult CUDAAPI cuStreamBeginCapture(CUstream hStream, CUstreamCaptureMode mode)+{+ return cuStreamBeginCapture_v2(hStream, mode);+}++CUresult CUDAAPI cuGraphExecKernelNodeSetParams_simple(CUgraphExec hGraphExec, CUgraphNode hNode, 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 cuGraphExecKernelNodeSetParams(hGraphExec, hNode, &nodeParams);+}+#endif++#if CUDA_VERSION >= 13000+// This is the signature of the CUDA <=12 version; much easier to shim here than in Haskell.+CUresult cuMemAdvise_device(CUdeviceptr dptr, size_t count, CUmem_advise advice, CUdevice device)+{+ return cuMemAdvise(dptr, count, advice, (CUmemLocation){.id = device, .type = CU_MEM_LOCATION_TYPE_DEVICE});+}++// This is the signature of the CUDA <=12 version; much easier to shim here than in Haskell.+CUresult cuMemPrefetchAsync_device(CUdeviceptr dptr, size_t count, CUdevice device, CUstream hStream)+{+ // flags is reserved and must be 0 in CUDA 13+ return cuMemPrefetchAsync(dptr, count, (CUmemLocation){.id = device, .type = CU_MEM_LOCATION_TYPE_DEVICE}, 0, hStream);+}+#endif
cbits/stubs.h view
@@ -21,84 +21,13 @@ void enable_constructors(); -cudaError_t-cudaConfigureCallSimple-(- int gridX, int gridY,- int blockX, int blockY, int blockZ,- size_t sharedMem,- cudaStream_t stream-);--CUresult-cuTexRefSetAddress2DSimple-(- CUtexref tex,- CUarray_format format,- unsigned int numChannels,- CUdeviceptr dptr,- size_t width,- size_t height,- size_t pitch-);--CUresult-cuMemcpy2DHtoD-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-);--CUresult-cuMemcpy2DHtoDAsync-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-);--CUresult-cuMemcpy2DDtoH-(- void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-);--CUresult-cuMemcpy2DDtoHAsync-(- void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-);--CUresult-cuMemcpy2DDtoD-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height-);--CUresult-cuMemcpy2DDtoDAsync-(- CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY,- CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY,- unsigned int widthInBytes,- unsigned int height,- CUstream hStream-);-+CUresult cuTexRefSetAddress2D_simple(CUtexref tex, CUarray_format format, unsigned int numChannels, CUdeviceptr dptr, size_t width, size_t height, size_t pitch);+CUresult cuMemcpy2DHtoD(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height);+CUresult cuMemcpy2DHtoDAsync(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, void* srcHost, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream);+CUresult cuMemcpy2DDtoH(void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height);+CUresult cuMemcpy2DDtoHAsync(void* dstHost, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream);+CUresult cuMemcpy2DDtoD(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height);+CUresult cuMemcpy2DDtoDAsync(CUdeviceptr dstDevice, unsigned int dstPitch, unsigned int dstXInBytes, unsigned int dstY, CUdeviceptr srcDevice, unsigned int srcPitch, unsigned int srcXInBytes, unsigned int srcY, unsigned int widthInBytes, unsigned int height, CUstream hStream); /* * Need to re-export some symbols as they are now generated by #defines, which@@ -216,6 +145,42 @@ CUresult CUDAAPI cuLinkCreate(unsigned int numOptions, CUjit_option *options, void **optionValues, CUlinkState *stateOut); CUresult CUDAAPI cuLinkAddData(CUlinkState state, CUjitInputType type, void *data, size_t size, const char *name, unsigned int numOptions, CUjit_option *options, void **optionValues); 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++#if CUDA_VERSION >= 10010+#undef cuStreamBeginCapture++CUresult CUDAAPI cuStreamBeginCapture(CUstream hStream, CUstreamCaptureMode mode);+CUresult CUDAAPI cuGraphExecKernelNodeSetParams_simple(CUgraphExec hGraphExec, CUgraphNode hNode, 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);+#endif++#if CUDA_VERSION >= 11000+#undef cuGraphInstantiate+#undef cuDevicePrimaryCtxRelease+#undef cuDevicePrimaryCtxReset+#undef cuDevicePrimaryCtxSetFlags++CUresult CUDAAPI cuGraphInstantiate(CUgraphExec *phGraphExec, CUgraph hGraph, CUgraphNode *phErrorNode, char *logBuffer, size_t bufferSize);+CUresult CUDAAPI cuDevicePrimaryCtxRelease(CUdevice dev);+CUresult CUDAAPI cuDevicePrimaryCtxReset(CUdevice dev);+CUresult CUDAAPI cuDevicePrimaryCtxSetFlags(CUdevice dev, unsigned int flags);+#endif++#if CUDA_VERSION >= 11010+#undef cuIpcOpenMemHandle+CUresult CUDAAPI cuIpcOpenMemHandle(CUdeviceptr *pdptr, CUipcMemHandle handle, unsigned int Flags);+#endif++#if CUDA_VERSION >= 13000+CUresult cuMemAdvise_device(CUdeviceptr dptr, size_t count, CUmem_advise advice, CUdevice device);+CUresult cuMemPrefetchAsync_device(CUdeviceptr dptr, size_t count, CUdevice device, CUstream hStream); #endif #ifdef __cplusplus
cuda.cabal view
@@ -1,6 +1,8 @@+cabal-version: 1.24+ Name: cuda-Version: 0.9.0.3-Synopsis: FFI binding to the CUDA interface for programming NVIDIA GPUs+Version: 0.13.0.0+Synopsis: FFI binding to the CUDA driver interface for programming NVIDIA GPUs Description: The CUDA library provides a direct, general purpose C-like SPMD programming model for NVIDIA graphics cards (G8x series onwards). This is a collection@@ -19,76 +21,61 @@ . 3. Checking at @\/usr\/local\/cuda@ .- 4. @CUDA_PATH_Vx_y@ environment variable, for recent CUDA toolkit versions x.y- .- This library provides bindings to both the CUDA Driver and Runtime APIs. To- get started, see one of:- .- * "Foreign.CUDA.Driver" (a short tutorial is available here)+ 4. Environment variables of the form @CUDA_PATH_Vx_y@ (deprecated) .- * "Foreign.CUDA.Runtime"+ This library provides bindings to the CUDA Driver API, not the Runtime API.+ To get started, see "Foreign.CUDA.Driver"; a short tutorial is available+ there. .- See the <https://travis-ci.org/tmcdonell/cuda travis-ci.org> build matrix- for tested CUDA library versions.+ Tested with library versions up to and including CUDA-13.0. . [/NOTES:/] .- The setup script for this package requires at least Cabal-1.24. To upgrade,- execute one of:- .- * cabal users: @cabal install Cabal --constraint="Cabal >= 1.24"@- .- * stack users: @stack setup --upgrade-cabal@- .- Due to an interaction between GHC-8 and unified virtual address spaces in- CUDA, this package does not currently work with GHCi on ghc-8.0.1 (compiled- programs should work). See the following for more details:- .- * <https://github.com/tmcdonell/cuda/issues/39>- .- * <https://ghc.haskell.org/trac/ghc/ticket/12573>- .- The bug should be fixed in ghc-8.0.2 and beyond.- . For additional notes on installing on Windows, see: .- * <https://github.com/tmcdonell/cuda/blob/master/WINDOWS.markdown>+ * <https://github.com/tmcdonell/cuda/blob/master/WINDOWS.md> .+ This library is currently in __maintenance mode__. While we are happy to+ release updates to keep the existing interface working with newer CUDA+ versions (as long as the underlying APIs remain available), no binding of+ new features is planned at the moment. Get in touch if you want to+ contribute. 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..2023]. Trevor L. McDonell <trevor.mcdonell@gmail.com>+Author: Trevor L. McDonell <trevor.mcdonell@gmail.com>+Maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com>,+ Tom Smeding <tom@tomsmeding.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 >= 8.0 Build-type: Custom -Extra-tmp-files: cuda.buildinfo.generated+Extra-tmp-files:+ cuda.buildinfo.generated -Extra-source-files: cbits/stubs.h- CHANGELOG.markdown- README.markdown- WINDOWS.markdown+Extra-source-files:+ cbits/stubs.h +Extra-doc-files:+ CHANGELOG.md+ README.md+ WINDOWS.md+ custom-setup setup-depends:- base >= 4.6- , Cabal >= 1.24+ base >= 4.7 && < 5+ , Cabal >= 1.24 && < 3.17 , directory >= 1.0 , filepath >= 1.0 Library hs-source-dirs: src- Exposed-Modules:- Foreign.CUDA+ exposed-modules: Foreign.CUDA.Path Foreign.CUDA.Ptr- Foreign.CUDA.Types -- Kernel and device analysis Foreign.CUDA.Analysis@@ -106,6 +93,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@@ -115,38 +106,29 @@ Foreign.CUDA.Driver.Module.Query Foreign.CUDA.Driver.Profiler Foreign.CUDA.Driver.Stream- Foreign.CUDA.Driver.Texture Foreign.CUDA.Driver.Unified Foreign.CUDA.Driver.Utils - -- Runtime API- Foreign.CUDA.Runtime- Foreign.CUDA.Runtime.Device- Foreign.CUDA.Runtime.Error- Foreign.CUDA.Runtime.Event- Foreign.CUDA.Runtime.Exec- Foreign.CUDA.Runtime.Marshal- Foreign.CUDA.Runtime.Stream- Foreign.CUDA.Runtime.Texture- Foreign.CUDA.Runtime.Utils-- Other-modules:+ -- Extras+ Foreign.C.Extra Foreign.CUDA.Internal.C2HS- Text.Show.Describe+ Foreign.CUDA.Internal.Describe - Include-dirs: .- C-sources: cbits/stubs.c+ include-dirs: .+ c-sources: cbits/stubs.c cbits/init.c - Build-tools: c2hs >= 0.21- Build-depends:- base >= 4 && < 5- , bytestring+ build-tools: c2hs >= 0.21+ build-depends:+ base >= 4.7 && < 5+ , bytestring >= 0.10.4+ , containers , filepath >= 1.0 , template-haskell+ , uuid-types >= 1.0 default-language: Haskell98- Extensions:+ ghc-options: -Wall -O2@@ -154,19 +136,15 @@ -fwarn-tabs -fno-warn-unused-imports - ghc-prof-options:- -fprof-auto- -fprof-cafs- if impl(ghc == 8.0.1) cpp-options: -DCUDA_PRELOAD Executable nvidia-device-query- Main-is: DeviceQuery.hs+ main-is: DeviceQuery.hs hs-source-dirs: examples/src/deviceQueryDrv - Build-depends:+ build-depends: base >= 4 && < 5 , cuda , pretty@@ -181,6 +159,6 @@ source-repository this type: git location: https://github.com/tmcdonell/cuda- tag: 0.9.0.3+ tag: v0.13.0.0 -- vim: nospell
examples/src/deviceQueryDrv/DeviceQuery.hs view
@@ -1,13 +1,17 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} module Main where -import Numeric import Control.Monad-import Text.Printf-import Text.PrettyPrint+import Foreign.Marshal.Utils ( toBool )+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 +30,120 @@ 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 - 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)]++ - bool True = text "Yes"- bool False = text "No"+ $(if CUDA.libraryVersion >= 13000 then [|+ [("Concurrent copy and kernel execution:", bool concurrentKernels <> text (printf " with %d copy engine%s" asyncEngineCount (if asyncEngineCount > 1 then "s" else "")))]+ |] else [|+ [("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 "")))]+ |])++ - 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))+ [("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 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)]+ |] else [|[]|])++++ $(if CUDA.libraryVersion >= 9000 && CUDA.libraryVersion < 13000 then [|+ [("Supports multi-device cooperative launch:", bool cooperativeLaunchMultiDevice)]+ |] else [|[]|])++++ [("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..2023] 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.hs
@@ -1,19 +0,0 @@------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Top level bindings. By default, expose the C-for-CUDA runtime API bindings,--- as they are slightly more user friendly.--------------------------------------------------------------------------------------module Foreign.CUDA (-- module Foreign.CUDA.Runtime--) where--import Foreign.CUDA.Runtime-
src/Foreign/CUDA/Analysis.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] 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..2023] Trevor L. McDonell -- License : BSD -- -- Common device functions@@ -19,8 +19,12 @@ #include "cbits/stubs.h" +import qualified Data.Set as Set+import Data.Set (Set) import Data.Int-import Text.Show.Describe+import Data.IORef+import Foreign.CUDA.Internal.Describe+import System.IO.Unsafe import Debug.Trace @@ -28,13 +32,19 @@ -- | -- The compute mode the device is currently in --+#if CUDA_VERSION < 13000 {# enum CUcomputemode as ComputeMode { underscoreToCase } with prefix="CU_COMPUTEMODE" deriving (Eq, Show) #}+#else+{# enum cudaComputeMode as ComputeMode+ { }+ with prefix="cudaComputeMode" deriving (Eq, Show) #}+#endif instance Describe ComputeMode where describe Default = "Multiple contexts are allowed on the device simultaneously"-#if CUDA_VERSION < 8000+#if CUDA_VERSION < 8000 || CUDA_VERSION >= 13000 describe Exclusive = "Only one context used by a single thread can be present on this device at a time" #endif describe Prohibited = "No contexts can be created on this device at this time"@@ -65,73 +75,87 @@ --} -- |--- The properties of a compute device+-- Some properties of a compute device. Originally, this mirrored+-- @struct cudaDeviceProp@ in CUDA, but since CUDA 13 some fields have been+-- removed from that struct, and this data type keeps them for backwards+-- compatibility. --+-- There are more device "properties" than those listed in this data type; use+-- 'Foreign.CUDA.Driver.Device.attribute' to query them.+-- 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) @@ -142,6 +166,8 @@ -- wikipedia entry: <https://en.wikipedia.org/wiki/CUDA#Version_features_and_specifications> -- data Allocation = Warp | Block+ deriving Show+ data DeviceResources = DeviceResources { threadsPerWarp :: !Int -- ^ Warp size , coresPerMP :: !Int -- ^ Number of SIMD arithmetic units per multiprocessor@@ -158,7 +184,9 @@ , 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) }+ deriving Show -- |@@ -167,7 +195,17 @@ deviceResources :: DeviceProperties -> DeviceResources deviceResources = resources . computeCapability where- -- This is mostly extracted from tables in the CUDA occupancy calculator.+ -- Sources:+ -- [1] https://github.com/NVIDIA/cuda-samples/blob/7b60178984e96bc09d066077d5455df71fee2a9f/Common/helper_cuda.h+ -- - for: coresPerMP (line 643 _ConvertSMVer2Cores)+ -- - for: architecture names (line 695 _ConvertSMVer2ArchName)+ -- [2] https://docs.nvidia.com/cuda/cuda-c-programming-guide/index.html#features-and-technical-specifications-technical-specifications-per-compute-capability+ -- - for: maxGridsPerDevice+ -- - archived here: https://web.archive.org/web/20250409220108/https://docs.nvidia.com/cuda/cuda-c-programming-guide/index.html#features-and-technical-specifications-technical-specifications-per-compute-capability+ -- - reproduced here: https://en.wikipedia.org/w/index.php?title=CUDA&oldid=1285775690#Technical_specification (note: link to specific page version)+ -- [3] NVidia Nsight Compute+ -- - for: the other fields+ -- - left top "Start Activity" -> "Occupancy Calculator" -> "Launch"; tab "GPU Data" -- resources compute = case compute of Compute 1 0 -> resources (Compute 1 1) -- Tesla G80@@ -187,6 +225,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 +252,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 +274,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,15 +305,17 @@ , sharedMemAllocUnit = 256 , warpAllocUnit = 4 , warpRegAllocUnit = 256+ , maxGridsPerDevice = 32 } Compute 5 2 -> (resources (Compute 5 0)) -- Maxwell GM20x { sharedMemPerMP = 98304- , maxRegPerBlock = 32768+ , maxRegPerBlock = 32768 -- value from [3], wrong in [2]? , warpAllocUnit = 2 } Compute 5 3 -> (resources (Compute 5 0)) -- Maxwell GM20B { maxRegPerBlock = 32768 , warpAllocUnit = 2+ , maxGridsPerDevice = 16 } Compute 6 0 -> DeviceResources -- Pascal GP100@@ -287,19 +334,166 @@ , 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+ -- Commit 4f75ea889c2ade2bd3eab377b51bb5bbd28bfbae changed warpsPerMP+ -- to 128, but [2] and [3] say 64 like CC 6.0; reverted back to 64 to+ -- match NVIDIA documentation.+ -- That commit also changed threadsPerMP (later mistakenly translated+ -- to threadBlocksPerMP in 9df19adec8efc9df761deab40cf04d27810d97d3)+ -- from 2048 to 4096, but again [2] and [3] retain 2048 so we keep it+ -- at that.+ , warpsPerMP = 64+ , maxRegPerBlock = 32768 -- value from [2], wrong in [3]? , warpAllocUnit = 4+ , maxGridsPerDevice = 16 } + Compute 7 0 -> DeviceResources -- Volta GV100+ { threadsPerWarp = 32+ , coresPerMP = 64+ , warpsPerMP = 64+ , threadsPerMP = 2048+ , threadBlocksPerMP = 32+ , sharedMemPerMP = 98304 -- of 128KB+ , maxSharedMemPerBlock = 98304+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 256+ , warpAllocUnit = 4+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128+ }++ Compute 7 2 -> (resources (Compute 7 0)) -- Volta GV10B+ { maxGridsPerDevice = 16+ , maxSharedMemPerBlock = 49152 -- unsure why this is here; [2] and [3] say still 98304+ }++ Compute 7 5 -> (resources (Compute 7 0)) -- Turing TU1xx+ { warpsPerMP = 32+ , threadBlocksPerMP = 16+ , threadsPerMP = 1024+ , maxGridsPerDevice = 128+ , sharedMemPerMP = 65536 -- of 96KB+ , maxSharedMemPerBlock = 65536+ }++ Compute 8 0 -> DeviceResources -- Ampere GA100+ { threadsPerWarp = 32+ , coresPerMP = 64+ , warpsPerMP = 64+ , threadsPerMP = 2048+ , threadBlocksPerMP = 32+ , sharedMemPerMP = 167936 -- of 192KB+ , maxSharedMemPerBlock = 167936+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 128+ , warpAllocUnit = 4+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128+ }+ Compute 8 6 -> (resources (Compute 8 0)) -- Ampere GA102+ { coresPerMP = 128+ , warpsPerMP = 48+ , threadsPerMP = 1536+ , threadBlocksPerMP = 16+ , sharedMemPerMP = 102400+ , maxSharedMemPerBlock = 102400+ }+ Compute 8 7 -> (resources (Compute 8 0)) -- Ampere+ { coresPerMP = 128+ , warpsPerMP = 48+ , threadsPerMP = 1536+ , threadBlocksPerMP = 16+ }+ Compute 8 9 -> (resources (Compute 8 0)) -- Ada+ { coresPerMP = 128+ , warpsPerMP = 48+ , threadsPerMP = 1536+ , threadBlocksPerMP = 24+ , sharedMemPerMP = 102400+ , maxSharedMemPerBlock = 102400+ }++ Compute 9 0 -> DeviceResources -- Hopper+ { threadsPerWarp = 32+ , coresPerMP = 128+ , warpsPerMP = 64+ , threadsPerMP = 2048+ , threadBlocksPerMP = 32+ , sharedMemPerMP = 233472+ , maxSharedMemPerBlock = 233472+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 128+ , warpAllocUnit = 4+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128+ }++ Compute 10 0 -> DeviceResources -- Blackwell+ { threadsPerWarp = 32+ , coresPerMP = 128+ , warpsPerMP = 64+ , threadsPerMP = 2048+ , threadBlocksPerMP = 32+ , sharedMemPerMP = 233472+ , maxSharedMemPerBlock = 233472+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 128+ , warpAllocUnit = 4+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128+ }+ Compute 10 1 -> (resources (Compute 10 0)) -- Blackwell+ { warpsPerMP = 48+ , threadsPerMP = 1536+ , threadBlocksPerMP = 24+ }++ Compute 12 0 -> DeviceResources -- Blackwell+ { threadsPerWarp = 32+ , coresPerMP = 128+ , warpsPerMP = 48+ , threadsPerMP = 1536+ , threadBlocksPerMP = 24+ , sharedMemPerMP = 102400+ , maxSharedMemPerBlock = 102400+ , regFileSizePerMP = 65536+ , maxRegPerBlock = 65536+ , regAllocUnit = 256+ , regAllocationStyle = Warp+ , maxRegPerThread = 255+ , sharedMemAllocUnit = 128+ , warpAllocUnit = 4+ , warpRegAllocUnit = 256+ , maxGridsPerDevice = 128+ }++ -- Something might have gone wrong, or the library just needs to be -- updated for the next generation of hardware, in which case we just want -- to pick a sensible default and carry on.@@ -308,7 +502,30 @@ -- However, it should be OK because all library functions run in IO, so it -- is likely the user code is as well. --- _ -> trace warning $ resources (Compute 3 0)- where warning = unlines [ "*** Warning: Unknown CUDA device compute capability: " ++ show compute- , "*** Please submit a bug report at https://github.com/tmcdonell/cuda/issues" ]+ _ -> case warningForCC compute of+ Just warning -> trace warning defaultResources+ Nothing -> defaultResources + defaultResources = resources (Compute 6 0)++ -- All this logic is to ensure the warning is only shown once per unknown+ -- compute capability. This sounds not worth it, but in practice, it is:+ -- empirically, an unknown compute capability often leads to /screenfuls/+ -- of warnings in accelerate-llvm-ptx otherwise.+ {-# NOINLINE warningForCC #-}+ warningForCC :: Compute -> Maybe String+ warningForCC compute = unsafePerformIO $ do+ unseen <- atomicModifyIORef' warningShown $ \seen ->+ -- This is just one tree traversal; lookup-insert would be two traversals.+ let seen' = Set.insert compute seen+ in (seen', Set.size seen' > Set.size seen)+ return $ if unseen+ then Just $ unlines+ [ "*** Warning: Unknown CUDA device compute capability: " ++ show compute+ , "*** Please submit a bug report at https://github.com/tmcdonell/cuda/issues"+ , "*** (This warning will only be shown once for this compute capability)" ]+ else Nothing++ {-# NOINLINE warningShown #-}+ warningShown :: IORef (Set Compute)+ warningShown = unsafePerformIO $ newIORef mempty
src/Foreign/CUDA/Analysis/Occupancy.hs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Analysis.Occupancy--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] Trevor L. McDonell -- License : BSD -- -- Occupancy calculations for CUDA kernels@@ -28,6 +28,14 @@ -- the number in the @.cubin@ file to the amount you dynamically allocate at run -- time to get the correct shared memory usage. --+-- __Warning__: Like the official Occupancy Calculator in NVidia Nsight+-- Compute, the calculator in this module does not support or consider Thread+-- Block Clusters+-- (<https://docs.nvidia.com/cuda/cuda-c-programming-guide/#thread-block-clusters>)+-- that have been introduced with compute capability 9.0 (Hopper). If you use+-- thread block clusters in your kernels, the results you get with the+-- functions in this module may not be accurate. Profile and measure.+-- -- /Notes About Occupancy/ -- -- Higher occupancy does not necessarily mean higher performance. If a kernel@@ -57,7 +65,7 @@ import Data.Ord import Data.List -import Foreign.CUDA.Analysis.Device+import Foreign.CUDA.Analysis.Device hiding ( maxSharedMemPerBlock ) -- GPU Occupancy per multiprocessor@@ -97,7 +105,8 @@ -- Physical resources --- gpu = deviceResources dev+ gpu = deviceResources dev+ maxSharedMemPerBlock = fromIntegral (sharedMemPerBlock dev) -- 2080Ti reports 48KB, but should be 64KB ! -- Allocated resource limits --@@ -116,16 +125,16 @@ -- Maximum thread blocks per multiprocessor --- limitDueToWarps = threadBlocksPerMP gpu `min` (warpsPerMP gpu `div` limitWarpsPerBlock)+ limitDueToWarps = threadBlocksPerMP gpu `min` (warpsPerMP gpu `div` limitWarpsPerBlock) limitDueToRegs- | regs > maxRegPerThread gpu = 0- | regs > 0 = (limitRegsPerSM `div` limitRegsPerBlock) * (regFileSizePerMP gpu `div` maxRegPerBlock gpu)- | otherwise = threadBlocksPerMP gpu+ | regs > maxRegPerThread gpu = 0+ | regs > 0 = (limitRegsPerSM `div` limitRegsPerBlock) * (regFileSizePerMP gpu `div` maxRegPerBlock gpu)+ | otherwise = threadBlocksPerMP gpu limitDueToSMem- | smem > maxSharedMemPerBlock gpu = 0- | smem > 0 = sharedMemPerMP gpu `div` limitSMemPerBlock- | otherwise = threadBlocksPerMP gpu+ | smem > maxSharedMemPerBlock = 0+ | smem > 0 = sharedMemPerMP gpu `div` limitSMemPerBlock+ | otherwise = threadBlocksPerMP gpu -- |
src/Foreign/CUDA/Driver.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] Trevor L. McDonell -- License : BSD -- -- This module defines an interface to the CUDA driver API. The Driver API@@ -31,7 +31,7 @@ -- Next, we must select a GPU that we will execute operations on. Each GPU -- is assigned a unique identifier (beginning at zero). We can get a handle -- to a compute device at a given ordinal using the 'device' operation.--- Given a device handle, we can query the properties of that device using+-- Given a device handle, we can query some properties of that device using -- 'props'. The number of available CUDA-capable devices is given via -- 'count'. For example: --@@ -228,12 +228,18 @@ ) where +-- If we don't import everything from a module below, the generated haddocks+-- will not have the convenient link to a module, but instead enumerate+-- documentation for everything which was imported. This, unfortunately, looks+-- like garbage, so it would be nice to find a better solution.+-- -- TLM 2018-11-18+-- import Foreign.CUDA.Ptr-import Foreign.CUDA.Driver.Context hiding ( useContext, device )-import Foreign.CUDA.Driver.Device hiding ( useDevice )+import Foreign.CUDA.Driver.Context hiding ( device )+import Foreign.CUDA.Driver.Device import Foreign.CUDA.Driver.Error import Foreign.CUDA.Driver.Exec-import Foreign.CUDA.Driver.Marshal hiding ( useDeviceHandle, peekDeviceHandle )+import Foreign.CUDA.Driver.Marshal import Foreign.CUDA.Driver.Module import Foreign.CUDA.Driver.Unified import Foreign.CUDA.Driver.Utils
src/Foreign/CUDA/Driver/Context.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Context--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] 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..2023] 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..2023] 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..2023] 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..2023] 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..2023] 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,71 @@ -- <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.+--+-- Since CUDA-13: If the device is in MIG mode, this function returns its MIG+-- UUID which uniquely identifies the subscribed MIG compute instance.+--+-- 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 #-}+#if CUDA_VERSION < 13000+ {# fun unsafe cuDeviceGetUuid+ { `Ptr ()'+ , useDevice `Device'+ } -> `()' checkStatus*- #}+#else+ {# fun unsafe cuDeviceGetUuid_v2 as cuDeviceGetUuid+ { `Ptr ()'+ , useDevice `Device'+ } -> `()' checkStatus*- #}+#endif++ {-# 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++ -- | -- Return the properties of the selected device --@@ -257,127 +314,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 +402,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..2023] Trevor L. McDonell -- License : BSD -- -- Error handling@@ -17,13 +17,13 @@ Status(..), CUDAException(..), describe, cudaError, cudaErrorIO, requireSDK,- resultIfOk, nothingIfOk,+ resultIfOk, nothingIfOk, checkStatus, ) where -- Friends import Foreign.CUDA.Internal.C2HS-import Text.Show.Describe+import Foreign.CUDA.Internal.Describe -- System import Control.Exception@@ -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..2023] Trevor L. McDonell -- License : BSD -- -- Event management for low-level driver interface@@ -25,19 +28,49 @@ {# 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+++-------------------------------------------------------------------------------- -- Event management -------------------------------------------------------------------------------- @@ -81,10 +114,17 @@ elapsedTime !ev1 !ev2 = resultIfOk =<< cuEventElapsedTime ev1 ev2 {-# INLINE cuEventElapsedTime #-}+#if CUDA_VERSION < 13000 {# fun unsafe cuEventElapsedTime { alloca- `Float' peekFloatConv* , useEvent `Event' , useEvent `Event' } -> `Status' cToEnum #}+#else+{# fun unsafe cuEventElapsedTime_v2 as cuEventElapsedTime+ { alloca- `Float' peekFloatConv*+ , useEvent `Event'+ , useEvent `Event' } -> `Status' cToEnum #}+#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..2023] 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,@@ -352,7 +352,6 @@ } -> `Status' cToEnum #} #endif --- TODO: cuLaunchCooperativeKernelMultiDevice introduced CUDA-9.0 -------------------------------------------------------------------------------- -- Deprecated@@ -402,8 +401,8 @@ {-# INLINE cuFuncSetSharedSize #-} {# fun unsafe cuFuncSetSharedSize- { useFun `Fun'- , cIntConv `Integer' } -> `Status' cToEnum #}+ { useFun `Fun'+ , fromInteger `Integer' } -> `Status' cToEnum #} -- |@@ -441,7 +440,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..2023] 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,745 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Build+-- Copyright : [2018..2023] 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++#if CUDA_VERSION < 13000+ {# fun unsafe cuGraphAddDependencies+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArrayLen* `[Node]'&+ }+ -> `()' checkStatus*- #}+#else+ cuGraphAddDependencies g' from' to' = cuGraphAddDependencies_v2 g' from' to' (length deps)+ {# fun unsafe cuGraphAddDependencies_v2+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArray* `[Node]'+ , withNullEdgeDataLen* `Int'&+ }+ -> `()' checkStatus*- #}+#endif+#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++#if CUDA_VERSION < 13000+ {# fun unsafe cuGraphRemoveDependencies+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArrayLen* `[Node]'&+ }+ -> `()' checkStatus*- #}+#else+ cuGraphRemoveDependencies g' from' to' = cuGraphRemoveDependencies_v2 g' from' to' (length deps)+ {# fun unsafe cuGraphRemoveDependencies_v2+ { useGraph `Graph'+ , withNodeArray* `[Node]'+ , withNodeArray* `[Node]'+ , withNullEdgeDataLen* `Int'&+ }+ -> `()' checkStatus*- #}+#endif+#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+#if CUDA_VERSION < 13000+ {# fun unsafe cuGraphGetEdges+ { useGraph `Graph'+ , castPtr `Ptr Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#else+ cuGraphGetEdges g' f t c = cuGraphGetEdges_v2 g' f t nullPtr c+ {# fun unsafe cuGraphGetEdges_v2+ { useGraph `Graph'+ , castPtr `Ptr Node'+ , castPtr `Ptr Node'+ , castPtr `Ptr edgeData'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+#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+#if CUDA_VERSION < 13000+ {# fun unsafe cuGraphNodeGetDependencies+ { useNode `Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#else+ cuGraphNodeGetDependencies n' d c = cuGraphNodeGetDependencies_v2 n' d nullPtr c+ {# fun unsafe cuGraphNodeGetDependencies_v2+ { useNode `Node'+ , castPtr `Ptr Node'+ , castPtr `Ptr edgeData'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+#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+#if CUDA_VERSION < 13000+ {# fun unsafe cuGraphNodeGetDependentNodes+ { useNode `Node'+ , castPtr `Ptr Node'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#else+ cuGraphNodeGetDependentNodes n' d c = cuGraphNodeGetDependentNodes_v2 n' d nullPtr c+ {# fun unsafe cuGraphNodeGetDependentNodes_v2+ { useNode `Node'+ , castPtr `Ptr Node'+ , castPtr `Ptr edgeData'+ , id `Ptr CULong'+ }+ -> `()' checkStatus*- #}+#endif+#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+++--------------------------------------------------------------------------------+-- 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++#if CUDA_VERSION >= 13000+{-# INLINE withNullEdgeDataLen #-}+withNullEdgeDataLen :: Int -> ((Ptr (), CULong) -> IO a) -> IO a+withNullEdgeDataLen len f = f (nullPtr, cIntConv len)+#endif+
+ src/Foreign/CUDA/Driver/Graph/Capture.chs view
@@ -0,0 +1,223 @@+{-# 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..2023] Trevor L. McDonell+-- License : BSD+--+-- Requires CUDA-10+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Graph.Capture (++ Status(..), Mode(..),+ start, stop, status, info, mode,++) 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++#if CUDA_VERSION < 10010+data Mode++instance Enum Mode where+#ifdef USE_EMPTY_CASE+ toEnum x = error ("Mode.toEnum: Cannot match " ++ show x)+ fromEnum x = case x of {}+#endif++#else+{# enum CUstreamCaptureMode as Mode+ { underscoreToCase }+ with prefix="CU_STREAM_CAPTURE_MODE" 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 -> Mode -> IO ()+start = requireSDK 'start 10.0+#elif CUDA_VERSION < 10010+start :: Stream -> Mode -> IO ()+start s _ = cuStreamBeginCapture s+ where+ {# fun unsafe cuStreamBeginCapture+ { useStream `Stream'+ }+ -> `()' checkStatus*- #}+#else+{# fun unsafe cuStreamBeginCapture as start+ { useStream `Stream'+ , `Mode'+ }+ -> `()' 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+++-- | Query the capture status of a stream and get an id for the capture+-- sequence, which is unique over the lifetime of the process.+--+-- Since CUDA-13, "edge data" can be associated with an edge in the graph. This+-- function assumes no such data is present (if there is, a CUDA error+-- (@CUDA_ERROR_LOSSY_QUERY@) will be raised).+--+-- Requires CUDA-10.1+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g13145ece1d79a1d79a1d22abb9663216>+--+-- @since 0.10.1.0+--+#if CUDA_VERSION < 10010+info :: Stream -> IO (Status, Int64)+info = requireSDK 'info 10.1+-- Not another elif because c2hs seems to be buggy+#else+#if CUDA_VERSION < 12000+{# fun unsafe cuStreamGetCaptureInfo as info+ { useStream `Stream'+ , alloca- `Status' peekEnum*+ , alloca- `Int64' peekIntConv*+ }+ -> `()' checkStatus*- #}+#elif CUDA_VERSION < 13000+{# fun unsafe cuStreamGetCaptureInfo_v2 as info+ { useStream `Stream'+ , alloca- `Status' peekEnum*+ , alloca- `Int64' peekIntConv*+ , withNullPtr- `Graph'+ , withNullPtr- `Node'+ , withNullPtr- `CSize'+ }+ -> `()' checkStatus*- #}+#else+{# fun unsafe cuStreamGetCaptureInfo_v3 as info+ { useStream `Stream'+ , alloca- `Status' peekEnum*+ , alloca- `Int64' peekIntConv*+ , withNullPtr- `Graph'+ , withNullPtr- `()'+ , withNullPtr- `Node'+ , withNullPtr- `CSize'+ }+ -> `()' checkStatus*- #}+#endif+#endif+++-- | Set the stream capture interaction mode for this thread. Return the previous value.+--+-- Requires CUDA-10.1+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g378135b262f02a43a7caeab239ae493d>+--+-- @since 0.10.1.0+--+#if CUDA_VERSION < 10010+mode :: Mode -> IO Mode+mode = requireSDK 'mode 10.1+#else+{# fun unsafe cuThreadExchangeStreamCaptureMode as mode+ { withEnum* `Mode' peekEnum*+ }+ -> `()' checkStatus*- #}+#endif+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++#if CUDA_VERSION >= 10000+{-# INLINE peekGraph #-}+peekGraph :: Ptr {# type CUgraph #} -> IO Graph+peekGraph = liftM Graph . peek+#endif++withNullPtr :: (Ptr a -> r) -> r+withNullPtr f = f nullPtr
+ src/Foreign/CUDA/Driver/Graph/Exec.chs view
@@ -0,0 +1,192 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Driver.Graph.Exec+-- Copyright : [2018..2023] 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,+ setKernel,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Exec ( Fun(..), FunParam(..) )+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+++-- | Update the parameters for a kernel node in the given executable graph+--+-- Requires CUDA-10.1+--+-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__GRAPH.html#group__CUDA__GRAPH_1gd84243569e4c3d6356b9f2eea20ed48c>+--+-- @since 0.10.1.0+--+setKernel+ :: Executable+ -> Node+ -> Fun+ -> (Int, Int, Int) -- ^ grid dimension+ -> (Int, Int, Int) -- ^ thread block dimensions+ -> Int -- ^ shared memory (bytes)+ -> [FunParam]+ -> IO ()+#if CUDA_VERSION < 10010+setKernel = requireSDK 'setKernel 10.1+#else+setKernel !exe !n !fun (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !args+ = withMany withFP args+ $ \pa -> withArray pa+ $ \pp -> cuGraphExecKernelNodeSetParams_simple exe n 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 cuGraphExecKernelNodeSetParams_simple+ { useExecutable `Executable'+ , useNode `Node'+ , useFun `Fun'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , `Int'+ , id `Ptr (Ptr ())'+ }+ -> `()' checkStatus*- #}+#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..2023] 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..2023] 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..2023] 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,@@ -351,16 +358,45 @@ go x _ = nothingIfOk =<< cuMemPrefetchAsync ptr (n * sizeOf x) (maybe (-1) useDevice mdev) (fromMaybe defaultStream mst) {-# INLINE cuMemPrefetchAsync #-}+#if CUDA_VERSION < 13000 {# fun unsafe cuMemPrefetchAsync { useDeviceHandle `DevicePtr a' , `Int'- , `CInt'+ , id `CInt' , useStream `Stream' } -> `Status' cToEnum #}+#else+{# fun unsafe cuMemPrefetchAsync_device as cuMemPrefetchAsync+ { useDeviceHandle `DevicePtr a'+ , `Int'+ , id `CInt'+ , useStream `Stream'+ }+ -> `Status' cToEnum #} #endif+#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 +1026,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 +1073,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 +1174,24 @@ -- {-# 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# (word64ToWord# 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# (wordToWord64# (int2Word# (addr2Int# addr#))))++#if __GLASGOW_HASKELL__ < 904+{-# INLINE word64ToWord# #-}+word64ToWord# :: Word# -> Word#+word64ToWord# x = x++{-# INLINE wordToWord64# #-}+wordToWord64# :: Word# -> Word#+wordToWord64# x = x+#endif
src/Foreign/CUDA/Driver/Module.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] 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..2023] 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..2023] 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,12 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Module.Query--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] Trevor L. McDonell -- License : BSD -- -- Querying module attributes for low-level driver interface@@ -13,7 +16,7 @@ module Foreign.CUDA.Driver.Module.Query ( -- ** Querying module inhabitants- getFun, getPtr, getTex,+ getFun, getPtr, ) where @@ -25,7 +28,6 @@ import Foreign.CUDA.Driver.Exec import Foreign.CUDA.Driver.Marshal ( peekDeviceHandle ) import Foreign.CUDA.Driver.Module.Base-import Foreign.CUDA.Driver.Texture import Foreign.CUDA.Internal.C2HS import Foreign.CUDA.Ptr @@ -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,35 +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 #}----- |--- Return a handle to a texture reference. This texture reference handle--- should not be destroyed, as the texture will be destroyed automatically--- when the module is unloaded.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9607dcbf911c16420d5264273f2b5608>----{-# INLINEABLE getTex #-}-getTex :: Module -> String -> 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- `DevicePtr a' peekDeviceHandle*+ , alloca- `Int' peekIntConv*+ , useModule `Module'+ , useAsCString* `ShortByteString'+ }+ -> `Status' cToEnum #} --------------------------------------------------------------------------------@@ -99,10 +96,44 @@ -------------------------------------------------------------------------------- {-# 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# (wordToWord8# 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++#if __GLASGOW_HASKELL__ < 902+{-# INLINE wordToWord8# #-}+wordToWord8# :: Word# -> Word#+wordToWord8# x = x+#endif
src/Foreign/CUDA/Driver/Profiler.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Profiler--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] Trevor L. McDonell -- License : BSD -- -- Profiler control for low-level driver interface
src/Foreign/CUDA/Driver/Stream.chs view
@@ -1,11 +1,16 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# 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..2023] Trevor L. McDonell -- License : BSD -- -- Stream management for low-level driver interface@@ -15,11 +20,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 +38,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 +180,7 @@ {# fun unsafe cuStreamCreateWithPriority { alloca- `Stream' peekStream* , combineBitMasks `[StreamFlag]'- , cIntConv `StreamPriority'+ , fromIntegral `StreamPriority' } -> `Status' cToEnum #} where@@ -169,17 +261,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 +324,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 ()@@ -211,6 +334,7 @@ write32 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue32 stream ptr val flags {-# INLINE cuStreamWriteValue32 #-}+#if CUDA_VERSION < 12000 {# fun unsafe cuStreamWriteValue32 { useStream `Stream' , useDeviceHandle `DevicePtr Word32'@@ -218,9 +342,16 @@ , combineBitMasks `[StreamWriteFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+#else+{# fun unsafe cuStreamWriteValue32_v2 as cuStreamWriteValue32+ { useStream `Stream'+ , useDeviceHandle `DevicePtr Word32'+ , `Word32'+ , combineBitMasks `[StreamWriteFlag]'+ }+ -> `Status' cToEnum #} #endif+#endif {-# INLINE write64 #-} write64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWriteFlag] -> IO ()@@ -230,6 +361,7 @@ write64 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue64 stream ptr val flags {-# INLINE cuStreamWriteValue64 #-}+#if CUDA_VERSION < 12000 {# fun unsafe cuStreamWriteValue64 { useStream `Stream' , useDeviceHandle `DevicePtr Word64'@@ -237,9 +369,16 @@ , combineBitMasks `[StreamWriteFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+#else+{# fun unsafe cuStreamWriteValue64_v2 as cuStreamWriteValue64+ { useStream `Stream'+ , useDeviceHandle `DevicePtr Word64'+ , `Word64'+ , combineBitMasks `[StreamWriteFlag]'+ }+ -> `Status' cToEnum #} #endif+#endif -- | Wait on a memory location. Work ordered after the operation will block@@ -259,7 +398,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 ()@@ -269,15 +408,22 @@ wait32 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue32 stream ptr val flags {-# INLINE cuStreamWaitValue32 #-}+#if CUDA_VERSION < 12000 {# fun unsafe cuStreamWaitValue32 { useStream `Stream' , useDeviceHandle `DevicePtr Word32' , `Word32' , combineBitMasks `[StreamWaitFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+#else+{# fun unsafe cuStreamWaitValue32_v2 as cuStreamWaitValue32+ { useStream `Stream'+ , useDeviceHandle `DevicePtr Word32'+ , `Word32'+ , combineBitMasks `[StreamWaitFlag]'+ } -> `Status' cToEnum #} #endif+#endif {-# INLINE wait64 #-} wait64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWaitFlag] -> IO ()@@ -287,13 +433,91 @@ wait64 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue64 stream ptr val flags {-# INLINE cuStreamWaitValue64 #-}+#if CUDA_VERSION < 12000 {# fun unsafe cuStreamWaitValue64 { useStream `Stream' , useDeviceHandle `DevicePtr Word64' , `Word64' , combineBitMasks `[StreamWaitFlag]' } -> `Status' cToEnum #}- where- useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+#else+{# fun unsafe cuStreamWaitValue64_v2 as cuStreamWaitValue64+ { useStream `Stream'+ , useDeviceHandle `DevicePtr Word64'+ , `Word64'+ , combineBitMasks `[StreamWaitFlag]'+ } -> `Status' cToEnum #}+#endif+#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# (wordToWord64# (int2Word# (addr2Int# addr#))))++#if __GLASGOW_HASKELL__ < 904+{-# INLINE wordToWord64# #-}+wordToWord64# :: Word# -> Word#+wordToWord64# x = x #endif
− src/Foreign/CUDA/Driver/Texture.chs
@@ -1,308 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# OPTIONS_HADDOCK prune #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Driver.Texture--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Texture management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Texture (-- -- * Texture Reference Management- Texture(..), Format(..), AddressMode(..), FilterMode(..), ReadMode(..),- bind, bind2D,- getAddressMode, getFilterMode, getFormat,- setAddressMode, setFilterMode, setFormat, setReadMode,-- -- Deprecated- create, destroy,-- -- Internal- peekTex--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Ptr-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Marshal-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad--#if CUDA_VERSION >= 3020-{-# DEPRECATED create, destroy "as of CUDA version 3.2" #-}-#endif-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A texture reference----newtype Texture = Texture { useTexture :: {# type CUtexref #}}- deriving (Eq, Show)--instance Storable Texture where- sizeOf _ = sizeOf (undefined :: {# type CUtexref #})- alignment _ = alignment (undefined :: {# type CUtexref #})- peek p = Texture `fmap` peek (castPtr p)- poke p t = poke (castPtr p) (useTexture t)---- |--- Texture reference addressing modes----{# enum CUaddress_mode as AddressMode- { underscoreToCase }- with prefix="CU_TR_ADDRESS_MODE" deriving (Eq, Show) #}---- |--- Texture reference filtering mode----{# enum CUfilter_mode as FilterMode- { underscoreToCase }- with prefix="CU_TR_FILTER_MODE" deriving (Eq, Show) #}---- |--- Texture read mode options----#c-typedef enum CUtexture_flag_enum {- CU_TEXTURE_FLAG_READ_AS_INTEGER = CU_TRSF_READ_AS_INTEGER,- CU_TEXTURE_FLAG_NORMALIZED_COORDINATES = CU_TRSF_NORMALIZED_COORDINATES,- CU_TEXTURE_FLAG_SRGB = CU_TRSF_SRGB-} CUtexture_flag;-#endc--{# enum CUtexture_flag as ReadMode- { underscoreToCase- , CU_TEXTURE_FLAG_SRGB as SRGB }- with prefix="CU_TEXTURE_FLAG" deriving (Eq, Show) #}---- |--- Texture data formats----{# enum CUarray_format as Format- { underscoreToCase- , UNSIGNED_INT8 as Word8- , UNSIGNED_INT16 as Word16- , UNSIGNED_INT32 as Word32- , SIGNED_INT8 as Int8- , SIGNED_INT16 as Int16- , SIGNED_INT32 as Int32 }- with prefix="CU_AD_FORMAT" deriving (Eq, Show) #}-------------------------------------------------------------------------------------- Texture management------------------------------------------------------------------------------------- |--- Create a new texture reference. Once created, the application must call--- 'setPtr' to associate the reference with allocated memory. Other texture--- reference functions are used to specify the format and interpretation to be--- used when the memory is read through this reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF__DEPRECATED.html#group__CUDA__TEXREF__DEPRECATED_1g0084fabe2c6d28ffcf9d9f5c7164f16c>----{-# INLINEABLE create #-}-create :: IO Texture-create = resultIfOk =<< cuTexRefCreate--{-# INLINE cuTexRefCreate #-}-{# fun unsafe cuTexRefCreate- { alloca- `Texture' peekTex* } -> `Status' cToEnum #}----- |--- Destroy a texture reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF__DEPRECATED.html#group__CUDA__TEXREF__DEPRECATED_1gea8edbd6cf9f97e6ab2b41fc6785519d>----{-# INLINEABLE destroy #-}-destroy :: Texture -> IO ()-destroy !tex = nothingIfOk =<< cuTexRefDestroy tex--{-# INLINE cuTexRefDestroy #-}-{# fun unsafe cuTexRefDestroy- { useTexture `Texture' } -> `Status' cToEnum #}----- |--- Bind a linear array address of the given size (bytes) as a texture--- reference. Any previously bound references are unbound.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g44ef7e5055192d52b3d43456602b50a8>----{-# INLINEABLE bind #-}-bind :: Texture -> DevicePtr a -> Int64 -> IO ()-bind !tex !dptr !bytes = nothingIfOk =<< cuTexRefSetAddress tex dptr bytes--{-# INLINE cuTexRefSetAddress #-}-{# fun unsafe cuTexRefSetAddress- { alloca- `Int'- , useTexture `Texture'- , useDeviceHandle `DevicePtr a'- , `Int64' } -> `Status' cToEnum #}----- |--- Bind a linear address range to the given texture reference as a--- two-dimensional arena. Any previously bound reference is unbound. Note that--- calls to 'setFormat' can not follow a call to 'bind2D' for the same texture--- reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g26f709bbe10516681913d1ffe8756ee2>----{-# INLINEABLE bind2D #-}-bind2D :: Texture -> Format -> Int -> DevicePtr a -> (Int,Int) -> Int64 -> IO ()-bind2D !tex !fmt !chn !dptr (!width,!height) !pitch =- nothingIfOk =<< cuTexRefSetAddress2DSimple tex fmt chn dptr width height pitch--{-# INLINE cuTexRefSetAddress2DSimple #-}-{# fun unsafe cuTexRefSetAddress2DSimple- { useTexture `Texture'- , cFromEnum `Format'- , `Int'- , useDeviceHandle `DevicePtr a'- , `Int'- , `Int'- , `Int64' } -> `Status' cToEnum #}----- |--- Get the addressing mode used by a texture reference, corresponding to the--- given dimension (currently the only supported dimension values are 0 or 1).------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1gfb367d93dc1d20aab0cf8ce70d543b33>----{-# INLINEABLE getAddressMode #-}-getAddressMode :: Texture -> Int -> IO AddressMode-getAddressMode !tex !dim = resultIfOk =<< cuTexRefGetAddressMode tex dim--{-# INLINE cuTexRefGetAddressMode #-}-{# fun unsafe cuTexRefGetAddressMode- { alloca- `AddressMode' peekEnum*- , useTexture `Texture'- , `Int' } -> `Status' cToEnum #}----- |--- Get the filtering mode used by a texture reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g2439e069746f69b940f2f4dbc78cdf87>----{-# INLINEABLE getFilterMode #-}-getFilterMode :: Texture -> IO FilterMode-getFilterMode !tex = resultIfOk =<< cuTexRefGetFilterMode tex--{-# INLINE cuTexRefGetFilterMode #-}-{# fun unsafe cuTexRefGetFilterMode- { alloca- `FilterMode' peekEnum*- , useTexture `Texture' } -> `Status' cToEnum #}----- |--- Get the data format and number of channel components of the bound texture.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g90936eb6c7c4434a609e1160c278ae53>----{-# INLINEABLE getFormat #-}-getFormat :: Texture -> IO (Format, Int)-getFormat !tex = do- (!status,!fmt,!dim) <- cuTexRefGetFormat tex- resultIfOk (status,(fmt,dim))--{-# INLINE cuTexRefGetFormat #-}-{# fun unsafe cuTexRefGetFormat- { alloca- `Format' peekEnum*- , alloca- `Int' peekIntConv*- , useTexture `Texture' } -> `Status' cToEnum #}----- |--- Specify the addressing mode for the given dimension of a texture reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g85f4a13eeb94c8072f61091489349bcb>----{-# INLINEABLE setAddressMode #-}-setAddressMode :: Texture -> Int -> AddressMode -> IO ()-setAddressMode !tex !dim !mode = nothingIfOk =<< cuTexRefSetAddressMode tex dim mode--{-# INLINE cuTexRefSetAddressMode #-}-{# fun unsafe cuTexRefSetAddressMode- { useTexture `Texture'- , `Int'- , cFromEnum `AddressMode' } -> `Status' cToEnum #}----- |--- Specify the filtering mode to be used when reading memory through a texture--- reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g595d0af02c55576f8c835e4efd1f39c0>----{-# INLINEABLE setFilterMode #-}-setFilterMode :: Texture -> FilterMode -> IO ()-setFilterMode !tex !mode = nothingIfOk =<< cuTexRefSetFilterMode tex mode--{-# INLINE cuTexRefSetFilterMode #-}-{# fun unsafe cuTexRefSetFilterMode- { useTexture `Texture'- , cFromEnum `FilterMode' } -> `Status' cToEnum #}----- |--- Specify additional characteristics for reading and indexing the texture--- reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g554ffd896487533c36810f2e45bb7a28>----{-# INLINEABLE setReadMode #-}-setReadMode :: Texture -> ReadMode -> IO ()-setReadMode !tex !mode = nothingIfOk =<< cuTexRefSetFlags tex mode--{-# INLINE cuTexRefSetFlags #-}-{# fun unsafe cuTexRefSetFlags- { useTexture `Texture'- , cFromEnum `ReadMode' } -> `Status' cToEnum #}----- |--- Specify the format of the data and number of packed components per element to--- be read by the texture reference.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g05585ef8ea2fec728a03c6c8f87cf07a>----{-# INLINEABLE setFormat #-}-setFormat :: Texture -> Format -> Int -> IO ()-setFormat !tex !fmt !chn = nothingIfOk =<< cuTexRefSetFormat tex fmt chn--{-# INLINE cuTexRefSetFormat #-}-{# fun unsafe cuTexRefSetFormat- { useTexture `Texture'- , cFromEnum `Format'- , `Int' } -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------{-# INLINE peekTex #-}-peekTex :: Ptr {# type CUtexref #} -> IO Texture-peekTex = liftM Texture . peek-
src/Foreign/CUDA/Driver/Unified.chs view
@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Unified--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2023] 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@@ -258,6 +258,7 @@ go x _ = nothingIfOk =<< cuMemAdvise ptr (n * sizeOf x) a (maybe (-1) useDevice mdev) {-# INLINE cuMemAdvise #-}+#if CUDA_VERSION < 13000 {# fun unsafe cuMemAdvise { useHandle `Ptr a' , `Int'@@ -265,7 +266,15 @@ , `CInt' } -> `Status' cToEnum #}+#else+{# fun unsafe cuMemAdvise_device as cuMemAdvise+ { useHandle `Ptr a'+ , `Int'+ , cFromEnum `Advice'+ , `CInt'+ }+ -> `Status' cToEnum #}+#endif where useHandle = fromIntegral . ptrToIntPtr #endif-
src/Foreign/CUDA/Driver/Utils.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Driver.Utils--- Copyright : [2009..2017] Trevor L. McDonell+-- Copyright : [2009..2023] Trevor L. McDonell -- License : BSD -- -- Utility functions
src/Foreign/CUDA/Internal/C2HS.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- C->Haskell Compiler: Marshalling library -- -- Copyright (c) [1999...2005] Manuel M T Chakravarty@@ -56,7 +59,11 @@ import Foreign.C import Control.Monad ( liftM ) +import GHC.Int+import GHC.Word+import GHC.Base + -- Composite marshalling functions -- ------------------------------- @@ -189,20 +196,41 @@ 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# (intToInt32# i#)) ;+ "fromIntegral/Int->CLLong" fromIntegral = \(I# i#) -> CLLong (I64# (intToInt64# i#)) ;+ #-}+{-# RULES+ "fromIntegral/Int->CUInt" fromIntegral = \(I# i#) -> CUInt (W32# (wordToWord32# (int2Word# i#))) ;+ "fromIntegral/Int->CULLong" fromIntegral = \(I# i#) -> CULLong (W64# (wordToWord64# (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'. --@@ -227,4 +255,23 @@ {-# INLINE [1] cFromEnum #-} cFromEnum :: (Enum e, Integral i) => e -> i cFromEnum = cIntConv . fromEnum++#if __GLASGOW_HASKELL__ < 902+{-# INLINE intToInt32# #-}+intToInt32# :: Int# -> Int#+intToInt32# = narrow32Int#++{-# INLINE wordToWord32# #-}+wordToWord32# :: Word# -> Word#+wordToWord32# = narrow32Word#+#endif+#if __GLASGOW_HASKELL__ < 904+{-# INLINE intToInt64# #-}+intToInt64# :: Int# -> Int#+intToInt64# x = x++{-# INLINE wordToWord64# #-}+wordToWord64# :: Word# -> Word#+wordToWord64# x = x+#endif
+ src/Foreign/CUDA/Internal/Describe.hs view
@@ -0,0 +1,18 @@+--------------------------------------------------------------------------------+-- |+-- Module : Foreign.CUDA.Internal.Describe+-- Copyright : [2016..2023] Trevor L. McDonell+-- License : BSD+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Internal.Describe+ where+++-- | Like 'Text.Show.Show', but focuses on providing a more detailed description+-- of the value rather than a 'Text.Read.read'able representation.+--+class Describe a where+ describe :: a -> String+
src/Foreign/CUDA/Path.chs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Foreign.CUDA.Path--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2023] 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..2023] 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
@@ -1,28 +0,0 @@------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Top level bindings to the C-for-CUDA runtime API--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime (-- module Foreign.CUDA.Ptr,- module Foreign.CUDA.Runtime.Device,- module Foreign.CUDA.Runtime.Error,- module Foreign.CUDA.Runtime.Exec,- module Foreign.CUDA.Runtime.Marshal,- module Foreign.CUDA.Runtime.Utils--) where--import Foreign.CUDA.Ptr-import Foreign.CUDA.Runtime.Device-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Runtime.Exec-import Foreign.CUDA.Runtime.Marshal-import Foreign.CUDA.Runtime.Utils-
− src/Foreign/CUDA/Runtime/Device.chs
@@ -1,464 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase #-}-#endif------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Device--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Device management routines--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Device (-- -- * Device Management- Device, DeviceFlag(..), DeviceProperties(..), Compute(..), ComputeMode(..),- choose, get, count, props, set, setFlags, setOrder, reset, sync,-- -- * Peer Access- PeerFlag,- accessible, add, remove,-- -- * Cache Configuration- Limit(..),- getLimit, setLimit--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Analysis.Device-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C--#c-typedef struct cudaDeviceProp cudaDeviceProp;--typedef enum-{- cudaDeviceFlagScheduleAuto = cudaDeviceScheduleAuto,- cudaDeviceFlagScheduleSpin = cudaDeviceScheduleSpin,- cudaDeviceFlagScheduleYield = cudaDeviceScheduleYield,- cudaDeviceFlagBlockingSync = cudaDeviceBlockingSync,- cudaDeviceFlagMapHost = cudaDeviceMapHost,-#if CUDART_VERSION >= 3000- cudaDeviceFlagLMemResizeToMax = cudaDeviceLmemResizeToMax-#endif-} cudaDeviceFlags;-#endc-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A device identifier----type Device = Int--{# pointer *cudaDeviceProp as ^ foreign -> DeviceProperties nocode #}---- |--- Device execution flags----{# enum cudaDeviceFlags as DeviceFlag { }- with prefix="cudaDeviceFlag" deriving (Eq, Show, Bounded) #}---instance Storable DeviceProperties where- sizeOf _ = {#sizeof cudaDeviceProp#}- alignment _ = alignment (undefined :: Ptr ())-- 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-#if CUDART_VERSION >= 3000- ck <- cToBool `fmap` {#get cudaDeviceProp.concurrentKernels#} p- u1 <- cIntConv `fmap` {#get cudaDeviceProp.maxTexture1D#} p-#endif-#if CUDART_VERSION >= 3010- ee <- cToBool `fmap` {#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-#endif- [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxThreadsDim#} p- [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxGridSize#} p-#if CUDART_VERSION >= 3000- [u21,u22] <- peekArrayWith cIntConv 2 =<< {#get cudaDeviceProp.maxTexture2D#} p- [u31,u32,u33] <- peekArrayWith cIntConv 3 =<< {#get cudaDeviceProp.maxTexture3D#} p-#endif-#if CUDART_VERSION >= 5050- sp <- cToBool `fmap` {#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-#endif-#if CUDART_VERSION >= 4000- , asyncEngineCount = ae- , cacheMemL2 = l2- , maxThreadsPerMultiProcessor = tm- , memBusWidth = mw- , memClockRate = mc- , tccDriverEnabled = tc- , unifiedAddressing = ua- , pciInfo = PCI pb pd pm-#endif-#if CUDA_VERSION >= 5050- , streamPriorities = sp-#endif-#if CUDA_VERSION >= 6000- , globalL1Cache = gl1- , localL1Cache = ll1- , managedMemory = mm- , multiGPUBoard = mg- , multiGPUBoardGroupID = mid-#endif- }-------------------------------------------------------------------------------------- Device Management------------------------------------------------------------------------------------- |--- Select the compute device which best matches the given criteria----{-# INLINEABLE choose #-}-choose :: DeviceProperties -> IO Device-choose !dev = resultIfOk =<< cudaChooseDevice dev--{-# INLINE cudaChooseDevice #-}-{# fun unsafe cudaChooseDevice- { alloca- `Int' peekIntConv*- , withDevProp* `DeviceProperties' } -> `Status' cToEnum #}- where- withDevProp = with----- |--- Returns which device is currently being used----{-# INLINEABLE get #-}-get :: IO Device-get = resultIfOk =<< cudaGetDevice--{-# INLINE cudaGetDevice #-}-{# fun unsafe cudaGetDevice- { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}----- |--- Returns the number of devices available for execution, with compute--- capability >= 1.0----{-# INLINEABLE count #-}-count :: IO Int-count = resultIfOk =<< cudaGetDeviceCount--{-# INLINE cudaGetDeviceCount #-}-{# fun unsafe cudaGetDeviceCount- { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}----- |--- Return information about the selected compute device----{-# INLINEABLE props #-}-props :: Device -> IO DeviceProperties-props !n = resultIfOk =<< cudaGetDeviceProperties n--{-# INLINE cudaGetDeviceProperties #-}-{# fun unsafe cudaGetDeviceProperties- { alloca- `DeviceProperties' peek*- , `Int' } -> `Status' cToEnum #}----- |--- Set device to be used for GPU execution----{-# INLINEABLE set #-}-set :: Device -> IO ()-set !n = nothingIfOk =<< cudaSetDevice n--{-# INLINE cudaSetDevice #-}-{# fun unsafe cudaSetDevice- { `Int' } -> `Status' cToEnum #}----- |--- Set flags to be used for device executions----{-# INLINEABLE setFlags #-}-setFlags :: [DeviceFlag] -> IO ()-setFlags !f = nothingIfOk =<< cudaSetDeviceFlags (combineBitMasks f)--{-# INLINE cudaSetDeviceFlags #-}-{# fun unsafe cudaSetDeviceFlags- { `Int' } -> `Status' cToEnum #}----- |--- Set list of devices for CUDA execution in priority order----{-# INLINEABLE setOrder #-}-setOrder :: [Device] -> IO ()-setOrder !l = nothingIfOk =<< cudaSetValidDevices l (length l)--{-# INLINE cudaSetValidDevices #-}-{# fun unsafe cudaSetValidDevices- { withArrayIntConv* `[Int]'- , `Int' } -> `Status' cToEnum #}- where- withArrayIntConv = withArray . map cIntConv---- |--- Block until the device has completed all preceding requested tasks. Returns--- an error if one of the tasks fails.----{-# INLINEABLE sync #-}-sync :: IO ()-#if CUDART_VERSION < 4000-{-# INLINE cudaThreadSynchronize #-}-sync = nothingIfOk =<< cudaThreadSynchronize-{# fun cudaThreadSynchronize { } -> `Status' cToEnum #}-#else-{-# INLINE cudaDeviceSynchronize #-}-sync = nothingIfOk =<< cudaDeviceSynchronize-{# fun cudaDeviceSynchronize { } -> `Status' cToEnum #}-#endif---- |--- Explicitly destroys and cleans up all runtime resources associated with the--- current device in the current process. Any subsequent API call will--- reinitialise the device.------ Note that this function will reset the device immediately. It is the caller’s--- responsibility to ensure that the device is not being accessed by any other--- host threads from the process when this function is called.----{-# INLINEABLE reset #-}-reset :: IO ()-#if CUDART_VERSION >= 4000-{-# INLINE cudaDeviceReset #-}-reset = nothingIfOk =<< cudaDeviceReset-{# fun unsafe cudaDeviceReset { } -> `Status' cToEnum #}-#else-{-# INLINE cudaThreadExit #-}-reset = nothingIfOk =<< cudaThreadExit-{# fun unsafe cudaThreadExit { } -> `Status' cToEnum #}-#endif-------------------------------------------------------------------------------------- Peer Access------------------------------------------------------------------------------------- |--- Possible option values for direct peer memory access----data PeerFlag-instance Enum PeerFlag where-#ifdef USE_EMPTY_CASE- toEnum x = case x of {}- fromEnum x = case x of {}-#endif---- |--- Queries if the first device can directly access the memory of the second. If--- direct access is possible, it can then be enabled with 'add'. Requires--- cuda-4.0.----{-# INLINEABLE accessible #-}-accessible :: Device -> Device -> IO Bool-#if CUDART_VERSION < 4000-accessible _ _ = requireSDK 'accessible 4.0-#else-accessible !dev !peer = resultIfOk =<< cudaDeviceCanAccessPeer dev peer--{-# INLINE cudaDeviceCanAccessPeer #-}-{# fun unsafe cudaDeviceCanAccessPeer- { alloca- `Bool' peekBool*- , cIntConv `Device'- , cIntConv `Device' } -> `Status' cToEnum #}-#endif---- |--- If the devices of both the current and supplied contexts support unified--- addressing, then enable allocations in the supplied context to be accessible--- by the current context. Requires cuda-4.0.----{-# INLINEABLE add #-}-add :: Device -> [PeerFlag] -> IO ()-#if CUDART_VERSION < 4000-add _ _ = requireSDK 'add 4.0-#else-add !dev !flags = nothingIfOk =<< cudaDeviceEnablePeerAccess dev flags--{-# INLINE cudaDeviceEnablePeerAccess #-}-{# fun unsafe cudaDeviceEnablePeerAccess- { cIntConv `Device'- , combineBitMasks `[PeerFlag]' } -> `Status' cToEnum #}-#endif----- |--- Disable direct memory access from the current context to the supplied--- context. Requires cuda-4.0.----{-# INLINEABLE remove #-}-remove :: Device -> IO ()-#if CUDART_VERSION < 4000-remove _ = requireSDK 'remove 4.0-#else-remove !dev = nothingIfOk =<< cudaDeviceDisablePeerAccess dev--{-# INLINE cudaDeviceDisablePeerAccess #-}-{# fun unsafe cudaDeviceDisablePeerAccess- { cIntConv `Device' } -> `Status' cToEnum #}-#endif-------------------------------------------------------------------------------------- Cache Configuration------------------------------------------------------------------------------------- |--- Device limit flags----#if CUDART_VERSION < 3010-data Limit-#else-{# enum cudaLimit as Limit- { underscoreToCase }- with prefix="cudaLimit" deriving (Eq, Show) #}-#endif----- |--- Query compute 2.0 call stack limits. Requires cuda-3.1.----{-# INLINEABLE getLimit #-}-getLimit :: Limit -> IO Int-#if CUDART_VERSION < 3010-getLimit _ = requireSDK 'getLimit 3.1-#elif CUDART_VERSION < 4000-getLimit !l = resultIfOk =<< cudaThreadGetLimit l--{-# INLINE cudaThreadGetLimit #-}-{# fun unsafe cudaThreadGetLimit- { alloca- `Int' peekIntConv*- , cFromEnum `Limit' } -> `Status' cToEnum #}-#else-getLimit !l = resultIfOk =<< cudaDeviceGetLimit l--{-# INLINE cudaDeviceGetLimit #-}-{# fun unsafe cudaDeviceGetLimit- { alloca- `Int' peekIntConv*- , cFromEnum `Limit' } -> `Status' cToEnum #}-#endif----- |--- Set compute 2.0 call stack limits. Requires cuda-3.1.----{-# INLINEABLE setLimit #-}-setLimit :: Limit -> Int -> IO ()-#if CUDART_VERSION < 3010-setLimit _ _ = requireSDK 'setLimit 3.1-#elif CUDART_VERSION < 4000-setLimit !l !n = nothingIfOk =<< cudaThreadSetLimit l n--{-# INLINE cudaThreadSetLimit #-}-{# fun unsafe cudaThreadSetLimit- { cFromEnum `Limit'- , cIntConv `Int' } -> `Status' cToEnum #}-#else-setLimit !l !n = nothingIfOk =<< cudaDeviceSetLimit l n--{-# INLINE cudaDeviceSetLimit #-}-{# fun unsafe cudaDeviceSetLimit- { cFromEnum `Limit'- , cIntConv `Int' } -> `Status' cToEnum #}-#endif-
− src/Foreign/CUDA/Runtime/Error.chs
@@ -1,119 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Error--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Error handling functions--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Error (-- Status(..), CUDAException(..),-- cudaError, describe, requireSDK,- resultIfOk, nothingIfOk--) where---- Friends-import Foreign.CUDA.Internal.C2HS-import Text.Show.Describe---- System-import Control.Exception-import Data.Typeable-import Foreign.C-import Foreign.Ptr-import Language.Haskell.TH-import System.IO.Unsafe-import Text.Printf--#include "cbits/stubs.h"-{# context lib="cudart" #}-------------------------------------------------------------------------------------- Return Status------------------------------------------------------------------------------------- |--- Return codes from API functions----{# enum cudaError as Status- { cudaSuccess as Success }- with prefix="cudaError" deriving (Eq, Show) #}------------------------------------------------------------------------------------- Exceptions-----------------------------------------------------------------------------------data CUDAException- = ExitCode Status- | UserError String- deriving Typeable--instance Exception CUDAException--instance Show CUDAException where- showsPrec _ (ExitCode s) = showString ("CUDA Exception: " ++ describe s)- showsPrec _ (UserError s) = showString ("CUDA Exception: " ++ s)----- |--- Raise a 'CUDAException' in the IO Monad----cudaError :: String -> IO a-cudaError s = throwIO (UserError s)---- |--- A specially formatted error message----requireSDK :: Name -> Double -> IO a-requireSDK n v = cudaError $ printf "'%s' requires at least cuda-%3.1f\n" (show n) v-------------------------------------------------------------------------------------- Helper Functions------------------------------------------------------------------------------------- |--- Return the descriptive string associated with a particular error code----instance Describe Status where- describe = cudaGetErrorString---- Logically, this must be a pure function, returning a pointer to a statically--- defined string constant.----{# fun pure unsafe cudaGetErrorString- { cFromEnum `Status' } -> `String' #}----- |--- Return the results of a function on successful execution, otherwise return--- the error string associated with the return code----{-# INLINE resultIfOk #-}-resultIfOk :: (Status, a) -> IO a-resultIfOk (status, !result) =- case status of- Success -> return result- _ -> throwIO (ExitCode status)----- |--- Return the error string associated with an unsuccessful return code,--- otherwise Nothing----{-# INLINE nothingIfOk #-}-nothingIfOk :: Status -> IO ()-nothingIfOk status =- case status of- Success -> return ()- _ -> throwIO (ExitCode status)-
− src/Foreign/CUDA/Runtime/Event.chs
@@ -1,148 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Driver.Event--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Event management for C-for-CUDA runtime environment--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Event (-- -- * Event Management- Event, EventFlag(..), WaitFlag,- create, destroy, elapsedTime, query, record, wait, block--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad ( liftM )-import Control.Exception ( throwIO )-import Data.Maybe ( fromMaybe )-------------------------------------------------------------------------------------- Event management------------------------------------------------------------------------------------- |--- Create a new event----{-# INLINEABLE create #-}-create :: [EventFlag] -> IO Event-create !flags = resultIfOk =<< cudaEventCreateWithFlags flags--{-# INLINE cudaEventCreateWithFlags #-}-{# fun unsafe cudaEventCreateWithFlags- { alloca- `Event' peekEvt*- , combineBitMasks `[EventFlag]' } -> `Status' cToEnum #}- where peekEvt = liftM Event . peek----- |--- Destroy an event----{-# INLINEABLE destroy #-}-destroy :: Event -> IO ()-destroy !ev = nothingIfOk =<< cudaEventDestroy ev--{-# INLINE cudaEventDestroy #-}-{# fun unsafe cudaEventDestroy- { useEvent `Event' } -> `Status' cToEnum #}----- |--- Determine the elapsed time (in milliseconds) between two events----{-# INLINEABLE elapsedTime #-}-elapsedTime :: Event -> Event -> IO Float-elapsedTime !ev1 !ev2 = resultIfOk =<< cudaEventElapsedTime ev1 ev2--{-# INLINE cudaEventElapsedTime #-}-{# fun unsafe cudaEventElapsedTime- { alloca- `Float' peekFloatConv*- , useEvent `Event'- , useEvent `Event' } -> `Status' cToEnum #}----- |--- Determines if a event has actually been recorded----{-# INLINEABLE query #-}-query :: Event -> IO Bool-query !ev =- cudaEventQuery ev >>= \rv ->- case rv of- Success -> return True- NotReady -> return False- _ -> throwIO (ExitCode rv)--{-# INLINE cudaEventQuery #-}-{# fun unsafe cudaEventQuery- { useEvent `Event' } -> `Status' cToEnum #}----- |--- Record an event once all operations in the current context (or optionally--- specified stream) have completed. This operation is asynchronous.----{-# INLINEABLE record #-}-record :: Event -> Maybe Stream -> IO ()-record !ev !mst =- nothingIfOk =<< cudaEventRecord ev (maybe defaultStream id mst)--{-# INLINE cudaEventRecord #-}-{# fun unsafe cudaEventRecord- { useEvent `Event'- , useStream `Stream' } -> `Status' cToEnum #}----- |--- Makes all future work submitted to the (optional) stream wait until the given--- event reports completion before beginning execution. Synchronisation is--- performed on the device, including when the event and stream are from--- different device contexts. Requires cuda-3.2.----{-# INLINEABLE wait #-}-wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()-#if CUDART_VERSION < 3020-wait _ _ _ = requireSDK 'wait 3.2-#else-wait !ev !mst !flags =- let st = fromMaybe defaultStream mst- in nothingIfOk =<< cudaStreamWaitEvent st ev flags--{-# INLINE cudaStreamWaitEvent #-}-{# fun unsafe cudaStreamWaitEvent- { useStream `Stream'- , useEvent `Event'- , combineBitMasks `[WaitFlag]' } -> `Status' cToEnum #}-#endif---- |--- Wait until the event has been recorded----{-# INLINEABLE block #-}-block :: Event -> IO ()-block !ev = nothingIfOk =<< cudaEventSynchronize ev--{-# INLINE cudaEventSynchronize #-}-{# fun cudaEventSynchronize- { useEvent `Event' } -> `Status' cToEnum #}-
− src/Foreign/CUDA/Runtime/Exec.chs
@@ -1,276 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TemplateHaskell #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Exec--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Kernel execution control for C-for-CUDA runtime interface--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Exec (-- -- * Kernel Execution- Fun, FunAttributes(..), FunParam(..), CacheConfig(..),- attributes, setConfig, setParams, setCacheConfig, launch, launchKernel,--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Runtime.Stream ( Stream(..), defaultStream )-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad--#c-typedef struct cudaFuncAttributes cudaFuncAttributes;-#endc-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A @__global__@ device function.------ Note that the use of a string naming a function was deprecated in CUDA 4.1--- and removed in CUDA 5.0.----#if CUDART_VERSION >= 5000-type Fun = FunPtr ()-#else-type Fun = String-#endif-------- Function Attributes----{# pointer *cudaFuncAttributes as ^ foreign -> FunAttributes nocode #}--data FunAttributes = FunAttributes- {- constSizeBytes :: !Int64,- localSizeBytes :: !Int64,- sharedSizeBytes :: !Int64,- maxKernelThreadsPerBlock :: !Int, -- ^ maximum block size that can be successively launched (based on register usage)- numRegs :: !Int -- ^ number of registers required for each thread- }- deriving (Show)--instance Storable FunAttributes where- sizeOf _ = {# sizeof cudaFuncAttributes #}- alignment _ = alignment (undefined :: Ptr ())-- poke _ _ = error "Can not poke Foreign.CUDA.Runtime.FunAttributes"- peek p = do- cs <- cIntConv `fmap` {#get cudaFuncAttributes.constSizeBytes#} p- ls <- cIntConv `fmap` {#get cudaFuncAttributes.localSizeBytes#} p- ss <- cIntConv `fmap` {#get cudaFuncAttributes.sharedSizeBytes#} p- tb <- cIntConv `fmap` {#get cudaFuncAttributes.maxThreadsPerBlock#} p- nr <- cIntConv `fmap` {#get cudaFuncAttributes.numRegs#} p-- return FunAttributes- {- constSizeBytes = cs,- localSizeBytes = ls,- sharedSizeBytes = ss,- maxKernelThreadsPerBlock = tb,- numRegs = nr- }--#if CUDART_VERSION < 3000-data CacheConfig-#else--- |--- Cache configuration preference----{# enum cudaFuncCache as CacheConfig- { }- with prefix="cudaFuncCachePrefer" deriving (Eq, Show) #}-#endif---- |--- Kernel function parameters. Doubles will be converted to an internal float--- representation on devices that do not support doubles natively.----data FunParam where- IArg :: !Int -> FunParam- FArg :: !Float -> FunParam- DArg :: !Double -> FunParam- VArg :: Storable a => !a -> FunParam-------------------------------------------------------------------------------------- Execution Control------------------------------------------------------------------------------------- |--- Obtain the attributes of the named @__global__@ device function. This--- itemises the requirements to successfully launch the given kernel.----{-# INLINEABLE attributes #-}-attributes :: Fun -> IO FunAttributes-attributes !fn = resultIfOk =<< cudaFuncGetAttributes fn--{-# INLINE cudaFuncGetAttributes #-}-{# fun unsafe cudaFuncGetAttributes- { alloca- `FunAttributes' peek*- , withFun* `Fun' } -> `Status' cToEnum #}----- |--- Specify the grid and block dimensions for a device call. Used in conjunction--- with 'setParams', this pushes data onto the execution stack that will be--- popped when a function is 'launch'ed.----{-# INLINEABLE setConfig #-}-setConfig :: (Int,Int) -- ^ grid dimensions- -> (Int,Int,Int) -- ^ block dimensions- -> Int64 -- ^ shared memory per block (bytes)- -> Maybe Stream -- ^ associated processing stream- -> IO ()-setConfig (!gx,!gy) (!bx,!by,!bz) !sharedMem !mst =- nothingIfOk =<<- cudaConfigureCallSimple gx gy bx by bz sharedMem (maybe defaultStream id mst)-------- The FFI does not support passing deferenced structures to C functions, as--- this is highly platform/compiler dependent. Wrap our own function stub--- accepting plain integers.----{-# INLINE cudaConfigureCallSimple #-}-{# fun unsafe cudaConfigureCallSimple- { `Int', `Int'- , `Int', `Int', `Int'- , cIntConv `Int64'- , useStream `Stream' } -> `Status' cToEnum #}----- |--- Set the argument parameters that will be passed to the next kernel--- invocation. This is used in conjunction with 'setConfig' to control kernel--- execution.----{-# INLINEABLE setParams #-}-setParams :: [FunParam] -> IO ()-setParams = foldM_ k 0- where- k !offset !arg = do- let s = size arg- set arg s offset >>= nothingIfOk- return (offset + s)-- size (IArg _) = sizeOf (undefined :: Int)- size (FArg _) = sizeOf (undefined :: Float)- size (DArg _) = sizeOf (undefined :: Double)- size (VArg a) = sizeOf a-- set (IArg v) s o = cudaSetupArgument v s o- set (FArg v) s o = cudaSetupArgument v s o- set (VArg v) s o = cudaSetupArgument v s o- set (DArg v) s o =- cudaSetDoubleForDevice v >>= resultIfOk >>= \d ->- cudaSetupArgument d s o---{-# INLINE cudaSetupArgument #-}-{# fun unsafe cudaSetupArgument- `Storable a' =>- { with'* `a'- , `Int'- , `Int' } -> `Status' cToEnum #}- where- with' v a = with v $ \p -> a (castPtr p)--{-# INLINE cudaSetDoubleForDevice #-}-{# fun unsafe cudaSetDoubleForDevice- { with'* `Double' peek'* } -> `Status' cToEnum #}- where- with' v a = with v $ \p -> a (castPtr p)- peek' = peek . castPtr----- |--- On devices where the L1 cache and shared memory use the same hardware--- resources, this sets the preferred cache configuration for the given device--- function. This is only a preference; the driver is free to choose a different--- configuration as required to execute the function.------ Switching between configuration modes may insert a device-side--- synchronisation point for streamed kernel launches----{-# INLINEABLE setCacheConfig #-}-setCacheConfig :: Fun -> CacheConfig -> IO ()-#if CUDART_VERSION < 3000-setCacheConfig _ _ = requireSDK 'setCacheConfig 3.0-#else-setCacheConfig !fn !pref = nothingIfOk =<< cudaFuncSetCacheConfig fn pref--{-# INLINE cudaFuncSetCacheConfig #-}-{# fun unsafe cudaFuncSetCacheConfig- { withFun* `Fun'- , cFromEnum `CacheConfig' } -> `Status' cToEnum #}-#endif----- |--- Invoke the @__global__@ kernel function on the device. This must be preceded--- by a call to 'setConfig' and (if appropriate) 'setParams'.----{-# INLINEABLE launch #-}-launch :: Fun -> IO ()-launch !fn = nothingIfOk =<< cudaLaunch fn--{-# INLINE cudaLaunch #-}-{# fun unsafe cudaLaunch- { withFun* `Fun' } -> `Status' cToEnum #}----- |--- Invoke a kernel on a @(gx * gy)@ grid of blocks, where each block contains--- @(tx * ty * tz)@ threads and has access to a given number of bytes of shared--- memory. The launch may also be associated with a specific 'Stream'.----{-# INLINEABLE launchKernel #-}-launchKernel- :: Fun -- ^ Device function symbol- -> (Int,Int) -- ^ grid dimensions- -> (Int,Int,Int) -- ^ thread block shape- -> Int64 -- ^ shared memory per block (bytes)- -> Maybe Stream -- ^ (optional) execution stream- -> [FunParam]- -> IO ()-launchKernel !fn !grid !block !sm !mst !args = do- setConfig grid block sm mst- setParams args- launch fn------------------------------------------------------------------------------------- Internals------------------------------------------------------------------------------------- CUDA 5.0 changed the type of a kernel function from char* to void*----#if CUDART_VERSION >= 5000-withFun :: Fun -> (Ptr a -> IO b) -> IO b-withFun fn action = action (castFunPtrToPtr fn)-#else-withFun :: Fun -> (Ptr CChar -> IO a) -> IO a-withFun = withCString-#endif-
− src/Foreign/CUDA/Runtime/Marshal.chs
@@ -1,648 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Marshal--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Memory management for CUDA devices--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Marshal (-- -- * Host Allocation- AllocFlag(..),- mallocHostArray, freeHost,-- -- * Device Allocation- mallocArray, allocaArray, free,-- -- * Unified Memory Allocation- AttachFlag(..),- mallocManagedArray,-- -- * Marshalling- peekArray, peekArrayAsync, peekArray2D, peekArray2DAsync, peekListArray,- pokeArray, pokeArrayAsync, pokeArray2D, pokeArray2DAsync, pokeListArray,- copyArray, copyArrayAsync, copyArray2D, copyArray2DAsync,-- -- * Combined Allocation and Marshalling- newListArray, newListArrayLen,- withListArray, withListArrayLen,-- -- * Utility- memset--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Ptr-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Runtime.Stream-import Foreign.CUDA.Internal.C2HS---- System-import Data.Int-import Data.Maybe-import Control.Exception--import Foreign.C-import Foreign.Ptr-import Foreign.Storable-import qualified Foreign.Marshal as F--#c-typedef enum cudaMemHostAlloc_option_enum {-// CUDA_MEMHOSTALLOC_OPTION_DEFAULT = cudaHostAllocDefault,- CUDA_MEMHOSTALLOC_OPTION_DEVICE_MAPPED = cudaHostAllocMapped,- CUDA_MEMHOSTALLOC_OPTION_PORTABLE = cudaHostAllocPortable,- CUDA_MEMHOSTALLOC_OPTION_WRITE_COMBINED = cudaHostAllocWriteCombined-} cudaMemHostAlloc_option;-#endc--#if CUDART_VERSION >= 6000-#c-typedef enum cudaMemAttachFlags_option_enum {- CUDA_MEM_ATTACH_OPTION_GLOBAL = cudaMemAttachGlobal,- CUDA_MEM_ATTACH_OPTION_HOST = cudaMemAttachHost,- CUDA_MEM_ATTACH_OPTION_SINGLE = cudaMemAttachSingle-} cudaMemAttachFlags_option;-#endc-#endif-------------------------------------------------------------------------------------- Host Allocation------------------------------------------------------------------------------------- |--- Options for host allocation----{# enum cudaMemHostAlloc_option as AllocFlag- { underscoreToCase }- with prefix="CUDA_MEMHOSTALLOC_OPTION" deriving (Eq, Show, Bounded) #}----- |--- Allocate a section of linear memory on the host which is page-locked and--- directly accessible from the device. The storage is sufficient to hold the--- given number of elements of a storable type. The runtime system automatically--- accelerates calls to functions such as 'peekArrayAsync' and 'pokeArrayAsync'--- that refer to page-locked memory.------ Note that since the amount of pageable memory is thusly reduced, overall--- system performance may suffer. This is best used sparingly to allocate--- staging areas for data exchange----{-# INLINEABLE mallocHostArray #-}-mallocHostArray :: Storable a => [AllocFlag] -> Int -> IO (HostPtr a)-mallocHostArray !flags = doMalloc undefined- where- doMalloc :: Storable a' => a' -> Int -> IO (HostPtr a')- doMalloc x !n = resultIfOk =<< cudaHostAlloc (fromIntegral n * fromIntegral (sizeOf x)) flags--{-# INLINE cudaHostAlloc #-}-{# fun unsafe cudaHostAlloc- { alloca'- `HostPtr a' hptr*- , cIntConv `Int64'- , combineBitMasks `[AllocFlag]' } -> `Status' cToEnum #}- where- alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)- hptr !p = (HostPtr . castPtr) `fmap` peek p----- |--- Free page-locked host memory previously allocated with 'mallecHost'----{-# INLINEABLE freeHost #-}-freeHost :: HostPtr a -> IO ()-freeHost !p = nothingIfOk =<< cudaFreeHost p--{-# INLINE cudaFreeHost #-}-{# fun unsafe cudaFreeHost- { hptr `HostPtr a' } -> `Status' cToEnum #}- where hptr = castPtr . useHostPtr-------------------------------------------------------------------------------------- Device Allocation------------------------------------------------------------------------------------- |--- Allocate a section of linear memory on the device, and return a reference to--- it. The memory is sufficient to hold the given number of elements of storable--- type. It is suitable aligned, and not cleared.----{-# INLINEABLE mallocArray #-}-mallocArray :: Storable a => Int -> IO (DevicePtr a)-mallocArray = doMalloc undefined- where- doMalloc :: Storable a' => a' -> Int -> IO (DevicePtr a')- doMalloc x !n = resultIfOk =<< cudaMalloc (fromIntegral n * fromIntegral (sizeOf x))--{-# INLINE cudaMalloc #-}-{# fun unsafe cudaMalloc- { alloca'- `DevicePtr a' dptr*- , cIntConv `Int64' } -> `Status' cToEnum #}- where- -- C-> Haskell doesn't like qualified imports in marshaller specifications- alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)- dptr !p = (castDevPtr . DevicePtr) `fmap` peek p----- |--- Execute a computation, passing a pointer to a temporarily allocated block of--- memory sufficient to hold the given number of elements of storable type. The--- memory is freed when the computation terminates (normally or via an--- exception), so the pointer must not be used after this.------ Note that kernel launches can be asynchronous, so you may need to add a--- synchronisation point at the end of the computation.----{-# INLINEABLE allocaArray #-}-allocaArray :: Storable a => Int -> (DevicePtr a -> IO b) -> IO b-allocaArray n = bracket (mallocArray n) free----- |--- Free previously allocated memory on the device----{-# INLINEABLE free #-}-free :: DevicePtr a -> IO ()-free !p = nothingIfOk =<< cudaFree p--{-# INLINE cudaFree #-}-{# fun unsafe cudaFree- { dptr `DevicePtr a' } -> `Status' cToEnum #}- where- dptr = useDevicePtr . castDevPtr-------------------------------------------------------------------------------------- Unified memory allocation------------------------------------------------------------------------------------- |--- Options for unified memory allocations----#if CUDART_VERSION >= 6000-{# enum cudaMemAttachFlags_option as AttachFlag- { underscoreToCase }- with prefix="CUDA_MEM_ATTACH_OPTION" deriving (Eq, Show, Bounded) #}-#else-data AttachFlag-#endif---- |--- Allocates memory that will be automatically managed by the Unified Memory--- system----{-# INLINEABLE mallocManagedArray #-}-mallocManagedArray :: Storable a => [AttachFlag] -> Int -> IO (DevicePtr a)-#if CUDART_VERSION < 6000-mallocManagedArray _ _ = requireSDK 'mallocManagedArray 6.0-#else-mallocManagedArray !flags = doMalloc undefined- where- doMalloc :: Storable a' => a' -> Int -> IO (DevicePtr a')- doMalloc x !n = resultIfOk =<< cudaMallocManaged (fromIntegral n * fromIntegral (sizeOf x)) flags--{-# INLINE cudaMallocManaged #-}-{# fun unsafe cudaMallocManaged- { alloca'- `DevicePtr a' dptr*- , cIntConv `Int64'- , combineBitMasks `[AttachFlag]' } -> `Status' cToEnum #}- where- alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)- dptr !p = (castDevPtr . DevicePtr) `fmap` peek p-#endif-------------------------------------------------------------------------------------- Marshalling------------------------------------------------------------------------------------- |--- Copy a number of elements from the device to host memory. This is a--- synchronous operation.----{-# INLINEABLE peekArray #-}-peekArray :: Storable a => Int -> DevicePtr a -> Ptr a -> IO ()-peekArray !n !dptr !hptr = memcpy hptr (useDevicePtr dptr) n DeviceToHost----- |--- Copy memory from the device asynchronously, possibly associated with a--- particular stream. The destination memory must be page locked.----{-# INLINEABLE peekArrayAsync #-}-peekArrayAsync :: Storable a => Int -> DevicePtr a -> HostPtr a -> Maybe Stream -> IO ()-peekArrayAsync !n !dptr !hptr !mst =- memcpyAsync (useHostPtr hptr) (useDevicePtr dptr) n DeviceToHost mst----- |--- Copy a 2D memory area from the device to the host. This is a synchronous--- operation.----{-# INLINEABLE peekArray2D #-}-peekArray2D- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> DevicePtr a -- ^ source array- -> Int -- ^ source array width- -> Ptr a -- ^ destination array- -> Int -- ^ destination array width- -> IO ()-peekArray2D !w !h !dptr !dw !hptr !hw =- memcpy2D hptr hw (useDevicePtr dptr) dw w h DeviceToHost----- |--- Copy a 2D memory area from the device to the host asynchronously, possibly--- associated with a particular stream. The destination array must be page--- locked.----{-# INLINEABLE peekArray2DAsync #-}-peekArray2DAsync- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> DevicePtr a -- ^ source array- -> Int -- ^ source array width- -> HostPtr a -- ^ destination array- -> Int -- ^ destination array width- -> Maybe Stream- -> IO ()-peekArray2DAsync !w !h !dptr !dw !hptr !hw !mst =- memcpy2DAsync (useHostPtr hptr) hw (useDevicePtr dptr) dw w h DeviceToHost mst----- |--- Copy a number of elements from the device into a new Haskell list. Note that--- this requires two memory copies: firstly from the device into a heap--- allocated array, and from there marshalled into a list----{-# INLINEABLE peekListArray #-}-peekListArray :: Storable a => Int -> DevicePtr a -> IO [a]-peekListArray !n !dptr =- F.allocaArray n $ \p -> do- peekArray n dptr p- F.peekArray n p----- |--- Copy a number of elements onto the device. This is a synchronous operation.----{-# INLINEABLE pokeArray #-}-pokeArray :: Storable a => Int -> Ptr a -> DevicePtr a -> IO ()-pokeArray !n !hptr !dptr = memcpy (useDevicePtr dptr) hptr n HostToDevice----- |--- Copy memory onto the device asynchronously, possibly associated with a--- particular stream. The source memory must be page-locked.----{-# INLINEABLE pokeArrayAsync #-}-pokeArrayAsync :: Storable a => Int -> HostPtr a -> DevicePtr a -> Maybe Stream -> IO ()-pokeArrayAsync !n !hptr !dptr !mst =- memcpyAsync (useDevicePtr dptr) (useHostPtr hptr) n HostToDevice mst----- |--- Copy a 2D memory area onto the device. This is a synchronous operation.----{-# INLINEABLE pokeArray2D #-}-pokeArray2D- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> Ptr a -- ^ source array- -> Int -- ^ source array width- -> DevicePtr a -- ^ destination array- -> Int -- ^ destination array width- -> IO ()-pokeArray2D !w !h !hptr !dw !dptr !hw =- memcpy2D (useDevicePtr dptr) dw hptr hw w h HostToDevice----- |--- Copy a 2D memory area onto the device asynchronously, possibly associated--- with a particular stream. The source array must be page locked.----{-# INLINEABLE pokeArray2DAsync #-}-pokeArray2DAsync- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> HostPtr a -- ^ source array- -> Int -- ^ source array width- -> DevicePtr a -- ^ destination array- -> Int -- ^ destination array width- -> Maybe Stream- -> IO ()-pokeArray2DAsync !w !h !hptr !hw !dptr !dw !mst =- memcpy2DAsync (useDevicePtr dptr) dw (useHostPtr hptr) hw w h HostToDevice mst---- |--- Write a list of storable elements into a device array. The array must be--- sufficiently large to hold the entire list. This requires two marshalling--- operations----{-# INLINEABLE pokeListArray #-}-pokeListArray :: Storable a => [a] -> DevicePtr a -> IO ()-pokeListArray !xs !dptr = F.withArrayLen xs $ \len p -> pokeArray len p dptr----- |--- Copy the given number of elements from the first device array (source) to the--- second (destination). The copied areas may not overlap. This operation is--- asynchronous with respect to host, but will not overlap other device--- operations.----{-# INLINEABLE copyArray #-}-copyArray :: Storable a => Int -> DevicePtr a -> DevicePtr a -> IO ()-copyArray !n !src !dst = memcpy (useDevicePtr dst) (useDevicePtr src) n DeviceToDevice----- |--- Copy the given number of elements from the first device array (source) to the--- second (destination). The copied areas may not overlap. This operation is--- asynchronous with respect to the host, and may be associated with a--- particular stream.----{-# INLINEABLE copyArrayAsync #-}-copyArrayAsync :: Storable a => Int -> DevicePtr a -> DevicePtr a -> Maybe Stream -> IO ()-copyArrayAsync !n !src !dst !mst =- memcpyAsync (useDevicePtr dst) (useDevicePtr src) n DeviceToDevice mst----- |--- Copy a 2D memory area from the first device array (source) to the second--- (destination). The copied areas may not overlap. This operation is--- asynchronous with respect to the host, but will not overlap other device--- operations.----{-# INLINEABLE copyArray2D #-}-copyArray2D- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> DevicePtr a -- ^ source array- -> Int -- ^ source array width- -> DevicePtr a -- ^ destination array- -> Int -- ^ destination array width- -> IO ()-copyArray2D !w !h !src !sw !dst !dw =- memcpy2D (useDevicePtr dst) dw (useDevicePtr src) sw w h DeviceToDevice----- |--- Copy a 2D memory area from the first device array (source) to the second--- device array (destination). The copied areas may not overlay. This operation--- is asynchronous with respect to the host, and may be associated with a--- particular stream.----{-# INLINEABLE copyArray2DAsync #-}-copyArray2DAsync- :: Storable a- => Int -- ^ width to copy (elements)- -> Int -- ^ height to copy (elements)- -> DevicePtr a -- ^ source array- -> Int -- ^ source array width- -> DevicePtr a -- ^ destination array- -> Int -- ^ destination array width- -> Maybe Stream- -> IO ()-copyArray2DAsync !w !h !src !sw !dst !dw !mst =- memcpy2DAsync (useDevicePtr dst) dw (useDevicePtr src) sw w h DeviceToDevice mst-------- Memory copy kind----{# enum cudaMemcpyKind as CopyDirection {}- with prefix="cudaMemcpy" deriving (Eq, Show) #}---- |--- Copy data between host and device. This is a synchronous operation.----{-# INLINEABLE memcpy #-}-memcpy :: Storable a- => Ptr a -- ^ destination- -> Ptr a -- ^ source- -> Int -- ^ number of elements- -> CopyDirection- -> IO ()-memcpy !dst !src !n !dir = doMemcpy undefined dst- where- doMemcpy :: Storable a' => a' -> Ptr a' -> IO ()- doMemcpy x _ =- nothingIfOk =<< cudaMemcpy dst src (fromIntegral n * fromIntegral (sizeOf x)) dir--{-# INLINE cudaMemcpy #-}-{# fun cudaMemcpy- { castPtr `Ptr a'- , castPtr `Ptr a'- , cIntConv `Int64'- , cFromEnum `CopyDirection' } -> `Status' cToEnum #}----- |--- Copy data between the host and device asynchronously, possibly associated--- with a particular stream. The host-side memory must be page-locked (allocated--- with 'mallocHostArray').----{-# INLINEABLE memcpyAsync #-}-memcpyAsync :: Storable a- => Ptr a -- ^ destination- -> Ptr a -- ^ source- -> Int -- ^ number of elements- -> CopyDirection- -> Maybe Stream- -> IO ()-memcpyAsync !dst !src !n !kind !mst = doMemcpy undefined dst- where- doMemcpy :: Storable a' => a' -> Ptr a' -> IO ()- doMemcpy x _ =- let bytes = fromIntegral n * fromIntegral (sizeOf x) in- nothingIfOk =<< cudaMemcpyAsync dst src bytes kind (fromMaybe defaultStream mst)--{-# INLINE cudaMemcpyAsync #-}-{# fun cudaMemcpyAsync- { castPtr `Ptr a'- , castPtr `Ptr a'- , cIntConv `Int64'- , cFromEnum `CopyDirection'- , useStream `Stream' } -> `Status' cToEnum #}----- |--- Copy a 2D memory area between the host and device. This is a synchronous--- operation.----{-# INLINEABLE memcpy2D #-}-memcpy2D :: Storable a- => Ptr a -- ^ destination- -> Int -- ^ width of destination array- -> Ptr a -- ^ source- -> Int -- ^ width of source array- -> Int -- ^ width to copy- -> Int -- ^ height to copy- -> CopyDirection- -> IO ()-memcpy2D !dst !dw !src !sw !w !h !kind = doCopy undefined dst- where- doCopy :: Storable a' => a' -> Ptr a' -> IO ()- doCopy x _ =- let bytes = fromIntegral (sizeOf x)- dw' = fromIntegral dw * bytes- sw' = fromIntegral sw * bytes- w' = fromIntegral w * bytes- h' = fromIntegral h- in- nothingIfOk =<< cudaMemcpy2D dst dw' src sw' w' h' kind--{-# INLINE cudaMemcpy2D #-}-{# fun cudaMemcpy2D- { castPtr `Ptr a'- , `Int64'- , castPtr `Ptr a'- , `Int64'- , `Int64'- , `Int64'- , cFromEnum `CopyDirection'- }- -> `Status' cToEnum #}----- |--- Copy a 2D memory area between the host and device asynchronously, possibly--- associated with a particular stream. The host-side memory must be--- page-locked.----{-# INLINEABLE memcpy2DAsync #-}-memcpy2DAsync :: Storable a- => Ptr a -- ^ destination- -> Int -- ^ width of destination array- -> Ptr a -- ^ source- -> Int -- ^ width of source array- -> Int -- ^ width to copy- -> Int -- ^ height to copy- -> CopyDirection- -> Maybe Stream- -> IO ()-memcpy2DAsync !dst !dw !src !sw !w !h !kind !mst = doCopy undefined dst- where- doCopy :: Storable a' => a' -> Ptr a' -> IO ()- doCopy x _ =- let bytes = fromIntegral (sizeOf x)- dw' = fromIntegral dw * bytes- sw' = fromIntegral sw * bytes- w' = fromIntegral w * bytes- h' = fromIntegral h- st = fromMaybe defaultStream mst- in- nothingIfOk =<< cudaMemcpy2DAsync dst dw' src sw' w' h' kind st--{-# INLINE cudaMemcpy2DAsync #-}-{# fun cudaMemcpy2DAsync- { castPtr `Ptr a'- , `Int64'- , castPtr `Ptr a'- , `Int64'- , `Int64'- , `Int64'- , cFromEnum `CopyDirection'- , useStream `Stream'- }- -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Combined Allocation and Marshalling------------------------------------------------------------------------------------- |--- Write a list of storable elements into a newly allocated device array,--- returning the device pointer together with the number of elements that were--- written. Note that this requires two copy operations: firstly from a Haskell--- list into a heap-allocated array, and from there into device memory. The--- array should be 'free'd when no longer required.----{-# INLINEABLE newListArrayLen #-}-newListArrayLen :: Storable a => [a] -> IO (DevicePtr a, Int)-newListArrayLen !xs =- F.withArrayLen xs $ \len p ->- bracketOnError (mallocArray len) free $ \d_xs -> do- pokeArray len p d_xs- return (d_xs, len)----- |--- Write a list of storable elements into a newly allocated device array. This--- is 'newListArrayLen' composed with 'fst'.----{-# INLINEABLE newListArray #-}-newListArray :: Storable a => [a] -> IO (DevicePtr a)-newListArray !xs = fst `fmap` newListArrayLen xs----- |--- Temporarily store a list of elements into a newly allocated device array. An--- IO action is applied to the array, the result of which is returned. Similar--- to 'newListArray', this requires two marshalling operations of the data.------ As with 'allocaArray', the memory is freed once the action completes, so you--- should not return the pointer from the action, and be sure that any--- asynchronous operations (such as kernel execution) have completed.----{-# INLINEABLE withListArray #-}-withListArray :: Storable a => [a] -> (DevicePtr a -> IO b) -> IO b-withListArray !xs = withListArrayLen xs . const----- |--- A variant of 'withListArray' which also supplies the number of elements in--- the array to the applied function----{-# INLINEABLE withListArrayLen #-}-withListArrayLen :: Storable a => [a] -> (Int -> DevicePtr a -> IO b) -> IO b-withListArrayLen !xs !f =- bracket (newListArrayLen xs) (free . fst) (uncurry . flip $ f)------ XXX: Will this attempt to double-free the device array on error (together--- with newListArrayLen)?----------------------------------------------------------------------------------------- Utility------------------------------------------------------------------------------------- |--- Initialise device memory to a given 8-bit value----{-# INLINEABLE memset #-}-memset :: DevicePtr a -- ^ The device memory- -> Int64 -- ^ Number of bytes- -> Int8 -- ^ Value to set for each byte- -> IO ()-memset !dptr !bytes !symbol = nothingIfOk =<< cudaMemset dptr symbol bytes--{-# INLINE cudaMemset #-}-{# fun unsafe cudaMemset- { dptr `DevicePtr a'- , cIntConv `Int8'- , cIntConv `Int64' } -> `Status' cToEnum #}- where- dptr = useDevicePtr . castDevPtr-
− src/Foreign/CUDA/Runtime/Stream.chs
@@ -1,115 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Stream--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Stream management routines--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Stream (-- -- * Stream Management- Stream(..),- create, destroy, finished, block, defaultStream--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad ( liftM )-import Control.Exception ( throwIO )-------------------------------------------------------------------------------------- Functions------------------------------------------------------------------------------------- |--- Create a new asynchronous stream----{-# INLINEABLE create #-}-create :: IO Stream-create = resultIfOk =<< cudaStreamCreate--{-# INLINE cudaStreamCreate #-}-{# fun unsafe cudaStreamCreate- { alloca- `Stream' peekStream* } -> `Status' cToEnum #}----- |--- Destroy and clean up an asynchronous stream----{-# INLINEABLE destroy #-}-destroy :: Stream -> IO ()-destroy !s = nothingIfOk =<< cudaStreamDestroy s--{-# INLINE cudaStreamDestroy #-}-{# fun unsafe cudaStreamDestroy- { useStream `Stream' } -> `Status' cToEnum #}----- |--- Determine if all operations in a stream have completed----{-# INLINEABLE finished #-}-finished :: Stream -> IO Bool-finished !s =- cudaStreamQuery s >>= \rv -> do- case rv of- Success -> return True- NotReady -> return False- _ -> throwIO (ExitCode rv)--{-# INLINE cudaStreamQuery #-}-{# fun unsafe cudaStreamQuery- { useStream `Stream' } -> `Status' cToEnum #}----- |--- Block until all operations in a Stream have been completed----{-# INLINEABLE block #-}-block :: Stream -> IO ()-block !s = nothingIfOk =<< cudaStreamSynchronize s--{-# INLINE cudaStreamSynchronize #-}-{# fun cudaStreamSynchronize- { useStream `Stream' } -> `Status' cToEnum #}----- |--- The main execution stream (0)------ {-# INLINE defaultStream #-}--- defaultStream :: Stream--- #if CUDART_VERSION < 3010--- defaultStream = Stream 0--- #else--- defaultStream = Stream nullPtr--- #endif------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------{-# INLINE peekStream #-}-peekStream :: Ptr {#type cudaStream_t#} -> IO Stream-#if CUDART_VERSION < 3010-peekStream = liftM Stream . peekIntConv-#else-peekStream = liftM Stream . peek-#endif-
− src/Foreign/CUDA/Runtime/Texture.chs
@@ -1,203 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Texture--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Texture references--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Texture (-- -- * Texture Reference Management- Texture(..), FormatKind(..), AddressMode(..), FilterMode(..), FormatDesc(..),- bind, bind2D--) where---- Friends-import Foreign.CUDA.Ptr-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Data.Int-import Foreign-import Foreign.C--#include "cbits/stubs.h"-{# context lib="cudart" #}--#c-typedef struct textureReference textureReference;-typedef struct cudaChannelFormatDesc cudaChannelFormatDesc;-#endc------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |A texture reference----{# pointer *textureReference as ^ -> Texture #}--data Texture = Texture- {- normalised :: !Bool, -- ^ access texture using normalised coordinates [0.0,1.0)- filtering :: !FilterMode,- addressing :: !(AddressMode, AddressMode, AddressMode),- format :: !FormatDesc- }- deriving (Eq, Show)---- |Texture channel format kind----{# enum cudaChannelFormatKind as FormatKind- { }- with prefix="cudaChannelFormatKind" deriving (Eq, Show) #}---- |Texture addressing mode----{# enum cudaTextureAddressMode as AddressMode- { }- with prefix="cudaAddressMode" deriving (Eq, Show) #}---- |Texture filtering mode----{# enum cudaTextureFilterMode as FilterMode- { }- with prefix="cudaFilterMode" deriving (Eq, Show) #}----- |A description of how memory read through the texture cache should be--- interpreted, including the kind of data and the number of bits of each--- component (x,y,z and w, respectively).----{# pointer *cudaChannelFormatDesc as ^ foreign -> FormatDesc nocode #}--data FormatDesc = FormatDesc- {- depth :: !(Int,Int,Int,Int),- kind :: !FormatKind- }- deriving (Eq, Show)--instance Storable FormatDesc where- sizeOf _ = {# sizeof cudaChannelFormatDesc #}- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- dx <- cIntConv `fmap` {# get cudaChannelFormatDesc.x #} p- dy <- cIntConv `fmap` {# get cudaChannelFormatDesc.y #} p- dz <- cIntConv `fmap` {# get cudaChannelFormatDesc.z #} p- dw <- cIntConv `fmap` {# get cudaChannelFormatDesc.w #} p- df <- cToEnum `fmap` {# get cudaChannelFormatDesc.f #} p- return $ FormatDesc (dx,dy,dz,dw) df-- poke p (FormatDesc (x,y,z,w) k) = do- {# set cudaChannelFormatDesc.x #} p (cIntConv x)- {# set cudaChannelFormatDesc.y #} p (cIntConv y)- {# set cudaChannelFormatDesc.z #} p (cIntConv z)- {# set cudaChannelFormatDesc.w #} p (cIntConv w)- {# set cudaChannelFormatDesc.f #} p (cFromEnum k)---instance Storable Texture where- sizeOf _ = {# sizeof textureReference #}- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- norm <- cToBool `fmap` {# get textureReference.normalized #} p- fmt <- cToEnum `fmap` {# get textureReference.filterMode #} p- dsc <- peek . castPtr =<< {# get textureReference.channelDesc #} p- [x,y,z] <- peekArrayWith cToEnum 3 =<< {# get textureReference.addressMode #} p- return $ Texture norm fmt (x,y,z) dsc-- poke p (Texture norm fmt (x,y,z) dsc) = do- {# set textureReference.normalized #} p (cFromBool norm)- {# set textureReference.filterMode #} p (cFromEnum fmt)- withArray (map cFromEnum [x,y,z]) ({# set textureReference.addressMode #} p)-- -- c2hs is returning the wrong type for structs-within-structs- dscptr <- {# get textureReference.channelDesc #} p- poke (castPtr dscptr) dsc-------------------------------------------------------------------------------------- Texture References------------------------------------------------------------------------------------- |Bind the memory area associated with the device pointer to a texture--- reference given by the named symbol. Any previously bound references are--- unbound.----{-# INLINEABLE bind #-}-bind :: String -> Texture -> DevicePtr a -> Int64 -> IO ()-bind !name !tex !dptr !bytes = do- ref <- getTex name- poke ref tex- nothingIfOk =<< cudaBindTexture ref dptr (format tex) bytes--{-# INLINE cudaBindTexture #-}-{# fun unsafe cudaBindTexture- { alloca- `Int'- , id `TextureReference'- , dptr `DevicePtr a'- , with_* `FormatDesc'- , `Int64' } -> `Status' cToEnum #}- where dptr = useDevicePtr . castDevPtr---- |Bind the two-dimensional memory area to the texture reference associated--- with the given symbol. The size of the area is constrained by (width,height)--- in texel units, and the row pitch in bytes. Any previously bound references--- are unbound.----{-# INLINEABLE bind2D #-}-bind2D :: String -> Texture -> DevicePtr a -> (Int,Int) -> Int64 -> IO ()-bind2D !name !tex !dptr (!width,!height) !bytes = do- ref <- getTex name- poke ref tex- nothingIfOk =<< cudaBindTexture2D ref dptr (format tex) width height bytes--{-# INLINE cudaBindTexture2D #-}-{# fun unsafe cudaBindTexture2D- { alloca- `Int'- , id `TextureReference'- , dptr `DevicePtr a'- , with_* `FormatDesc'- , `Int'- , `Int'- , `Int64' } -> `Status' cToEnum #}- where dptr = useDevicePtr . castDevPtr----- |Returns the texture reference associated with the given symbol----{-# INLINEABLE getTex #-}-getTex :: String -> IO TextureReference-getTex !name = resultIfOk =<< cudaGetTextureReference name--{-# INLINE cudaGetTextureReference #-}-{# fun unsafe cudaGetTextureReference- { alloca- `Ptr Texture' peek*- , withCString_* `String' } -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------{-# INLINE with_ #-}-with_ :: Storable a => a -> (Ptr a -> IO b) -> IO b-with_ = with----- CUDA 5.0 changed the types of some attributes from char* to void*----{-# INLINE withCString_ #-}-withCString_ :: String -> (Ptr a -> IO b) -> IO b-withCString_ !str !fn = withCString str (fn . castPtr)-
− src/Foreign/CUDA/Runtime/Utils.chs
@@ -1,63 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module : Foreign.CUDA.Runtime.Utils--- Copyright : [2009..2017] Trevor L. McDonell--- License : BSD------ Utility functions--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Utils (-- runtimeVersion,- driverVersion,- libraryVersion,--) where--#include "cbits/stubs.h"-{# context lib="cudart" #}---- Friends-import Foreign.CUDA.Runtime.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C----- |--- Return the version number of the installed CUDA driver----{-# INLINEABLE runtimeVersion #-}-runtimeVersion :: IO Int-runtimeVersion = resultIfOk =<< cudaRuntimeGetVersion--{-# INLINE cudaRuntimeGetVersion #-}-{# fun unsafe cudaRuntimeGetVersion- { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}----- |--- Return the version number of the installed CUDA runtime----{-# INLINEABLE driverVersion #-}-driverVersion :: IO Int-driverVersion = resultIfOk =<< cudaDriverGetVersion--{-# INLINE cudaDriverGetVersion #-}-{# fun unsafe cudaDriverGetVersion- { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}----- |--- Return the version number of the CUDA library (API) that this package was--- compiled against.----{-# INLINEABLE libraryVersion #-}-libraryVersion :: Int-libraryVersion = {#const CUDART_VERSION #}-
− 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-
− src/Text/Show/Describe.hs
@@ -1,18 +0,0 @@------------------------------------------------------------------------------------ |--- Module : Text.Show.Describe--- Copyright : [2016..2017] Trevor L. McDonell--- License : BSD--------------------------------------------------------------------------------------module Text.Show.Describe- where----- | Like 'Text.Show.Show', but focuses on providing a more detailed description--- of the value rather than a 'Text.Read.read'able representation.----class Describe a where- describe :: a -> String-