packages feed

cuda 0.7.5.0 → 0.7.5.1

raw patch · 78 files changed

+8113/−8038 lines, 78 filessetup-changed

Files

− Foreign/CUDA.hs 
@@ -1,19 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA--- Copyright : [2009..2014] 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-
− Foreign/CUDA/Analysis.hs 
@@ -1,20 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Analysis--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Meta-module exporting CUDA analysis routines--------------------------------------------------------------------------------------module Foreign.CUDA.Analysis (--  module Foreign.CUDA.Analysis.Device,-  module Foreign.CUDA.Analysis.Occupancy--) where--import Foreign.CUDA.Analysis.Device-import Foreign.CUDA.Analysis.Occupancy-
− Foreign/CUDA/Analysis/Device.chs 
@@ -1,181 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Analysis.Device--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Common device functions--------------------------------------------------------------------------------------module Foreign.CUDA.Analysis.Device-  (-    Compute(..), ComputeMode(..),-    DeviceProperties(..), DeviceResources(..), Allocation(..), PCI(..),-    deviceResources-  )-  where--#include "cbits/stubs.h"--import Data.Int-import Debug.Trace----- |--- The compute mode the device is currently in----{# enum CUcomputemode as ComputeMode-    { underscoreToCase }-    with prefix="CU_COMPUTEMODE" deriving (Eq, Show) #}---- |--- GPU compute capability, major and minor revision number respectively.----data Compute = Compute !Int !Int-  deriving Eq--instance Show Compute where-  show (Compute major minor) = show major ++ "." ++ show minor--instance Ord Compute where-  compare (Compute m1 n1) (Compute m2 n2) =-    case compare m1 m2 of-      EQ -> compare n1 n2-      x  -> x--{---cap :: Int -> Int -> Double-cap a 0 = fromIntegral a-cap a b = let a' = fromIntegral a in-            let b' = fromIntegral b in-            a' + b' / max 10 (10^ ((ceiling . logBase 10) b' :: Int))---}---- |--- The properties of a compute device----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-#if CUDA_VERSION >= 4000-  , 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-#if CUDA_VERSION >= 3000-  , 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-#if CUDA_VERSION >= 4000-  , 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-#if CUDA_VERSION >= 3000-  , 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-#endif-  , 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-#endif-#if CUDA_VERSION >= 5050-  , 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-#endif-  }-  deriving (Show)---data PCI = PCI-  {-    busID       :: !Int,                -- ^ PCI bus ID of the device-    deviceID    :: !Int,                -- ^ PCI device ID-    domainID    :: !Int                 -- ^ PCI domain ID-  }-  deriving (Show)----- GPU Hardware Resources----data Allocation      = Warp | Block-data DeviceResources = DeviceResources-  {-    threadsPerWarp      :: !Int,        -- ^ Warp size-    threadsPerMP        :: !Int,        -- ^ Maximum number of in-flight threads on a multiprocessor-    threadBlocksPerMP   :: !Int,        -- ^ Maximum number of thread blocks resident on a multiprocessor-    warpsPerMP          :: !Int,        -- ^ Maximum number of in-flight warps per multiprocessor-    coresPerMP          :: !Int,        -- ^ Number of SIMD arithmetic units per multiprocessor-    sharedMemPerMP      :: !Int,        -- ^ Total amount of shared memory per multiprocessor (bytes)-    sharedMemAllocUnit  :: !Int,        -- ^ Shared memory allocation unit size (bytes)-    regFileSize         :: !Int,        -- ^ Total number of registers in a multiprocessor-    regAllocUnit        :: !Int,        -- ^ Register allocation unit size-    regAllocWarp        :: !Int,        -- ^ Register allocation granularity for warps-    regPerThread        :: !Int,        -- ^ Maximum number of registers per thread-    allocation          :: !Allocation  -- ^ How multiprocessor resources are divided-  }----- |--- Extract some additional hardware resource limitations for a given device.----deviceResources :: DeviceProperties -> DeviceResources-deviceResources = resources . computeCapability-  where-    -- This is mostly extracted from tables in the CUDA occupancy calculator.-    ---    resources compute = case compute of-      Compute 1 0 -> DeviceResources 32  768  8 24   8  16384 512   8192 256 2 124 Block  -- Tesla G80-      Compute 1 1 -> DeviceResources 32  768  8 24   8  16384 512   8192 256 2 124 Block  -- Tesla G8x-      Compute 1 2 -> DeviceResources 32 1024  8 32   8  16384 512  16384 512 2 124 Block  -- Tesla G9x-      Compute 1 3 -> DeviceResources 32 1024  8 32   8  16384 512  16384 512 2 124 Block  -- Tesla GT200-      Compute 2 0 -> DeviceResources 32 1536  8 48  32  49152 128  32768  64 2  63 Warp   -- Fermi GF100-      Compute 2 1 -> DeviceResources 32 1536  8 48  48  49152 128  32768  64 2  63 Warp   -- Fermi GF10x-      Compute 3 0 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4  63 Warp   -- Kepler GK10x-      Compute 3 2 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4 255 Warp   -- Jetson TK1-      Compute 3 5 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4 255 Warp   -- Kepler GK11x-      Compute 3 7 -> DeviceResources 32 2048 16 64 192 114688 256 131072 256 4 266 Warp   -- Kepler GK21x-      Compute 5 0 -> DeviceResources 32 2048 32 64 128  65536 256  65536 256 4 255 Warp   -- Maxwell GM10x-      Compute 5 2 -> DeviceResources 32 2048 32 64 128  98304 256  65536 256 4 255 Warp   -- Maxwell GM20x-      Compute 5 3 -> DeviceResources 32 2048 32 64 128  65536 256  65536 256 4 255 Warp   -- Maxwell GM20B--      -- 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.-      ---      -- This is slightly dodgy as the warning message is coming from pure code.-      -- 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" ]-
− Foreign/CUDA/Analysis/Occupancy.hs 
@@ -1,207 +0,0 @@-{-# LANGUAGE BangPatterns #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Analysis.Occupancy--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Occupancy calculations for CUDA kernels------ <http://developer.download.nvidia.com/compute/cuda/3_0/sdk/docs/CUDA_Occupancy_calculator.xls>------ /Determining Registers Per Thread and Shared Memory Per Block/------ To determine the number of registers used per thread in your kernel, simply--- compile the kernel code using the option------ > --ptxas-options=-v------ to nvcc.  This will output information about register, local memory, shared--- memory, and constant memory usage for each kernel in the @.cu@ file.--- Alternatively, you can compile with the @-cubin@ option to nvcc.  This will--- generate a @.cubin@ file, which you can open in a text editor.  Look for the--- @code@ section with your kernel's name.  Within the curly braces (@{ ... }@)--- for that code block, you will see a line with @reg = X@, where @x@ is the--- number of registers used by your kernel.  You can also see the amount of--- shared memory used as @smem = Y@.  However, if your kernel declares any--- external shared memory that is allocated dynamically, you will need to add--- the number in the @.cubin@ file to the amount you dynamically allocate at run--- time to get the correct shared memory usage.------ /Notes About Occupancy/------ Higher occupancy does not necessarily mean higher performance.  If a kernel--- is not bandwidth bound, then increasing occupancy will not necessarily--- increase performance.  If a kernel invocation is already running at least one--- thread block per multiprocessor in the GPU, and it is bottlenecked by--- computation and not by global memory accesses, then increasing occupancy may--- have no effect.  In fact, making changes just to increase occupancy can have--- other effects, such as additional instructions, spills to local memory (which--- is off chip), divergent branches, etc.  As with any optimization, you should--- experiment to see how changes affect the *wall clock time* of the kernel--- execution.  For bandwidth bound applications, on the other hand, increasing--- occupancy can help better hide the latency of memory accesses, and therefore--- improve performance.---------------------------------------------------------------------------------------module Foreign.CUDA.Analysis.Occupancy (--    Occupancy(..),-    occupancy, optimalBlockSize, optimalBlockSizeOf, maxResidentBlocks,-    incPow2, incWarp, decPow2, decWarp--) where--import Data.Ord-import Data.List--import Foreign.CUDA.Analysis.Device----- GPU Occupancy per multiprocessor----data Occupancy = Occupancy-  {-    activeThreads      :: !Int,         -- ^ Active threads per multiprocessor-    activeThreadBlocks :: !Int,         -- ^ Active thread blocks per multiprocessor-    activeWarps        :: !Int,         -- ^ Active warps per multiprocessor-    occupancy100       :: !Double       -- ^ Occupancy of each multiprocessor (percent)-  }-  deriving (Eq, Ord, Show)----- |--- Calculate occupancy data for a given GPU and kernel resource usage----{-# INLINEABLE occupancy #-}-occupancy-    :: DeviceProperties -- ^ Properties of the card in question-    -> Int              -- ^ Threads per block-    -> Int              -- ^ Registers per thread-    -> Int              -- ^ Shared memory per block (bytes)-    -> Occupancy-occupancy !dev !thds !regs !smem-  = Occupancy at ab aw oc-  where-    at = ab * thds-    aw = ab * warps-    ab = minimum [limitWarpBlock, limitRegMP, limitSMemMP]-    oc = 100 * fromIntegral aw / fromIntegral (warpsPerMP gpu)--    regs' = 1 `max` regs-    smem' = 1 `max` smem--    ceiling'      = ceiling :: Double -> Int-    ceilingBy x s = s * ceiling' (fromIntegral x / fromIntegral s)--    -- Physical resources-    ---    gpu = deviceResources dev--    -- Allocation per thread block-    ---    warps     = ceiling' (fromIntegral thds / fromIntegral (threadsPerWarp gpu))-    sharedMem = ceilingBy smem' (sharedMemAllocUnit gpu)-    registers = case allocation gpu of-      Block -> (warps `ceilingBy` regAllocWarp gpu * regs' * threadsPerWarp gpu) `ceilingBy` regAllocUnit gpu-      Warp  -> warps * ceilingBy (regs' * threadsPerWarp gpu) (regAllocUnit gpu)--    -- Maximum thread blocks per multiprocessor-    ---    limitWarpBlock = threadBlocksPerMP gpu `min` (warpsPerMP gpu     `div` warps)-    limitRegMP     = threadBlocksPerMP gpu `min` (regFileSize gpu    `div` registers)-    limitSMemMP    = threadBlocksPerMP gpu `min` (sharedMemPerMP gpu `div` sharedMem)----- |--- Optimise multiprocessor occupancy as a function of thread block size and--- resource usage. This returns the smallest satisfying block size in increments--- of a single warp.----{-# INLINEABLE optimalBlockSize #-}-optimalBlockSize-    :: DeviceProperties         -- ^ Architecture to optimise for-    -> (Int -> Int)             -- ^ Register count as a function of thread block size-    -> (Int -> Int)             -- ^ Shared memory usage (bytes) as a function of thread block size-    -> (Int, Occupancy)-optimalBlockSize dev = optimalBlockSizeOf dev (decWarp dev)----- |--- As 'optimalBlockSize', but with a generator that produces the specific thread--- block sizes that should be tested. The generated list can produce values in--- any order, but the last satisfying block size will be returned. Hence, values--- should be monotonically decreasing to return the smallest block size yielding--- maximum occupancy, and vice-versa.----{-# INLINEABLE optimalBlockSizeOf #-}-optimalBlockSizeOf-    :: DeviceProperties         -- ^ Architecture to optimise for-    -> [Int]                    -- ^ Thread block sizes to consider-    -> (Int -> Int)             -- ^ Register count as a function of thread block size-    -> (Int -> Int)             -- ^ Shared memory usage (bytes) as a function of thread block size-    -> (Int, Occupancy)-optimalBlockSizeOf !dev !threads !freg !fsmem-  = maximumBy (comparing (occupancy100 . snd))-  $ [ (t, occupancy dev t (freg t) (fsmem t)) | t <- threads ]----- | Increments in powers-of-two, over the range of supported thread block sizes--- for the given device.----{-# INLINEABLE incPow2 #-}-incPow2 :: DeviceProperties -> [Int]-incPow2 !dev = map ((2::Int)^) [lb, lb+1 .. ub]-  where-    round' = round :: Double -> Int-    lb     = round' . logBase 2 . fromIntegral $ warpSize dev-    ub     = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev---- | Decrements in powers-of-two, over the range of supported thread block sizes--- for the given device.----{-# INLINEABLE decPow2 #-}-decPow2 :: DeviceProperties -> [Int]-decPow2 !dev = map ((2::Int)^) [ub, ub-1 .. lb]-  where-    round' = round :: Double -> Int-    lb     = round' . logBase 2 . fromIntegral $ warpSize dev-    ub     = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev---- | Decrements in the warp size of the device, over the range of supported--- thread block sizes.----{-# INLINEABLE decWarp #-}-decWarp :: DeviceProperties -> [Int]-decWarp !dev = [block, block-warp .. warp]-  where-    !warp  = warpSize dev-    !block = maxThreadsPerBlock dev---- | Increments in the warp size of the device, over the range of supported--- thread block sizes.----{-# INLINEABLE incWarp #-}-incWarp :: DeviceProperties -> [Int]-incWarp !dev = [warp, 2*warp .. block]-  where-    warp  = warpSize dev-    block = maxThreadsPerBlock dev----- |--- Determine the maximum number of CTAs that can be run simultaneously for a--- given kernel / device combination.----{-# INLINEABLE maxResidentBlocks #-}-maxResidentBlocks-  :: DeviceProperties   -- ^ Properties of the card in question-  -> Int                -- ^ Threads per block-  -> Int                -- ^ Registers per thread-  -> Int                -- ^ Shared memory per block (bytes)-  -> Int                -- ^ Maximum number of resident blocks-maxResidentBlocks !dev !thds !regs !smem =-  multiProcessorCount dev * activeThreadBlocks (occupancy dev thds regs smem)-
− Foreign/CUDA/Driver.hs 
@@ -1,238 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ This module defines an interface to the CUDA driver API. The Driver API--- is a lower-level interface to CUDA devices than that provided by the--- Runtime API. Using the Driver API, the programmer must deal explicitly--- with operations such as initialisation, context management, and loading--- (kernel) modules. Although more difficult to use initially, the Driver--- API provides more control over how CUDA is used. Furthermore, since it--- does not require compiling and linking the program with 'nvcc', the--- Driver API provides better inter-language compatibility.-  ----- The following is a short tutorial on using the Driver API. The steps can--- be copied into a file, or run directly in `ghci`, in which case `ghci`--- should be launched with the option `-fno-ghci-sandbox`. This is because--- CUDA maintains CPU-local state, so operations should always be run from--- a bound thread.--------- [/Using the Driver API/]------ Before any operation can be performed, the Driver API must be--- initialised:------ >>> import Foreign.CUDA.Driver--- >>> initialise []------ 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--- 'props'. The number of available CUDA-capable devices is given via--- 'count'. For example:------ >>> count--- 1--- >>> dev0 <- device 0--- >>> props dev0--- DeviceProperties {deviceName = "GeForce GT 650M", computeCapability = 3.0, ...}------ This package also includes the executable 'nvidia-device-query', which when--- executed displays the key properties of all available devices. See--- "Foreign.CUDA.Driver.Device" for additional operations to query the--- capabilities or status of a device.------ Once you have chosen a device to use, the next step is to create a CUDA--- context. A context is associated with a particular device, and all--- operations, such as memory allocation and kernel execution, take place--- with respect to that context. For example, to 'create' a new execution--- context on CUDA device 0:------ >>> ctx <- create dev0 []------ The second argument is a set of 'ContextFlag's which control how the--- context behaves in various situations, for example, whether or not the--- CPU should actively spin when waiting for results from the GPU--- ('SchedSpin'), or to yield control to other threads instead--- ('SchedYield').------ The newly created context is now the /active/ context, and all--- subsequent operations take place within that context. More than one--- context can be created per device, but resources, such as memory--- allocated in the GPU, are unique to each context. The module--- "Foreign.CUDA.Driver.Context" contains operations for managing multiple--- contexts. Some devices allow data to be shared between contexts without--- copying, see "Foreign.CUDA.Driver.Context.Peer" for more information.------ Once the context is no longer needed, it should be 'destroy'ed in order--- to free up any resources that were allocated to it.------ >>> destroy ctx------ Each device also has a unique context which is used by the Runtime API.--- This context can be accessed with the module--- "Foreign.CUDA.Driver.Context.Primary".--------- [/Executing kernels onto the GPU/]------ Once the Driver API is initialised and an execution context is created--- on the GPU, we can begin to interact with it.------ At an example, we'll step through executing the CUDA equivalent of the--- following Haskell function, which element-wise adds the elements of two--- arrays:------ >>> vecAdd xs ys = zipWith (+) xs ys------ The following CUDA kernel can be used to implement this on the GPU:------ > extern "C" __global__ void vecAdd(float *xs, float *ys, float *zs, int N)--- > {--- >     int ix = blockIdx.x * blockDim.x + threadIdx.x;--- >--- >     if ( ix < N ) {--- >         zs[ix] = xs[ix] + ys[ix];--- >     }--- > }------ Here, the `__global__` keyword marks the function as a kernel that--- should be computed on the GPU in data parallel. When we execute this--- function on the GPU, (at least) /N/ threads will execute /N/ individual--- instances of the kernel function `vecAdd`. Each thread will operate on--- a single element of each input array to create a single value in the--- result. See the CUDA programming guide for more details.------ We can save this to a file `vector_add.cu`, and compile it using `nvcc`--- into a form that we can then load onto the GPU and execute:------ > $ nvcc --ptx vector_add.cu------ The module "Foreign.CUDA.Driver.Module" contains functions for loading--- the resulting .ptx file (or .cubin files) into the running program.------ >>> mdl <- loadFile "vector_add.ptx"------ Once finished with the module, it is also a good idea to 'unload' it.------ Modules may export kernel functions, global variables, and texture--- references. Before we can execute our function, we need to look it up in--- the module by name.------ >>> vecAdd <- getFun mdl "vecAdd"------ Given this reference to our kernel function, we are almost ready to--- execute it on the device using 'launchKernel', but first, we must create--- some data that we can execute the function on.--------- [/Transferring data to and from the GPU/]------ GPUs typically have their own memory which is separate from the CPU's--- memory, and we need to explicitly copy data back and forth between these--- two regions. The module "Foreign.CUDA.Driver.Marshal" provides functions--- for allocating memory on the GPU, and copying data between the CPU and--- GPU, as well as directly between multiple GPUs.------ For simplicity, we'll use standard Haskell lists for our input and--- output data structure. Note however that this will have significantly--- lower effective bandwidth than reading a single contiguous region of--- memory, so for most practical purposes you will want to use some kind of--- unboxed array.------ >>> let xs = [1..1024]   :: [Float]--- >>> let ys = [2,4..2048] :: [Float]------ In CUDA, like C, all memory management is explicit, and arrays on the--- device must be explicitly allocated and freed. As mentioned previously,--- data transfer is also explicit. However, we do provide convenience--- functions for combined allocation and marshalling, as well as bracketed--- operations.------ >>> xs_dev <- newListArray xs--- >>> ys_dev <- newListArray ys--- >>> zs_dev <- mallocArray 1024 :: IO (DevicePtr Float)------ After executing the kernel (see next section), we transfer the result--- back to the host, and free the memory that was allocated on the GPU.------ >>> zs <- peekListArray 1024 zs_dev--- >>> free xs_dev--- >>> free ys_dev--- >>> free zs_dev--------- [/Piecing it all together/]------ Finally, we have everything in place to execute our operation on the--- GPU. Launching a kernel on the GPU consists of creating many threads on--- the GPU which all execute the same function, and each thread has--- a unique identifier in the grid/block hierarchy which can be used to--- identify exactly which element this thread should process (the--- `blockIdx` and `threadIdx` parameters that we saw earlier,--- respectively).------ To execute our function, we will use a grid of 4 blocks, each containing--- 256 threads. Thus, a total of 1024 threads will be launched, which will--- each compute a single element of the output array (recall that our input--- arrays each have 1024 elements). The module--- "Foreign.CUDA.Analysis.Occupancy" contains functions to help determine--- the ideal thread block size for a given kernel and GPU combination.------ >>> launchKernel vecAdd (4,1,1) (256,1,1) 0 Nothing [VArg xs_dev, VArg ys_dev, VArg zs_dev, IArg 1024]------ Note that kernel execution is asynchronous, so we should also wait for--- the operation to complete before attempting to read the results back.------ >>> sync------ And that's it!--------- [/Next steps/]------ As mentioned at the end of the previous section, kernels on the GPU are--- executed asynchronously with respect to the host, and other operations--- such as data transfers can also be executed asynchronously. This allows--- the CPU to continue doing other work while the GPU is busy.--- 'Foreign.CUDA.Driver.Event.Event's can be used to check whether an--- operation has completed yet.------ It is also possible to execute multiple kernels or data transfers--- concurrently with each other, by assigning those operations to different--- execution 'Foreign.CUDA.Driver.Stream.Stream's. Used in conjunction with--- 'Foreign.CUDA.Driver.Event.Event's, operations will be scheduled--- efficiently only once all dependencies (in the form of--- 'Foreign.CUDA.Driver.Event.Event's) have been cleared.------ See "Foreign.CUDA.Driver.Event" and "Foreign.CUDA.Driver.Stream" for--- more information on this topic.--------------------------------------------------------------------------------------module Foreign.CUDA.Driver (--  module Foreign.CUDA.Ptr,-  module Foreign.CUDA.Driver.Context,-  module Foreign.CUDA.Driver.Device,-  module Foreign.CUDA.Driver.Error,-  module Foreign.CUDA.Driver.Exec,-  module Foreign.CUDA.Driver.Marshal,-  module Foreign.CUDA.Driver.Module,-  module Foreign.CUDA.Driver.Utils--) where--import Foreign.CUDA.Ptr-import Foreign.CUDA.Driver.Context      hiding ( useContext, device )-import Foreign.CUDA.Driver.Device       hiding ( useDevice )-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Exec-import Foreign.CUDA.Driver.Marshal      hiding ( useDeviceHandle, peekDeviceHandle )-import Foreign.CUDA.Driver.Module-import Foreign.CUDA.Driver.Utils-
− Foreign/CUDA/Driver/Context.hs 
@@ -1,23 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Context--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ Context management for low-level driver interface---------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Context (--  module Foreign.CUDA.Driver.Context.Base,-  module Foreign.CUDA.Driver.Context.Config,-  module Foreign.CUDA.Driver.Context.Peer,--) where--import Foreign.CUDA.Driver.Context.Base-import Foreign.CUDA.Driver.Context.Config-import Foreign.CUDA.Driver.Context.Peer-
− Foreign/CUDA/Driver/Context/Base.chs 
@@ -1,241 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase                #-}-#endif------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Context.Base--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ Context management for the low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Context.Base (--  -- * Context Management-  Context(..), ContextFlag(..),-  create, destroy, device, pop, push, sync, get, set,--  -- Deprecated in CUDA-4.0-  attach, detach,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Device                       ( Device(..) )-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad                                    ( liftM )-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A device context----newtype Context = Context { useContext :: {# type CUcontext #}}-  deriving (Eq, Show)----- |--- Context creation flags----{# enum CUctx_flags as ContextFlag-    { underscoreToCase }-    with prefix="CU_CTX" deriving (Eq, Show, Bounded) #}---#if CUDA_VERSION >= 4000-{-# DEPRECATED attach, detach "as of CUDA-4.0" #-}-{-# DEPRECATED BlockingSync "use SchedBlockingSync instead" #-}-#endif-------------------------------------------------------------------------------------- Context management------------------------------------------------------------------------------------- |--- Create a new CUDA context and associate it with the calling thread. The--- context is created with a usage count of one, and the caller of 'create'--- must call 'destroy' when done using the context. If a context is already--- current to the thread, it is supplanted by the newly created context and--- must be restored by a subsequent call to 'pop'.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g65dc0012348bc84810e2103a40d8e2cf>----{-# INLINEABLE create #-}-create :: Device -> [ContextFlag] -> IO Context-create !dev !flags = resultIfOk =<< cuCtxCreate flags dev--{-# INLINE cuCtxCreate #-}-{# fun unsafe cuCtxCreate-  { alloca-         `Context'       peekCtx*-  , combineBitMasks `[ContextFlag]'-  , useDevice       `Device'                 } -> `Status' cToEnum #}-  where peekCtx = liftM Context . peek----- |--- Increments the usage count of the context. API: no context flags are--- currently supported, so this parameter must be empty.----{-# INLINEABLE attach #-}-attach :: Context -> [ContextFlag] -> IO ()-attach !ctx !flags = nothingIfOk =<< cuCtxAttach ctx flags--{-# INLINE cuCtxAttach #-}-{# fun unsafe cuCtxAttach-  { withCtx*        `Context'-  , combineBitMasks `[ContextFlag]' } -> `Status' cToEnum #}-  where withCtx = with . useContext----- |--- Detach the context, and destroy if no longer used----{-# INLINEABLE detach #-}-detach :: Context -> IO ()-detach !ctx = nothingIfOk =<< cuCtxDetach ctx--{-# INLINE cuCtxDetach #-}-{# fun unsafe cuCtxDetach-  { useContext `Context' } -> `Status' cToEnum #}----- |--- Destroy the specified context, regardless of how many threads it is--- current to. The context will be 'pop'ed from the current thread's--- context stack, but if it is current on any other threads it will remain--- current to those threads, and attempts to access it will result in an--- error.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g27a365aebb0eb548166309f58a1e8b8e>----{-# INLINEABLE destroy #-}-destroy :: Context -> IO ()-destroy !ctx = nothingIfOk =<< cuCtxDestroy ctx--{-# INLINE cuCtxDestroy #-}-{# fun unsafe cuCtxDestroy-  { useContext `Context' } -> `Status' cToEnum #}----- |--- Return the context bound to the calling CPU thread.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g8f13165846b73750693640fb3e8380d0>----{-# INLINEABLE get #-}-get :: IO (Maybe Context)-#if CUDA_VERSION < 4000-get = requireSDK 'get 4.0-#else-get = resultIfOk =<< cuCtxGetCurrent--{-# INLINE cuCtxGetCurrent #-}-{# fun unsafe cuCtxGetCurrent-  { alloca- `Maybe Context' peekCtx* } -> `Status' cToEnum #}-  where peekCtx = liftM (nothingIfNull Context) . peek-#endif----- |--- Bind the specified context to the calling thread.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gbe562ee6258b4fcc272ca6478ca2a2f7>----{-# INLINEABLE set #-}-set :: Context -> IO ()-#if CUDA_VERSION < 4000-set _    = requireSDK 'set 4.0-#else-set !ctx = nothingIfOk =<< cuCtxSetCurrent ctx--{-# INLINE cuCtxSetCurrent #-}-{# fun unsafe cuCtxSetCurrent-  { useContext `Context' } -> `Status' cToEnum #}-#endif----- |--- Return the device of the currently active context------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g4e84b109eba36cdaaade167f34ae881e>----{-# INLINEABLE device #-}-device :: IO Device-device = resultIfOk =<< cuCtxGetDevice--{-# INLINE cuCtxGetDevice #-}-{# fun unsafe cuCtxGetDevice-  { alloca- `Device' dev* } -> `Status' cToEnum #}-  where dev = liftM Device . peekIntConv----- |--- Pop the current CUDA context from the CPU thread. The context may then--- be attached to a different CPU thread by calling 'push'.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2fac188026a062d92e91a8687d0a7902>----{-# INLINEABLE pop #-}-pop :: IO Context-pop = resultIfOk =<< cuCtxPopCurrent--{-# INLINE cuCtxPopCurrent #-}-{# fun unsafe cuCtxPopCurrent-  { alloca- `Context' peekCtx* } -> `Status' cToEnum #}-  where peekCtx = liftM Context . peek----- |--- Push the given context onto the CPU's thread stack of current contexts.--- The specified context becomes the CPU thread's current context, so all--- operations that operate on the current context are affected.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gb02d4c850eb16f861fe5a29682cc90ba>----{-# INLINEABLE push #-}-push :: Context -> IO ()-push !ctx = nothingIfOk =<< cuCtxPushCurrent ctx--{-# INLINE cuCtxPushCurrent #-}-{# fun unsafe cuCtxPushCurrent-  { useContext `Context' } -> `Status' cToEnum #}----- |--- Block until the device has completed all preceding requests. If the--- context was created with the 'SchedBlockingSync' flag, the CPU thread--- will block until the GPU has finished its work.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g7a54725f28d34b8c6299f0c6ca579616>----{-# INLINEABLE sync #-}-sync :: IO ()-sync = nothingIfOk =<< cuCtxSynchronize--{-# INLINE cuCtxSynchronize #-}-{# fun cuCtxSynchronize-  { } -> `Status' cToEnum #}-
− Foreign/CUDA/Driver/Context/Config.chs 
@@ -1,297 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase                #-}-#endif------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Context.Config--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ Context configuration for the low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Context.Config (--  -- * Context configuration-  getFlags,--  -- ** Resource limits-  Limit(..),-  getLimit, setLimit,--  -- ** Cache-  Cache(..),-  getCache, setCache,--  -- ** Shared memory-  SharedMem(..),-  getSharedMem, setSharedMem,--  -- ** Streams-  StreamPriority,-  getStreamPriorityRange,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Context.Base-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Types---- System-import Control.Monad-import Foreign-import Foreign.C-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- Device limits flags----#if CUDA_VERSION < 3010-data Limit-#else-{# enum CUlimit_enum as Limit-    { underscoreToCase }-    with prefix="CU_LIMIT" deriving (Eq, Show) #}-#endif----- |--- Device cache configuration preference----#if CUDA_VERSION < 3020-data Cache-#else-{# enum CUfunc_cache_enum as Cache-    { underscoreToCase }-    with prefix="CU_FUNC_CACHE" deriving (Eq, Show) #}-#endif----- |--- Device shared memory configuration preference----#if CUDA_VERSION < 4020-data SharedMem-#else-{# enum CUsharedconfig as SharedMem-    { underscoreToCase }-    with prefix="CU_SHARED_MEM_CONFIG" deriving (Eq, Show) #}-#endif-------------------------------------------------------------------------------------- Context configuration------------------------------------------------------------------------------------- |--- Return the flags that were used to create the current context.------ Requires CUDA-7.0------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gf81eef983c1e3b2ef4f166d7a930c86d>----{-# INLINEABLE getFlags #-}-getFlags :: IO [ContextFlag]-#if CUDA_VERSION < 7000-getFlags = requireSDK 'getFlags 7.0-#else-getFlags = resultIfOk =<< cuCtxGetFlags--{-# INLINE cuCtxGetFlags #-}-{# fun unsafe cuCtxGetFlags-  { alloca- `[ContextFlag]' peekFlags* } -> `Status' cToEnum #}-  where-    peekFlags = liftM extractBitMasks . peek-#endif----- |--- Query compute 2.0 call stack limits.------ Requires CUDA-3.1.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g9f2d47d1745752aa16da7ed0d111b6a8>----{-# INLINEABLE getLimit #-}-getLimit :: Limit -> IO Int-#if CUDA_VERSION < 3010-getLimit _  = requireSDK 'getLimit 3.1-#else-getLimit !l = resultIfOk =<< cuCtxGetLimit l--{-# INLINE cuCtxGetLimit #-}-{# fun unsafe cuCtxGetLimit-  { alloca-   `Int' peekIntConv*-  , cFromEnum `Limit'            } -> `Status' cToEnum #}-#endif----- |--- Specify the size of the call stack, for compute 2.0 devices.------ Requires CUDA-3.1.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g0651954dfb9788173e60a9af7201e65a>----{-# INLINEABLE setLimit #-}-setLimit :: Limit -> Int -> IO ()-#if CUDA_VERSION < 3010-setLimit _ _   = requireSDK 'setLimit 3.1-#else-setLimit !l !n = nothingIfOk =<< cuCtxSetLimit l n--{-# INLINE cuCtxSetLimit #-}-{# fun unsafe cuCtxSetLimit-  { cFromEnum `Limit'-  , cIntConv  `Int'   } -> `Status' cToEnum #}-#endif----- |--- On devices where the L1 cache and shared memory use the same hardware--- resources, this function returns the preferred cache configuration for--- the current context.------ Requires CUDA-3.2.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g40b6b141698f76744dea6e39b9a25360>----{-# INLINEABLE getCache #-}-getCache :: IO Cache-#if CUDA_VERSION < 3020-getCache = requireSDK 'getCache 3.2-#else-getCache = resultIfOk =<< cuCtxGetCacheConfig--{-# INLINE cuCtxGetCacheConfig #-}-{# fun unsafe cuCtxGetCacheConfig-  { alloca- `Cache' peekEnum* } -> `Status' cToEnum #}-#endif----- |--- On devices where the L1 cache and shared memory use the same hardware--- resources, this sets the preferred cache configuration for the current--- context. This is only a preference.------ Any function configuration set via--- 'Foreign.CUDA.Driver.Exec.setCacheConfigFun' will be preferred over this--- context-wide setting.------ Requires CUDA-3.2.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g54699acf7e2ef27279d013ca2095f4a3>----{-# INLINEABLE setCache #-}-setCache :: Cache -> IO ()-#if CUDA_VERSION < 3020-setCache _  = requireSDK 'setCache 3.2-#else-setCache !c = nothingIfOk =<< cuCtxSetCacheConfig c--{-# INLINE cuCtxSetCacheConfig #-}-{# fun unsafe cuCtxSetCacheConfig-  { cFromEnum `Cache' } -> `Status' cToEnum #}-#endif----- |--- Return the current size of the shared memory banks in the current--- context. On devices with configurable shared memory banks,--- 'setSharedMem' can be used to change the configuration, so that--- subsequent kernel launches will by default us the new bank size. On--- devices without configurable shared memory, this function returns the--- fixed bank size of the hardware.------ Requires CUDA-4.2------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g17153a1b8b8c756f7ab8505686a4ad74>----{-# INLINEABLE getSharedMem #-}-getSharedMem :: IO SharedMem-#if CUDA_VERSION < 4020-getSharedMem = requireSDK 'getSharedMem 4.2-#else-getSharedMem = resultIfOk =<< cuCtxGetSharedMemConfig--{-# INLINE cuCtxGetSharedMemConfig #-}-{# fun unsafe cuCtxGetSharedMemConfig-  { alloca- `SharedMem' peekEnum*-  } -> `Status' cToEnum #}-#endif----- |--- On devices with configurable shared memory banks, this function will set--- the context's shared memory bank size that will be used by default for--- subsequent kernel launches.------ Changing the shared memory configuration between launches may insert--- a device synchronisation.------ Shared memory bank size does not affect shared memory usage or kernel--- occupancy, but may have major effects on performance. Larger bank sizes--- allow for greater potential bandwidth to shared memory, but change the--- kinds of accesses which result in bank conflicts.------ Requires CUDA-4.2------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2574235fa643f8f251bf7bc28fac3692>----{-# INLINEABLE setSharedMem #-}-setSharedMem :: SharedMem -> IO ()-#if CUDA_VERSION < 4020-setSharedMem _  = requireSDK 'setSharedMem 4.2-#else-setSharedMem !c = nothingIfOk =<< cuCtxSetSharedMemConfig c--{-# INLINE cuCtxSetSharedMemConfig #-}-{# fun unsafe cuCtxSetSharedMemConfig-  { cFromEnum `SharedMem' } -> `Status' cToEnum #}-#endif------ |--- Returns the numerical values that correspond to the greatest and least--- priority execution streams in the current context respectively. Stream--- priorities follow the convention that lower numerical numbers correspond--- to higher priorities. The range of meaningful stream priorities is given--- by the inclusive range [greatestPriority,leastPriority].------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g137920ab61a71be6ce67605b9f294091>----{-# INLINEABLE getStreamPriorityRange #-}-getStreamPriorityRange :: IO (StreamPriority, StreamPriority)-#if CUDA_VERSION < 5050-getStreamPriorityRange = requireSDK 'getStreamPriorityRange 5.5-#else-getStreamPriorityRange = do-  (r,l,h) <- cuCtxGetStreamPriorityRange-  resultIfOk (r, (h,l))--{-# INLINE cuCtxGetStreamPriorityRange #-}-{# fun unsafe cuCtxGetStreamPriorityRange-  { alloca- `Int' peekIntConv*-  , alloca- `Int' peekIntConv*-  }-  -> `Status' cToEnum #}-#endif-
− Foreign/CUDA/Driver/Context/Peer.chs 
@@ -1,131 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase                #-}-#endif------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Context.Peer--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ Direct peer context access functions for the low-level driver interface.------ Since: CUDA-4.0--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Context.Peer (--  -- * Peer Access-  PeerFlag,-  accessible, add, remove,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Context.Base                 ( Context(..) )-import Foreign.CUDA.Driver.Device                       ( Device(..) )-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- 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-------------------------------------------------------------------------------------- Peer access------------------------------------------------------------------------------------- |--- 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.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g496bdaae1f632ebfb695b99d2c40f19e>----{-# INLINEABLE accessible #-}-accessible :: Device -> Device -> IO Bool-#if CUDA_VERSION < 4000-accessible _ _        = requireSDK 'accessible 4.0-#else-accessible !dev !peer = resultIfOk =<< cuDeviceCanAccessPeer dev peer--{-# INLINE cuDeviceCanAccessPeer #-}-{# fun unsafe cuDeviceCanAccessPeer-  { alloca-   `Bool'   peekBool*-  , useDevice `Device'-  , useDevice `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.------ Note that access is unidirectional, and in order to access memory in the--- current context from the peer context, a separate symmetric call to--- 'add' is required.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g0889ec6728e61c05ed359551d67b3f5a>----{-# INLINEABLE add #-}-add :: Context -> [PeerFlag] -> IO ()-#if CUDA_VERSION < 4000-add _ _         = requireSDK 'add 4.0-#else-add !ctx !flags = nothingIfOk =<< cuCtxEnablePeerAccess ctx flags--{-# INLINE cuCtxEnablePeerAccess #-}-{# fun unsafe cuCtxEnablePeerAccess-  { useContext      `Context'-  , combineBitMasks `[PeerFlag]' } -> `Status' cToEnum #}-#endif----- |--- Disable direct memory access from the current context to the supplied--- peer context, and unregisters any registered allocations.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g5b4b6936ea868d4954ce4d841a3b4810>----{-# INLINEABLE remove #-}-remove :: Context -> IO ()-#if CUDA_VERSION < 4000-remove _    = requireSDK 'remave 4.0-#else-remove !ctx = nothingIfOk =<< cuCtxDisablePeerAccess ctx--{-# INLINE cuCtxDisablePeerAccess #-}-{# fun unsafe cuCtxDisablePeerAccess-  { useContext `Context' } -> `Status' cToEnum #}-#endif-
− Foreign/CUDA/Driver/Context/Primary.chs 
@@ -1,170 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Context.Primary--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Primary context management for low-level driver interface. The primary--- context is unique per device and shared with the Runtime API. This--- allows integration with other libraries using CUDA.------ Since: CUDA-7.0--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Context.Primary (--  status, setup, reset, retain, release,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Context.Base-import Foreign.CUDA.Driver.Device-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Control.Exception-import Control.Monad-import Foreign-import Foreign.C-------------------------------------------------------------------------------------- Primary context management-------------------------------------------------------------------------------------- |--- Get the status of the primary context. Returns whether the current--- context is active, and the flags it was (or will be) created with.------ Requires CUDA-7.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g65f3e018721b6d90aa05cfb56250f469>----{-# INLINEABLE status #-}-status :: Device -> IO (Bool, [ContextFlag])-#if CUDA_VERSION < 7000-status _    = requireSDK 'status 7.0-#else-status !dev =-  cuDevicePrimaryCtxGetState dev >>= \(rv, !flags, !active) ->-  case rv of-    Success -> return (active, flags)-    _       -> throwIO (ExitCode rv)--{# fun unsafe cuDevicePrimaryCtxGetState-  { useDevice `Device'-  , alloca-   `[ContextFlag]' peekFlags*-  , alloca-   `Bool'          peekBool*-  } -> `Status' cToEnum #}-  where-    peekFlags = liftM extractBitMasks . peek-#endif----- |--- Specify the flags that the primary context should be created with. Note--- that this is an error if the primary context is already active.------ Requires CUDA-7.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gd779a84f17acdad0d9143d9fe719cfdf>----{-# INLINEABLE setup #-}-setup :: Device -> [ContextFlag] -> IO ()-#if CUDA_VERSION < 7000-setup _    _      = requireSDK 'setup 7.0-#else-setup !dev !flags = nothingIfOk =<< cuDevicePrimaryCtxSetFlags dev flags--{-# INLINE cuDevicePrimaryCtxSetFlags #-}-{# fun unsafe cuDevicePrimaryCtxSetFlags-  { useDevice       `Device'-  , combineBitMasks `[ContextFlag]'-  } -> `Status' cToEnum #}-#endif----- |--- Destroy all allocations and reset all state on the primary context of--- the given device in the current process. Requires cuda-7.0------ Requires CUDA-7.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g5d38802e8600340283958a117466ce12>----{-# INLINEABLE reset #-}-reset :: Device -> IO ()-#if CUDA_VERSION < 7000-reset _    = requireSDK 'reset 7.0-#else-reset !dev = nothingIfOk =<< cuDevicePrimaryCtxReset dev--{-# INLINE cuDevicePrimaryCtxReset #-}-{# fun unsafe cuDevicePrimaryCtxReset-  { useDevice `Device' } -> `Status' cToEnum #}-#endif----- |--- Release the primary context on the given device. If there are no more--- references to the primary context it will be destroyed, regardless of--- how many threads it is current to.------ Unlike 'Foreign.CUDA.Driver.Context.Base.pop' this does not pop the--- context from the stack in any circumstances.------ Requires CUDA-7.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gf2a8bc16f8df0c88031f6a1ba3d6e8ad>----{-# INLINEABLE release #-}-release :: Device -> IO ()-#if CUDA_VERSION < 7000-release _    = requireSDK 'release 7.0-#else-release !dev = nothingIfOk =<< cuDevicePrimaryCtxRelease dev--{-# INLINE cuDevicePrimaryCtxRelease #-}-{# fun unsafe cuDevicePrimaryCtxRelease-  { useDevice `Device' } -> `Status' cToEnum #}-#endif----- |--- Retain the primary context for the given device, creating it if--- necessary, and increasing its usage count. The caller must call--- 'release' when done using the context. Unlike--- 'Foreign.CUDA.Driver.Context.Base.create' the newly retained context is--- not pushed onto the stack.------ Requires CUDA-7.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g9051f2d5c31501997a6cb0530290a300>----{-# INLINEABLE retain #-}-retain :: Device -> IO Context-#if CUDA_VERSION < 7000-retain _    = requireSDK 'retain 7.0-#else-retain !dev = resultIfOk =<< cuDevicePrimaryCtxRetain dev--{-# INLINE cuDevicePrimaryCtxRetain #-}-{# fun unsafe cuDevicePrimaryCtxRetain-  { alloca-   `Context' peekCtx*-  , useDevice `Device'-  } -> `Status' cToEnum #}-  where-    peekCtx = liftM Context . peek-#endif-
− Foreign/CUDA/Driver/Device.chs 
@@ -1,403 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase                #-}-#endif------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Device--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Device management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Device (--  -- * Device Management-  Device(..),-  DeviceProperties(..), DeviceAttribute(..), Compute(..), ComputeMode(..), InitFlag,-  initialise, capability, device, attribute, count, name, props, totalMem--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Analysis.Device-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad                                    ( liftM )-import Control.Applicative-import Prelude-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A CUDA device----newtype Device = Device { useDevice :: {# type CUdevice #}}-  deriving (Eq, Show)----- |--- Device attributes----{# enum CUdevice_attribute as DeviceAttribute-    { underscoreToCase-    , MAX as CU_DEVICE_ATTRIBUTE_MAX }          -- ignore-    with prefix="CU_DEVICE_ATTRIBUTE" deriving (Eq, Show) #}---#if CUDA_VERSION < 5000-{# pointer *CUdevprop as ^ foreign -> CUDevProp nocode #}------- Properties of the compute device (internal helper).--- Replaced by cuDeviceGetAttribute in CUDA-5.0 and later.----data CUDevProp = CUDevProp-  {-    cuMaxThreadsPerBlock :: !Int,               -- Maximum number of threads per block-    cuMaxBlockSize       :: !(Int,Int,Int),     -- Maximum size of each dimension of a block-    cuMaxGridSize        :: !(Int,Int,Int),     -- Maximum size of each dimension of a grid-    cuSharedMemPerBlock  :: !Int64,             -- Shared memory available per block in bytes-    cuTotalConstMem      :: !Int64,             -- Constant memory available on device in bytes-    cuWarpSize           :: !Int,               -- Warp size in threads (SIMD width)-    cuMemPitch           :: !Int64,             -- Maximum pitch in bytes allowed by memory copies-    cuRegsPerBlock       :: !Int,               -- 32-bit registers available per block-    cuClockRate          :: !Int,               -- Clock frequency in kilohertz-    cuTextureAlignment   :: !Int64              -- Alignment requirement for textures-  }-  deriving (Show)---instance Storable CUDevProp where-  sizeOf _    = {#sizeof CUdevprop#}-  alignment _ = alignment (undefined :: Ptr ())--  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--    [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxThreadsDim#} p-    [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxGridSize#} p--    return CUDevProp-      {-        cuMaxThreadsPerBlock = tb,-        cuMaxBlockSize       = (t1,t2,t3),-        cuMaxGridSize        = (g1,g2,g3),-        cuSharedMemPerBlock  = sm,-        cuTotalConstMem      = cm,-        cuWarpSize           = ws,-        cuMemPitch           = mp,-        cuRegsPerBlock       = rb,-        cuClockRate          = cl,-        cuTextureAlignment   = ta-      }-#endif----- |--- Possible option flags for CUDA initialisation. Dummy instance until the API--- exports actual option values.----data InitFlag-instance Enum InitFlag where-#ifdef USE_EMPTY_CASE-  toEnum   x = case x of {}-  fromEnum x = case x of {}-#endif-------------------------------------------------------------------------------------- Initialisation------------------------------------------------------------------------------------- |--- Initialise the CUDA driver API. This must be called before any other--- driver function.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__INITIALIZE.html#group__CUDA__INITIALIZE_1g0a2f1517e1bd8502c7194c3a8c134bc3>----{-# INLINEABLE initialise #-}-initialise :: [InitFlag] -> IO ()-initialise !flags = nothingIfOk =<< cuInit flags <* enable_constructors--{-# INLINE enable_constructors #-}-{# fun unsafe enable_constructors { } -> `()' #}--{-# INLINE cuInit #-}-{# fun unsafe cuInit-  { combineBitMasks `[InitFlag]' } -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Device Management------------------------------------------------------------------------------------- |--- Return the compute compatibility revision supported by the device----{-# INLINEABLE capability #-}-capability :: Device -> IO Compute-#if CUDA_VERSION >= 5000-capability !dev =-  Compute <$> attribute dev ComputeCapabilityMajor-          <*> attribute dev ComputeCapabilityMinor-#else--- Deprecated as of CUDA-5.0----capability !dev =-  (\(!s,!a,!b) -> resultIfOk (s,Compute a b)) =<< cuDeviceComputeCapability dev--{-# INLINE cuDeviceComputeCapability #-}-{# fun unsafe cuDeviceComputeCapability-  { alloca-   `Int'    peekIntConv*-  , alloca-   `Int'    peekIntConv*-  , useDevice `Device'              } -> `Status' cToEnum #}-#endif----- |--- Return a handle to the compute device at the given ordinal.------ <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-  { alloca-  `Device' dev*-  , cIntConv `Int'           } -> `Status' cToEnum #}-  where dev = liftM Device . peek----- |--- Return the selected attribute for the given device.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g9c3e1414f0ad901d3278a4d6645fc266>----{-# 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 #}----- |--- Return the number of device with compute capability > 1.0.------ <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 #}----- |--- The identifying name of the device.------ <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-  { allocaS-  `String'& peekS*-  , useDevice `Device'         } -> `Status' cToEnum #}-  where-    len       = 512-    allocaS a = allocaBytes len $ \p -> a (p, cIntConv len)-    peekS s _ = peekCString s----- |--- Return the properties of the selected device----{-# INLINEABLE props #-}-props :: Device -> IO DeviceProperties-props !d = do--#if CUDA_VERSION < 5000-  -- Old versions of the CUDA API used the separate cuDeviceGetProperties-  -- function to probe some properties, and cuDeviceGetAttribute for-  -- others. As of CUDA-5.0, the former was deprecated and its-  -- 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-#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-#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-#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-#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-#endif-#if CUDA_VERSION >= 5050-  sp  <- toBool `fmap` 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-#endif-#if CUDA_VERSION >= 5050-    , streamPriorities                  = sp-#endif-#if CUDA_VERSION >= 6000-    , globalL1Cache                     = gl1-    , localL1Cache                      = ll1-    , managedMemory                     = mm-    , multiGPUBoard                     = mg-    , multiGPUBoardGroupID              = mid-#endif-    }--#if CUDA_VERSION < 5000--- Deprecated as of CUDA-5.0-{-# INLINE cuDeviceGetProperties #-}-{# fun unsafe cuDeviceGetProperties-  { alloca-   `CUDevProp' peek*-  , useDevice `Device'          } -> `Status' cToEnum #}-#endif----- |--- The total memory available on the device (bytes).------ <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-  { alloca-   `Int64'  peekIntConv*-  , useDevice `Device'              } -> `Status' cToEnum #}-
− Foreign/CUDA/Driver/Error.chs 
@@ -1,210 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE DeriveDataTypeable       #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Error--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Error handling--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Error (--  -- * CUDA Errors-  Status(..), CUDAException(..),-  describe,-  cudaError, cudaErrorIO, requireSDK,-  resultIfOk, nothingIfOk,--) where---- Friends-import Foreign.CUDA.Internal.C2HS---- System-import Control.Exception-import Control.Monad-import Data.Typeable-import Foreign.C-import Foreign.Marshal-import Foreign.Ptr-import Foreign.Storable-import Language.Haskell.TH-import System.IO.Unsafe-import Text.Printf---#include "cbits/stubs.h"-{# context lib="cuda" #}-------------------------------------------------------------------------------------- Return Status---------------------------------------------------------------------------------------- Error Codes----{# enum CUresult as Status-    { underscoreToCase-    , CUDA_SUCCESS                      as Success-    , CUDA_ERROR_NO_BINARY_FOR_GPU      as NoBinaryForGPU-    , CUDA_ERROR_INVALID_PTX            as InvalidPTX-    , CUDA_ERROR_INVALID_PC             as InvalidPC-    }-    with prefix="CUDA_ERROR" deriving (Eq, Show) #}----- |--- Return a descriptive error string associated with a particular error code----describe :: Status -> String-#if CUDA_VERSION >= 6000-describe status-  = unsafePerformIO $ resultIfOk =<< cuGetErrorString status--{# fun unsafe cuGetErrorString-    { cFromEnum `Status'-    , alloca-   `String' ppeek* } -> `Status' cToEnum #}-    where-      ppeek = peek >=> peekCString--#else-describe Success                        = "no error"-describe InvalidValue                   = "invalid argument"-describe OutOfMemory                    = "out of memory"-describe NotInitialized                 = "driver not initialised"-describe Deinitialized                  = "driver deinitialised"-describe NoDevice                       = "no CUDA-capable device is available"-describe InvalidDevice                  = "invalid device ordinal"-describe InvalidImage                   = "invalid kernel image"-describe InvalidContext                 = "invalid context handle"-describe ContextAlreadyCurrent          = "context already current"-describe MapFailed                      = "map failed"-describe UnmapFailed                    = "unmap failed"-describe ArrayIsMapped                  = "array is mapped"-describe AlreadyMapped                  = "already mapped"-describe NoBinaryForGPU                 = "no binary available for this GPU"-describe AlreadyAcquired                = "resource already acquired"-describe NotMapped                      = "not mapped"-describe InvalidSource                  = "invalid source"-describe FileNotFound                   = "file not found"-describe InvalidHandle                  = "invalid handle"-describe NotFound                       = "not found"-describe NotReady                       = "device not ready"-describe LaunchFailed                   = "unspecified launch failure"-describe LaunchOutOfResources           = "too many resources requested for launch"-describe LaunchTimeout                  = "the launch timed out and was terminated"-describe LaunchIncompatibleTexturing    = "launch with incompatible texturing"-#if CUDA_VERSION >= 3000-describe NotMappedAsArray               = "mapped resource not available for access as an array"-describe NotMappedAsPointer             = "mapped resource not available for access as a pointer"-describe EccUncorrectable               = "uncorrectable ECC error detected"-#endif-#if CUDA_VERSION >= 3000 && CUDA_VERSION < 3020-describe PointerIs64bit                 = "attempt to retrieve a 64-bit pointer via a 32-bit API function"-describe SizeIs64bit                    = "attempt to retrieve 64-bit size via a 32-bit API function"-#endif-#if CUDA_VERSION >= 3010-describe UnsupportedLimit               = "limits not supported by device"-describe SharedObjectSymbolNotFound     = "link to a shared object failed to resolve"-describe SharedObjectInitFailed         = "shared object initialisation failed"-#endif-#if CUDA_VERSION >= 3020-describe OperatingSystem                = "operating system call failed"-#endif-#if CUDA_VERSION >= 4000-describe ProfilerDisabled               = "profiling APIs disabled: application running with visual profiler"-describe ProfilerNotInitialized         = "profiler not initialised"-describe ProfilerAlreadyStarted         = "profiler already started"-describe ProfilerAlreadyStopped         = "profiler already stopped"-describe ContextAlreadyInUse            = "context is already bound to a thread and in use"-describe PeerAccessAlreadyEnabled       = "peer access already enabled"-describe PeerAccessNotEnabled           = "peer access has not been enabled"-describe PrimaryContextActive           = "primary context for this device has already been initialised"-describe ContextIsDestroyed             = "context already destroyed"-#endif-#if CUDA_VERSION >= 4010-describe Assert                         = "device-side assert triggered"-describe TooManyPeers                   = "peer mapping resources exhausted"-describe HostMemoryAlreadyRegistered    = "part or all of the requested memory range is already mapped"-describe HostMemoryNotRegistered        = "pointer does not correspond to a registered memory region"-#endif-#if CUDA_VERSION >= 5000-describe PeerAccessUnsupported          = "peer access is not supported across the given devices"-describe NotPermitted                   = "not permitted"-describe NotSupported                   = "not supported"-#endif-describe Unknown                        = "unknown error"-#endif-------------------------------------------------------------------------------------- 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. Exceptions can be thrown from pure code, but can only--- be caught in the 'IO' monad.----{-# RULES "cudaError/IO" cudaError = cudaErrorIO #-}-{-# NOINLINE [1] cudaError #-}-cudaError :: String -> a-cudaError s = throw (UserError s)---- |--- Raise a CUDAException in the IO Monad----cudaErrorIO :: String -> IO a-cudaErrorIO s = throwIO (UserError s)---- |--- A specially formatted error message----requireSDK :: Name -> Double -> a-requireSDK n v = cudaError $ printf "'%s' requires at least cuda-%3.1f\n" (show n) v-------------------------------------------------------------------------------------- Helper Functions-------------------------------------------------------------------------------------- |--- Return the results of a function on successful execution, otherwise throw an--- exception with an 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)----- |--- Throw an exception with an error string associated with an unsuccessful--- return code, otherwise return unit.----{-# INLINE nothingIfOk #-}-nothingIfOk :: Status -> IO ()-nothingIfOk status =-    case status of-        Success -> return  ()-        _       -> throwIO (ExitCode status)-
− Foreign/CUDA/Driver/Event.chs 
@@ -1,163 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Event--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Event management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Event (--  -- * Event Management-  Event(..), EventFlag(..), WaitFlag,-  create, destroy, elapsedTime, query, record, wait, block--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Driver.Error---- System-import Foreign-import Foreign.C-import Data.Maybe-import Control.Monad                                    ( liftM )-import Control.Exception                                ( throwIO )-------------------------------------------------------------------------------------- Event management------------------------------------------------------------------------------------- |--- Create a new event------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g450687e75f3ff992fe01662a43d9d3db>----{-# INLINEABLE create #-}-create :: [EventFlag] -> IO Event-create !flags = resultIfOk =<< cuEventCreate flags--{-# INLINE cuEventCreate #-}-{# fun unsafe cuEventCreate-  { alloca-         `Event'       peekEvt*-  , combineBitMasks `[EventFlag]'          } -> `Status' cToEnum #}-  where peekEvt = liftM Event . peek----- |--- Destroy an event------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g593ec73a8ec5a5fc031311d3e4dca1ef>----{-# INLINEABLE destroy #-}-destroy :: Event -> IO ()-destroy !ev = nothingIfOk =<< cuEventDestroy ev--{-# INLINE cuEventDestroy #-}-{# fun unsafe cuEventDestroy-  { useEvent `Event' } -> `Status' cToEnum #}----- |--- Determine the elapsed time (in milliseconds) between two events------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1gdfb1178807353bbcaa9e245da497cf97>----{-# INLINEABLE elapsedTime #-}-elapsedTime :: Event -> Event -> IO Float-elapsedTime !ev1 !ev2 = resultIfOk =<< cuEventElapsedTime ev1 ev2--{-# INLINE cuEventElapsedTime #-}-{# fun unsafe cuEventElapsedTime-  { alloca-  `Float' peekFloatConv*-  , useEvent `Event'-  , useEvent `Event'                } -> `Status' cToEnum #}----- |--- Determines if a event has actually been recorded------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g6f0704d755066b0ee705749ae911deef>----{-# INLINEABLE query #-}-query :: Event -> IO Bool-query !ev =-  cuEventQuery ev >>= \rv ->-  case rv of-    Success  -> return True-    NotReady -> return False-    _        -> throwIO (ExitCode rv)--{-# INLINE cuEventQuery #-}-{# fun unsafe cuEventQuery-  { useEvent `Event' } -> `Status' cToEnum #}----- |--- Record an event once all operations in the current context (or optionally--- specified stream) have completed. This operation is asynchronous.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g95424d3be52c4eb95d83861b70fb89d1>----{-# INLINEABLE record #-}-record :: Event -> Maybe Stream -> IO ()-record !ev !mst =-  nothingIfOk =<< cuEventRecord ev (fromMaybe defaultStream mst)--{-# INLINE cuEventRecord #-}-{# fun unsafe cuEventRecord-  { 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.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g6a898b652dfc6aa1d5c8d97062618b2f>----{-# INLINEABLE wait #-}-wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()-#if CUDA_VERSION < 3020-wait _ _ _           = requireSDK 'wait 3.2-#else-wait !ev !mst !flags =-  nothingIfOk =<< cuStreamWaitEvent (fromMaybe defaultStream mst) ev flags--{-# INLINE cuStreamWaitEvent #-}-{# fun unsafe cuStreamWaitEvent-  { useStream       `Stream'-  , useEvent        `Event'-  , combineBitMasks `[WaitFlag]' } -> `Status' cToEnum #}-#endif---- |--- Wait until the event has been recorded------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g9e520d34e51af7f5375610bca4add99c>----{-# INLINEABLE block #-}-block :: Event -> IO ()-block !ev = nothingIfOk =<< cuEventSynchronize ev--{-# INLINE cuEventSynchronize #-}-{# fun cuEventSynchronize-  { useEvent `Event' } -> `Status' cToEnum #}-
− Foreign/CUDA/Driver/Exec.chs 
@@ -1,380 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GADTs                    #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Exec--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Kernel execution control for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Exec (--  -- * Kernel Execution-  Fun(Fun), FunParam(..), FunAttribute(..), SharedMem(..),-  requires,-  setCacheConfigFun,-  setSharedMemConfigFun,-  launchKernel, launchKernel',--  -- Deprecated since CUDA-4.0-  setBlockShape, setSharedSize, setParams, launch,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Context                      ( Cache(..), SharedMem(..) )-import Foreign.CUDA.Driver.Stream                       ( Stream(..), defaultStream )---- System-import Foreign-import Foreign.C-import Data.Maybe-import Control.Monad                                    ( zipWithM_ )---#if CUDA_VERSION >= 4000-{-# DEPRECATED setBlockShape, setSharedSize, setParams, launch-      "use launchKernel instead" #-}-#endif-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A @\_\_global\_\_@ device function----newtype Fun = Fun { useFun :: {# type CUfunction #}}----- |--- Function attributes----{# enum CUfunction_attribute as FunAttribute-    { underscoreToCase-    , MAX_THREADS_PER_BLOCK as MaxKernelThreadsPerBlock-    , MAX as CU_FUNC_ATTRIBUTE_MAX }    -- ignore-    with prefix="CU_FUNC_ATTRIBUTE" deriving (Eq, Show) #}---- |--- Kernel function parameters----data FunParam where-  IArg :: !Int32           -> FunParam-  FArg :: !Float           -> FunParam-  VArg :: Storable a => !a -> FunParam--instance Storable FunParam where-  sizeOf (IArg _)       = sizeOf (undefined :: CUInt)-  sizeOf (FArg _)       = sizeOf (undefined :: CFloat)-  sizeOf (VArg v)       = sizeOf v--  alignment (IArg _)    = alignment (undefined :: CUInt)-  alignment (FArg _)    = alignment (undefined :: CFloat)-  alignment (VArg v)    = alignment v--  poke p (IArg i)       = poke (castPtr p) i-  poke p (FArg f)       = poke (castPtr p) f-  poke p (VArg v)       = poke (castPtr p) v--  peek _                = error "Can not peek Foreign.CUDA.Driver.FunParam"-------------------------------------------------------------------------------------- Execution Control------------------------------------------------------------------------------------- |--- Returns the value of the selected attribute requirement for the given kernel.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g5e92a1b0d8d1b82cb00dcfb2de15961b>----{-# INLINEABLE requires #-}-requires :: Fun -> FunAttribute -> IO Int-requires !fn !att = resultIfOk =<< cuFuncGetAttribute att fn--{-# INLINE cuFuncGetAttribute #-}-{# fun unsafe cuFuncGetAttribute-  { alloca-   `Int'          peekIntConv*-  , cFromEnum `FunAttribute'-  , useFun    `Fun'                       } -> `Status' cToEnum #}----- |--- 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.------ Requires CUDA-3.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g40f8c11e81def95dc0072a375f965681>----{-# INLINEABLE setCacheConfigFun #-}-setCacheConfigFun :: Fun -> Cache -> IO ()-#if CUDA_VERSION < 3000-setCacheConfigFun _ _       = requireSDK 'setCacheConfigFun 3.0-#else-setCacheConfigFun !fn !pref = nothingIfOk =<< cuFuncSetCacheConfig fn pref--{-# INLINE cuFuncSetCacheConfig #-}-{# fun unsafe cuFuncSetCacheConfig-  { useFun    `Fun'-  , cFromEnum `Cache' } -> `Status' cToEnum #}-#endif----- |--- Set the shared memory configuration of a device function.------ On devices with configurable shared memory banks, this will force all--- subsequent launches of the given device function to use the specified--- shared memory bank size configuration. On launch of the function, the--- shared memory configuration of the device will be temporarily changed if--- needed to suit the function configuration. Changes in shared memory--- configuration may introduction a device side synchronisation between--- kernel launches.------ Any per-function configuration specified by 'setSharedMemConfig' will--- override the context-wide configuration set with--- 'Foreign.CUDA.Driver.Context.Config.setSharedMem'.------ Changing the shared memory bank size will not increase shared memory--- usage or affect occupancy of kernels, but may have major effects on--- performance. Larger bank sizes will allow for greater potential--- bandwidth to shared memory, but will change what kinds of accesses to--- shared memory will result in bank conflicts.------ This function will do nothing on devices with fixed shared memory bank--- size.------ Requires CUDA-5.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g430b913f24970e63869635395df6d9f5>----{-# INLINEABLE setSharedMemConfigFun #-}-setSharedMemConfigFun :: Fun -> SharedMem -> IO ()-#if CUDA_VERSION < 5000-setSharedMemConfigFun _    _     = requireSDK 'setSharedMemConfigFun 5.0-#else-setSharedMemConfigFun !fun !pref = nothingIfOk =<< cuFuncSetSharedMemConfig fun pref--{-# INLINE cuFuncSetSharedMemConfig #-}-{# fun unsafe cuFuncSetSharedMemConfig-  { useFun    `Fun'-  , cFromEnum `SharedMem'-  }-  -> `Status' cToEnum #}-#endif----- |--- Invoke a kernel on a @(gx * gy * gz)@ 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'.------ In 'launchKernel', the number of kernel parameters and their offsets and--- sizes do not need to be specified, as this information is retrieved directly--- from the kernel's image. This requires the kernel to have been compiled with--- toolchain version 3.2 or later.------ The alternative 'launchKernel'' will pass the arguments in directly,--- requiring the application to know the size and alignment/padding of each--- kernel parameter.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1gb8f3dc3031b40da29d5f9a7139e52e15>----{-# INLINEABLE launchKernel  #-}-{-# INLINEABLE launchKernel' #-}-launchKernel, launchKernel'-    :: Fun                      -- ^ function to execute-    -> (Int,Int,Int)            -- ^ block grid dimension-    -> (Int,Int,Int)            -- ^ thread block shape-    -> Int                      -- ^ shared memory (bytes)-    -> Maybe Stream             -- ^ (optional) stream to execute in-    -> [FunParam]               -- ^ list of function parameters-    -> IO ()-#if CUDA_VERSION >= 4000-launchKernel !fn (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !mst !args-  = (=<<) nothingIfOk-  $ withMany withFP args-  $ \pa -> withArray pa-  $ \pp -> cuLaunchKernel fn gx gy gz tx ty tz sm st pp nullPtr-  where-    !st = fromMaybe defaultStream mst--    withFP :: FunParam -> (Ptr FunParam -> IO b) -> IO b-    withFP !p !f = case p of-      IArg v -> with' v (f . castPtr)-      FArg v -> with' v (f . castPtr)-      VArg v -> with' v (f . castPtr)--    -- can't use the standard 'with' because 'alloca' will pass an undefined-    -- dummy argument when determining 'sizeOf' and 'alignment', but sometimes-    -- instances in Accelerate need to evaluate this argument.-    ---    with' :: Storable a => a -> (Ptr a -> IO b) -> IO b-    with' !val !f =-      allocaBytes (sizeOf val) $ \ptr -> do-        poke ptr val-        f ptr---launchKernel' !fn (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !mst !args-  = (=<<) nothingIfOk-  $ with bytes-  $ \pb -> withArray' args-  $ \pa -> withArray0 nullPtr [buffer, castPtr pa, size, castPtr pb]-  $ \pp -> cuLaunchKernel fn gx gy gz tx ty tz sm st nullPtr pp-  where-    buffer      = wordPtrToPtr 0x01     -- CU_LAUNCH_PARAM_BUFFER_POINTER-    size        = wordPtrToPtr 0x02     -- CU_LAUNCH_PARAM_BUFFER_SIZE-    bytes       = foldl (\a x -> a + sizeOf x) 0 args-    st          = fromMaybe defaultStream mst--    -- can't use the standard 'withArray' because 'mallocArray' will pass-    -- 'undefined' to 'sizeOf' when determining how many bytes to allocate, but-    -- our Storable instance for FunParam needs to dispatch on each constructor,-    -- hence evaluating the undefined.-    ---    withArray' !vals !f =-      allocaBytes bytes $ \ptr -> do-        pokeArray ptr vals-        f ptr---{-# INLINE cuLaunchKernel #-}-{# fun unsafe cuLaunchKernel-  { useFun    `Fun'-  ,           `Int', `Int', `Int'-  ,           `Int', `Int', `Int'-  ,           `Int'-  , useStream `Stream'-  , castPtr   `Ptr (Ptr FunParam)'-  , castPtr   `Ptr (Ptr ())'       } -> `Status' cToEnum #}--#else-launchKernel !fn (!gx,!gy,_) (!tx,!ty,!tz) !sm !mst !args = do-  setParams     fn args-  setSharedSize fn (toInteger sm)-  setBlockShape fn (tx,ty,tz)-  launch        fn (gx,gy) mst--launchKernel' = launchKernel-#endif-------------------------------------------------------------------------------------- Deprecated------------------------------------------------------------------------------------- |--- Invoke the kernel on a size @(w,h)@ grid of blocks. Each block contains the--- number of threads specified by a previous call to 'setBlockShape'. The launch--- may also be associated with a specific 'Stream'.----{-# INLINEABLE launch #-}-launch :: Fun -> (Int,Int) -> Maybe Stream -> IO ()-launch !fn (!w,!h) mst =-  nothingIfOk =<< cuLaunchGridAsync fn w h (fromMaybe defaultStream mst)--{-# INLINE cuLaunchGridAsync #-}-{# fun unsafe cuLaunchGridAsync-  { useFun    `Fun'-  ,           `Int'-  ,           `Int'-  , useStream `Stream' } -> `Status' cToEnum #}----- |--- Specify the @(x,y,z)@ dimensions of the thread blocks that are created when--- the given kernel function is launched.----{-# INLINEABLE setBlockShape #-}-setBlockShape :: Fun -> (Int,Int,Int) -> IO ()-setBlockShape !fn (!x,!y,!z) = nothingIfOk =<< cuFuncSetBlockShape fn x y z--{-# INLINE cuFuncSetBlockShape #-}-{# fun unsafe cuFuncSetBlockShape-  { useFun `Fun'-  ,        `Int'-  ,        `Int'-  ,        `Int' } -> `Status' cToEnum #}----- |--- Set the number of bytes of dynamic shared memory to be available to each--- thread block when the function is launched----{-# INLINEABLE setSharedSize #-}-setSharedSize :: Fun -> Integer -> IO ()-setSharedSize !fn !bytes = nothingIfOk =<< cuFuncSetSharedSize fn bytes--{-# INLINE cuFuncSetSharedSize #-}-{# fun unsafe cuFuncSetSharedSize-  { useFun   `Fun'-  , cIntConv `Integer' } -> `Status' cToEnum #}----- |--- Set the parameters that will specified next time the kernel is invoked----{-# INLINEABLE setParams #-}-setParams :: Fun -> [FunParam] -> IO ()-setParams !fn !prs = do-  zipWithM_ (set fn) offsets prs-  nothingIfOk =<< cuParamSetSize fn (last offsets)-  where-    offsets = scanl (\a b -> a + size b) 0 prs--    size (IArg _)    = sizeOf (undefined :: CUInt)-    size (FArg _)    = sizeOf (undefined :: CFloat)-    size (VArg v)    = sizeOf v--    set f o (IArg v) = nothingIfOk =<< cuParamSeti f o v-    set f o (FArg v) = nothingIfOk =<< cuParamSetf f o v-    set f o (VArg v) = with v $ \p -> (nothingIfOk =<< cuParamSetv f o p (sizeOf v))---{-# INLINE cuParamSetSize #-}-{# fun unsafe cuParamSetSize-  { useFun `Fun'-  ,        `Int' } -> `Status' cToEnum #}--{-# INLINE cuParamSeti #-}-{# fun unsafe cuParamSeti-  { useFun `Fun'-  ,        `Int'-  ,        `Int32' } -> `Status' cToEnum #}--{-# INLINE cuParamSetf #-}-{# fun unsafe cuParamSetf-  { useFun `Fun'-  ,        `Int'-  ,        `Float' } -> `Status' cToEnum #}--{-# INLINE cuParamSetv #-}-{# fun unsafe cuParamSetv-  `Storable a' =>-  { useFun  `Fun'-  ,         `Int'-  , castPtr `Ptr a'-  ,         `Int'   } -> `Status' cToEnum #}--
− Foreign/CUDA/Driver/IPC/Event.chs 
@@ -1,140 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.IPC.Event--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ IPC event management for low-level driver interface.------ Restricted to devices which support unified addressing on Linux--- operating systems.------ Since CUDA-4.1.--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.IPC.Event (--  IPCEvent,-  export, open,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Event-import Foreign.CUDA.Internal.C2HS---- System-import Control.Monad-import Prelude--import Foreign.C-import Foreign.Ptr-import Foreign.ForeignPtr-import Foreign.Marshal-import Foreign.Storable-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A CUDA inter-process event handle.----newtype IPCEvent = IPCEvent { useIPCEvent :: IPCEventHandle }-  deriving (Eq, Show)-------------------------------------------------------------------------------------- IPC event management------------------------------------------------------------------------------------- |--- Create an inter-process event handle for a previously allocated event.--- The event must be created with the 'Interprocess' and 'DisableTiming'--- event flags. The returned handle may then be sent to another process and--- 'open'ed to allow efficient hardware synchronisation between GPU work in--- other processes.------ After the event has been opened in the importing process, 'record',--- 'block', 'wait', 'query' may be used in either process.------ Performing operations on the imported event after the event has been--- 'destroy'ed in the exporting process is undefined.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gea02eadd12483de5305878b13288a86c>----{-# INLINEABLE export #-}-export :: Event -> IO IPCEvent-#if CUDA_VERSION < 4010-export _   = requireSDK 'create 4.1-#else-export !ev = do-  h <- newIPCEventHandle-  r <- cuIpcGetEventHandle h ev-  resultIfOk (r, IPCEvent h)--{-# INLINE cuIpcGetEventHandle #-}-{# fun unsafe cuIpcGetEventHandle-  { withForeignPtr* `IPCEventHandle'-  , useEvent        `Event'-  }-  -> `Status' cToEnum #}-#endif----- |--- Open an inter-process event handle for use in the current process,--- returning an event that can be used in the current process and behaving--- as a locally created event with the 'DisableTiming' flag specified.------ The event must be freed with 'destroy'. Performing operations on the--- imported event after the exported event has been 'destroy'ed in the--- exporting process is undefined.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf1d525918b6c643b99ca8c8e42e36c2e>----{-# INLINEABLE open #-}-open :: IPCEvent -> IO Event-#if CUDA_VERSION < 4010-open _    = requireSDK 'open 4.1-#else-open !ev = resultIfOk =<< cuIpcOpenEventHandle (useIPCEvent ev)--{-# INLINE cuIpcOpenEventHandle #-}-{# fun unsafe cuIpcOpenEventHandle-  { alloca-         `Event'          peekEvent*-  , withForeignPtr* `IPCEventHandle'-  }-  -> `Status' cToEnum #}-  where-    peekEvent = liftM Event . peek-#endif-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------type IPCEventHandle = ForeignPtr ()--newIPCEventHandle :: IO IPCEventHandle-#if CUDA_VERSION < 4010-newIPCEventHandle = requireSDK 'newIPCEventHandle 4.1-#else-newIPCEventHandle = mallocForeignPtrBytes {#sizeof CUipcEventHandle#}-#endif-
− Foreign/CUDA/Driver/IPC/Marshal.chs 
@@ -1,177 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.IPC.Marshal--- Copyright : [2009..2015] Trevor L. McDonell--- License   : BSD------ IPC memory management for low-level driver interface.------ Restricted to devices which support unified addressing on Linux--- operating systems.------ Since CUDA-4.0.--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.IPC.Marshal (--  -- ** IPC memory management-  IPCDevicePtr, IPCFlag(..),-  export, open, close,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Ptr-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS-import Foreign.CUDA.Driver.Marshal---- System-import Control.Monad-import Prelude--import Foreign.C-import Foreign.Ptr-import Foreign.ForeignPtr-import Foreign.Marshal-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A CUDA memory handle used for inter-process communication.----newtype IPCDevicePtr a = IPCDevicePtr { useIPCDevicePtr :: IPCMemHandle }-  deriving (Eq, Show)----- |--- Flags for controlling IPC memory access----#if CUDA_VERSION < 4010-data IPCFlag-#else-{# enum CUipcMem_flags as IPCFlag-  { underscoreToCase }-  with prefix="CU_IPC_MEM" deriving (Eq, Show, Bounded) #}-#endif-------------------------------------------------------------------------------------- IPC memory management------------------------------------------------------------------------------------- |--- Create an inter-process memory handle for an existing device memory--- allocation. The handle can then be sent to another process and made--- available to that process via 'open'.------ Requires CUDA-4.1.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g6f1b5be767b275f016523b2ac49ebec1>----{-# INLINEABLE export #-}-export :: DevicePtr a -> IO (IPCDevicePtr a)-#if CUDA_VERSION < 4010-export _     = requireSDK 'export 4.1-#else-export !dptr = do-  h <- newIPCMemHandle-  r <- cuIpcGetMemHandle h dptr-  resultIfOk (r, IPCDevicePtr h)--{-# INLINE cuIpcGetMemHandle #-}-{# fun unsafe cuIpcGetMemHandle-  { withForeignPtr* `IPCMemHandle'-  , useDeviceHandle `DevicePtr a'-  }-  -> `Status' cToEnum #}-#endif----- |--- Open an inter-process memory handle exported from another process,--- returning a device pointer usable in the current process.------ Maps memory exported by another process with 'create' into the current--- device address space. For contexts on different devices, 'open' can--- attempt to enable peer access if the user called--- 'Foreign.CUDA.Driver.Context.Peer.add', and is controlled by the--- 'LazyEnablePeerAccess' flag.------ Each handle from a given device and context may only be 'open'ed by one--- context per device per other process. Memory returned by 'open' must be--- freed via 'close'.------ Requires CUDA-4.1.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1ga8bd126fcff919a0c996b7640f197b79>----{-# INLINEABLE open #-}-open :: IPCDevicePtr a -> [IPCFlag]-> IO (DevicePtr a)-#if CUDA_VERSION < 4010-open _    _      = requireSDK 'open 4.1-#else-open !hdl !flags = resultIfOk =<< cuIpcOpenMemHandle (useIPCDevicePtr hdl) flags--{-# INLINE cuIpcOpenMemHandle #-}-{# fun unsafe cuIpcOpenMemHandle-  { alloca-         `DevicePtr a'  peekDeviceHandle*-  , withForeignPtr* `IPCMemHandle'-  , combineBitMasks `[IPCFlag]'-  }-  -> `Status' cToEnum #}-#endif----- |--- Close and unmap memory returned by 'open'. The original allocation in--- the exporting process as well as imported mappings in other processes--- are unaffected.------ Any resources used to enable peer access will be freed if this is the--- last mapping using them.------ Requires CUDA-4.1.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gd6f5d5bcf6376c6853b64635b0157b9e>----{-# INLINEABLE close #-}-close :: DevicePtr a -> IO ()-#if CUDA_VERSION < 4010-close _     = requireSDK 'close 4.1-#else-close !dptr = nothingIfOk =<< cuIpcCloseMemHandle dptr--{-# INLINE cuIpcCloseMemHandle #-}-{# fun unsafe cuIpcCloseMemHandle-  { useDeviceHandle `DevicePtr a'-  }-  -> `Status' cToEnum #}-#endif-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------type IPCMemHandle = ForeignPtr ()--newIPCMemHandle :: IO IPCMemHandle-#if CUDA_VERSION < 4010-newIPCMemHandle = requireSDK 'newIPCMemHandle 4.1-#else-newIPCMemHandle = mallocForeignPtrBytes {#sizeof CUipcMemHandle#}-#endif-
− Foreign/CUDA/Driver/Marshal.chs 
@@ -1,1117 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}-{-# OPTIONS_HADDOCK prune #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Marshal--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Memory management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Marshal (--  -- * Host Allocation-  AllocFlag(..),-  mallocHostArray, mallocHostForeignPtr, freeHost,-  registerArray, unregisterArray,--  -- * 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,-  copyArrayPeer, copyArrayPeerAsync,--  -- * Combined Allocation and Marshalling-  newListArray,  newListArrayLen,-  withListArray, withListArrayLen,--  -- * Utility-  memset, memsetAsync,-  getDevicePtr, getBasePtr, getMemInfo,--  -- Internal-  useDeviceHandle, peekDeviceHandle--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Ptr-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Stream                       ( Stream(..), defaultStream )-import Foreign.CUDA.Driver.Context.Base                 ( Context(..) )-import Foreign.CUDA.Internal.C2HS---- System-import Data.Int-import Data.Maybe-import Data.Word-import Unsafe.Coerce-import Control.Applicative-import Control.Exception-import Prelude--import Foreign.C-import Foreign.Ptr-import Foreign.ForeignPtr-import Foreign.Storable-import qualified Foreign.Marshal                        as F--#c-typedef enum CUmemhostalloc_option_enum {-    CU_MEMHOSTALLOC_OPTION_PORTABLE       = CU_MEMHOSTALLOC_PORTABLE,-    CU_MEMHOSTALLOC_OPTION_DEVICE_MAPPED  = CU_MEMHOSTALLOC_DEVICEMAP,-    CU_MEMHOSTALLOC_OPTION_WRITE_COMBINED = CU_MEMHOSTALLOC_WRITECOMBINED-} CUmemhostalloc_option;-#endc-------------------------------------------------------------------------------------- Host Allocation------------------------------------------------------------------------------------- |--- Options for host allocation----{# enum CUmemhostalloc_option as AllocFlag-    { underscoreToCase }-    with prefix="CU_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.------ 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.------ Host memory allocated in this way is automatically and immediately--- accessible to all contexts on all devices which support unified--- addressing.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gdd8311286d2c2691605362c689bc64e0>----{-# 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 =<< cuMemHostAlloc (n * sizeOf x) flags---- |--- As 'mallocHostArray', but return a 'ForeignPtr' instead. The array will be--- deallocated automatically once the last reference to the 'ForeignPtr' is--- dropped.----{-# INLINEABLE mallocHostForeignPtr #-}-{-# SPECIALISE mallocHostForeignPtr :: [AllocFlag] -> Int -> IO (ForeignPtr Word8) #-}-mallocHostForeignPtr :: Storable a => [AllocFlag] -> Int -> IO (ForeignPtr a)-mallocHostForeignPtr !flags !size = do-  HostPtr ptr <- mallocHostArray flags size-  newForeignPtr finalizerMemFreeHost ptr--{-# INLINE cuMemHostAlloc #-}-{# fun unsafe cuMemHostAlloc-  { alloca'-        `HostPtr a'   peekHP*-  ,                 `Int'-  , combineBitMasks `[AllocFlag]'         } -> `Status' cToEnum #}-  where-    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)-    peekHP !p  = HostPtr . castPtr <$> peek p---- Pointer to the foreign function to release host arrays, which may be used as--- a finalizer. Technically this function has a non-void return type, but I am--- hoping that that doesn't matter...----foreign import ccall "&cuMemFreeHost" finalizerMemFreeHost :: FinalizerPtr a---- |--- Free a section of page-locked host memory.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g62e0fdbe181dab6b1c90fa1a51c7b92c>----{-# INLINEABLE freeHost #-}-freeHost :: HostPtr a -> IO ()-freeHost !p = nothingIfOk =<< cuMemFreeHost p--{-# INLINE cuMemFreeHost #-}-{# fun unsafe cuMemFreeHost-  { useHP `HostPtr a' } -> `Status' cToEnum #}-  where-    useHP = castPtr . useHostPtr----- |--- Page-locks the specified array (on the host) and maps it for the device(s) as--- specified by the given allocation flags. Subsequently, the memory is accessed--- directly by the device so can be read and written with much higher bandwidth--- than pageable memory that has not been registered. The memory range is added--- to the same tracking mechanism as 'mallocHostArray' to automatically--- accelerate calls to functions such as 'pokeArray'.------ Note that page-locking excessive amounts of memory may degrade system--- performance, since it reduces the amount of pageable memory available. This--- is best used sparingly to allocate staging areas for data exchange.------ This function has limited support on Mac OS X. OS 10.7 or later is--- required.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf0a9fe11544326dabd743b7aa6b54223>----{-# INLINEABLE registerArray #-}-registerArray :: Storable a => [AllocFlag] -> Int -> Ptr a -> IO (HostPtr a)-#if CUDA_VERSION < 4000-registerArray _ _ _     = requireSDK 'registerArray 4.0-#else-registerArray !flags !n = go undefined-  where-    go :: Storable b => b -> Ptr b -> IO (HostPtr b)-    go x !p = do-      status <- cuMemHostRegister p (n * sizeOf x) flags-      resultIfOk (status,HostPtr p)--{-# INLINE cuMemHostRegister #-}-{# fun unsafe cuMemHostRegister-  { castPtr         `Ptr a'-  ,                 `Int'-  , combineBitMasks `[AllocFlag]' } -> `Status' cToEnum #}-#endif----- |--- Unmaps the memory from the given pointer, and makes it pageable again.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g63f450c8125359be87b7623b1c0b2a14>----{-# INLINEABLE unregisterArray #-}-unregisterArray :: HostPtr a -> IO (Ptr a)-#if CUDA_VERSION < 4000-unregisterArray _           = requireSDK 'unregisterArray 4.0-#else-unregisterArray (HostPtr !p) = do-  status <- cuMemHostUnregister p-  resultIfOk (status,p)--{-# INLINE cuMemHostUnregister #-}-{# fun unsafe cuMemHostUnregister-  { castPtr `Ptr a' } -> `Status' cToEnum #}-#endif-------------------------------------------------------------------------------------- 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 suitably aligned for any type, and is not cleared.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gb82d2a09844a58dd9e744dc31e8aa467>----{-# 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 =<< cuMemAlloc (n * sizeOf x)--{-# INLINE cuMemAlloc #-}-{# fun unsafe cuMemAlloc-  { alloca'- `DevicePtr a' peekDeviceHandle*-  ,          `Int'                           } -> `Status' cToEnum #}-  where-    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)----- |--- Execute a computation on the device, 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 want to add a--- synchronisation point using 'Foreign.CUDA.Driver.Context.sync' as part--- of the continuation.----{-# INLINEABLE allocaArray #-}-allocaArray :: Storable a => Int -> (DevicePtr a -> IO b) -> IO b-allocaArray !n = bracket (mallocArray n) free----- |--- Release a section of device memory.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g89b3f154e17cc89b6eea277dbdf5c93a>----{-# INLINEABLE free #-}-free :: DevicePtr a -> IO ()-free !dp = nothingIfOk =<< cuMemFree dp--{-# INLINE cuMemFree #-}-{# fun unsafe cuMemFree-  { useDeviceHandle `DevicePtr a' } -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Unified memory allocations------------------------------------------------------------------------------------- |--- Options for unified memory allocations----#if CUDA_VERSION < 6000-data AttachFlag-#else-{# enum CUmemAttach_flags as AttachFlag-    { underscoreToCase }-    with prefix="CU_MEM_ATTACH_OPTION" deriving (Eq, Show, Bounded) #}-#endif---- |--- Allocates memory that will be automatically managed by the Unified Memory--- system. The returned pointer is valid on the CPU and on all GPUs which--- supported managed memory. All accesses to this pointer must obey the--- Unified Memory programming model.------ On a multi-GPU system with peer-to-peer support, where multiple GPUs--- support managed memory, the physical storage is created on the GPU which--- is active at the time 'mallocManagedArray' is called. All other GPUs--- will access the array at reduced bandwidth via peer mapping over the--- PCIe bus. The Unified Memory system does not migrate memory between--- GPUs.------ On a multi-GPU system where multiple GPUs support managed memory, but--- not all pairs of such GPUs have peer-to-peer support between them, the--- physical storage is allocated in system memory (zero-copy memory) and--- all GPUs will access the data at reduced bandwidth over the PCIe bus.------ Requires CUDA-6.0------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gb347ded34dc326af404aa02af5388a32>----{-# INLINEABLE mallocManagedArray #-}-mallocManagedArray :: Storable a => [AttachFlag] -> Int -> IO (DevicePtr a)-#if CUDA_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 =<< cuMemAllocManaged (n * sizeOf x) flags--{-# INLINE cuMemAllocManaged #-}-{# fun unsafe cuMemAllocManaged-  { alloca'-        `DevicePtr a' peekDeviceHandle*-  ,                 `Int'-  , combineBitMasks `[AttachFlag]'                  } -> `Status' cToEnum #}-  where-    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)-#endif-------------------------------------------------------------------------------------- Marshalling------------------------------------------------------------------------------------- Device -> Host--- ------------------ |--- Copy a number of elements from the device to host memory. This is a--- synchronous operation.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g3480368ee0208a98f75019c9a8450893>----{-# INLINEABLE peekArray #-}-peekArray :: Storable a => Int -> DevicePtr a -> Ptr a -> IO ()-peekArray !n !dptr !hptr = doPeek undefined dptr-  where-    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPeek x _ = nothingIfOk =<< cuMemcpyDtoH hptr dptr (n * sizeOf x)--{-# INLINE cuMemcpyDtoH #-}-{# fun cuMemcpyDtoH-  { castPtr         `Ptr a'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'         } -> `Status' cToEnum #}----- |--- Copy memory from the device asynchronously, possibly associated with a--- particular stream. The destination host memory must be page-locked.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g56f30236c7c5247f8e061b59d3268362>----{-# INLINEABLE peekArrayAsync #-}-peekArrayAsync :: Storable a => Int -> DevicePtr a -> HostPtr a -> Maybe Stream -> IO ()-peekArrayAsync !n !dptr !hptr !mst = doPeek undefined dptr-  where-    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPeek x _ = nothingIfOk =<< cuMemcpyDtoHAsync hptr dptr (n * sizeOf x) (fromMaybe defaultStream mst)--{-# INLINE cuMemcpyDtoHAsync #-}-{# fun cuMemcpyDtoHAsync-  { useHP           `HostPtr a'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}-  where-    useHP = castPtr . useHostPtr----- |--- Copy a 2D array from the device to the host.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>----{-# INLINEABLE peekArray2D #-}-peekArray2D-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> DevicePtr a              -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> Ptr a                    -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> IO ()-peekArray2D !w !h !dptr !dw !dx !dy !hptr !hw !hx !hy = doPeek undefined dptr-  where-    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPeek x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-      in-      nothingIfOk =<< cuMemcpy2DDtoH hptr hw' hx' hy dptr dw' dx' dy w' h--{-# INLINE cuMemcpy2DDtoH #-}-{# fun cuMemcpy2DDtoH-  { castPtr         `Ptr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  }-  -> `Status' cToEnum #}----- |--- Copy a 2D array from the device to the host asynchronously, possibly--- associated with a particular execution stream. The destination host memory--- must be page-locked.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>----{-# INLINEABLE peekArray2DAsync #-}-peekArray2DAsync-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> DevicePtr a              -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> HostPtr a                -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> Maybe Stream             -- ^ stream to associate to-    -> IO ()-peekArray2DAsync !w !h !dptr !dw !dx !dy !hptr !hw !hx !hy !mst = doPeek undefined dptr-  where-    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPeek x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-          st    = fromMaybe defaultStream mst-      in-      nothingIfOk =<< cuMemcpy2DDtoHAsync hptr hw' hx' hy dptr dw' dx' dy w' h st--{-# INLINE cuMemcpy2DDtoHAsync #-}-{# fun cuMemcpy2DDtoHAsync-  { useHP           `HostPtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useStream       `Stream'-  }-  -> `Status' cToEnum #}-  where-    useHP = castPtr . useHostPtr----- |--- 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----- Host -> Device--- ------------------ |--- Copy a number of elements onto the device. This is a synchronous operation.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4d32266788c440b0220b1a9ba5795169>----{-# INLINEABLE pokeArray #-}-pokeArray :: Storable a => Int -> Ptr a -> DevicePtr a -> IO ()-pokeArray !n !hptr !dptr = doPoke undefined dptr-  where-    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPoke x _ = nothingIfOk =<< cuMemcpyHtoD dptr hptr (n * sizeOf x)--{-# INLINE cuMemcpyHtoD #-}-{# fun cuMemcpyHtoD-  { useDeviceHandle `DevicePtr a'-  , castPtr         `Ptr a'-  ,                 `Int'         } -> `Status' cToEnum #}----- |--- Copy memory onto the device asynchronously, possibly associated with a--- particular stream. The source host memory must be page-locked.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g1572263fe2597d7ba4f6964597a354a3>----{-# INLINEABLE pokeArrayAsync #-}-pokeArrayAsync :: Storable a => Int -> HostPtr a -> DevicePtr a -> Maybe Stream -> IO ()-pokeArrayAsync !n !hptr !dptr !mst = dopoke undefined dptr-  where-    dopoke :: Storable a' => a' -> DevicePtr a' -> IO ()-    dopoke x _ = nothingIfOk =<< cuMemcpyHtoDAsync dptr hptr (n * sizeOf x) (fromMaybe defaultStream mst)--{-# INLINE cuMemcpyHtoDAsync #-}-{# fun cuMemcpyHtoDAsync-  { useDeviceHandle `DevicePtr a'-  , useHP           `HostPtr a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}-  where-    useHP = castPtr . useHostPtr----- |--- Copy a 2D array from the host to the device.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>----{-# INLINEABLE pokeArray2D #-}-pokeArray2D-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> Ptr a                    -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> DevicePtr a              -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> IO ()-pokeArray2D !w !h !hptr !hw !hx !hy !dptr !dw !dx !dy = doPoke undefined dptr-  where-    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPoke x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-      in-      nothingIfOk =<< cuMemcpy2DHtoD dptr dw' dx' dy hptr hw' hx' hy w' h--{-# INLINE cuMemcpy2DHtoD #-}-{# fun cuMemcpy2DHtoD-  { useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , castPtr         `Ptr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  }-  -> `Status' cToEnum #}----- |--- Copy a 2D array from the host to the device asynchronously, possibly--- associated with a particular execution stream. The source host memory must be--- page-locked.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>----{-# INLINEABLE pokeArray2DAsync #-}-pokeArray2DAsync-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> HostPtr a                -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> DevicePtr a              -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> Maybe Stream             -- ^ stream to associate to-    -> IO ()-pokeArray2DAsync !w !h !hptr !hw !hx !hy !dptr !dw !dx !dy !mst = doPoke undefined dptr-  where-    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()-    doPoke x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-          st    = fromMaybe defaultStream mst-      in-      nothingIfOk =<< cuMemcpy2DHtoDAsync dptr dw' dx' dy hptr hw' hx' hy w' h st--{-# INLINE cuMemcpy2DHtoDAsync #-}-{# fun cuMemcpy2DHtoDAsync-  { useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useHP           `HostPtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useStream       `Stream'-  }-  -> `Status' cToEnum #}-  where-    useHP = castPtr . useHostPtr----- |--- Write a list of storable elements into a device array. The device 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----- Device -> Device--- -------------------- |--- Copy the given number of elements from the first device array (source) to the--- second device (destination). The copied areas may not overlap. This operation--- is asynchronous with respect to the host, but will never overlap with kernel--- execution.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g1725774abf8b51b91945f3336b778c8b>----{-# INLINEABLE copyArray #-}-copyArray :: Storable a => Int -> DevicePtr a -> DevicePtr a -> IO ()-copyArray !n = docopy undefined-  where-    docopy :: Storable a' => a' -> DevicePtr a' -> DevicePtr a' -> IO ()-    docopy x src dst = nothingIfOk =<< cuMemcpyDtoD dst src (n * sizeOf x)--{-# INLINE cuMemcpyDtoD #-}-{# fun unsafe cuMemcpyDtoD-  { useDeviceHandle `DevicePtr a'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'         } -> `Status' cToEnum #}----- |--- Copy the given number of elements from the first device array (source) to the--- second device array (destination). The copied areas may not overlap. The--- operation is asynchronous with respect to the host, and can be asynchronous--- to other device operations by associating it with a particular stream.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g39ea09ba682b8eccc9c3e0c04319b5c8>----{-# INLINEABLE copyArrayAsync #-}-copyArrayAsync :: Storable a => Int -> DevicePtr a -> DevicePtr a -> Maybe Stream -> IO ()-copyArrayAsync !n !src !dst !mst = docopy undefined src-  where-    docopy :: Storable a' => a' -> DevicePtr a' -> IO ()-    docopy x _ = nothingIfOk =<< cuMemcpyDtoDAsync dst src (n * sizeOf x) (fromMaybe defaultStream mst)--{-# INLINE cuMemcpyDtoDAsync #-}-{# fun unsafe cuMemcpyDtoDAsync-  { useDeviceHandle `DevicePtr a'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}----- |--- Copy a 2D array from the first device array (source) to the second device--- array (destination). The copied areas must not overlap. This operation is--- asynchronous with respect to the host, but will never overlap with kernel--- execution.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>----{-# INLINEABLE copyArray2D #-}-copyArray2D-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> DevicePtr a              -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> DevicePtr a              -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> IO ()-copyArray2D !w !h !src !hw !hx !hy !dst !dw !dx !dy = doCopy undefined dst-  where-    doCopy :: Storable a' => a' -> DevicePtr a' -> IO ()-    doCopy x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-      in-      nothingIfOk =<< cuMemcpy2DDtoD dst dw' dx' dy src hw' hx' hy w' h--{-# INLINE cuMemcpy2DDtoD #-}-{# fun unsafe cuMemcpy2DDtoD-  { useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  }-  -> `Status' cToEnum #}----- |--- Copy a 2D array from the first device array (source) to the second device--- array (destination). The copied areas may not overlap. The operation is--- asynchronous with respect to the host, and can be asynchronous to other--- device operations by associating it with a particular execution stream.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>----{-# INLINEABLE copyArray2DAsync #-}-copyArray2DAsync-    :: Storable a-    => Int                      -- ^ width to copy (elements)-    -> Int                      -- ^ height to copy (elements)-    -> DevicePtr a              -- ^ source array-    -> Int                      -- ^ source array width-    -> Int                      -- ^ source x-coordinate-    -> Int                      -- ^ source y-coordinate-    -> DevicePtr a              -- ^ destination array-    -> Int                      -- ^ destination array width-    -> Int                      -- ^ destination x-coordinate-    -> Int                      -- ^ destination y-coordinate-    -> Maybe Stream             -- ^ stream to associate to-    -> IO ()-copyArray2DAsync !w !h !src !hw !hx !hy !dst !dw !dx !dy !mst = doCopy undefined dst-  where-    doCopy :: Storable a' => a' -> DevicePtr a' -> IO ()-    doCopy x _ =-      let bytes = sizeOf x-          w'    = w  * bytes-          hw'   = hw * bytes-          hx'   = hx * bytes-          dw'   = dw * bytes-          dx'   = dx * bytes-          st    = fromMaybe defaultStream mst-      in-      nothingIfOk =<< cuMemcpy2DDtoDAsync dst dw' dx' dy src hw' hx' hy w' h st--{-# INLINE cuMemcpy2DDtoDAsync #-}-{# fun unsafe cuMemcpy2DDtoDAsync-  { useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useDeviceHandle `DevicePtr a'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  ,                 `Int'-  , useStream       `Stream'-  }-  -> `Status' cToEnum #}------ Context -> Context--- ---------------------- |--- Copies an array from device memory in one context to device memory in another--- context. Note that this function is asynchronous with respect to the host,--- but serialised with respect to all pending and future asynchronous work in--- the source and destination contexts. To avoid this synchronisation, use--- 'copyArrayPeerAsync' instead.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1ge1f5c7771544fee150ada8853c7cbf4a>----{-# INLINEABLE copyArrayPeer #-}-copyArrayPeer :: Storable a-              => Int                            -- ^ number of array elements-              -> DevicePtr a -> Context         -- ^ source array and context-              -> DevicePtr a -> Context         -- ^ destination array and context-              -> IO ()-#if CUDA_VERSION < 4000-copyArrayPeer _ _ _ _ _                    = requireSDK 'copyArrayPeer 4.0-#else-copyArrayPeer !n !src !srcCtx !dst !dstCtx = go undefined src dst-  where-    go :: Storable b => b -> DevicePtr b -> DevicePtr b -> IO ()-    go x _ _ = nothingIfOk =<< cuMemcpyPeer dst dstCtx src srcCtx (n * sizeOf x)--{-# INLINE cuMemcpyPeer #-}-{# fun unsafe cuMemcpyPeer-  { useDeviceHandle `DevicePtr a'-  , useContext      `Context'-  , useDeviceHandle `DevicePtr a'-  , useContext      `Context'-  ,                 `Int'         } -> `Status' cToEnum #}-#endif----- |--- Copies from device memory in one context to device memory in another context.--- Note that this function is asynchronous with respect to the host and all work--- in other streams and devices.------ Requires CUDA-4.0.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g82fcecb38018e64b98616a8ac30112f2>----{-# INLINEABLE copyArrayPeerAsync #-}-copyArrayPeerAsync :: Storable a-                   => Int                       -- ^ number of array elements-                   -> DevicePtr a -> Context    -- ^ source array and context-                   -> DevicePtr a -> Context    -- ^ destination array and device context-                   -> Maybe Stream              -- ^ stream to associate with-                   -> IO ()-#if CUDA_VERSION < 4000-copyArrayPeerAsync _ _ _ _ _ _                      = requireSDK 'copyArrayPeerAsync 4.0-#else-copyArrayPeerAsync !n !src !srcCtx !dst !dstCtx !st = go undefined src dst-  where-    go :: Storable b => b -> DevicePtr b -> DevicePtr b -> IO ()-    go x _ _ = nothingIfOk =<< cuMemcpyPeerAsync dst dstCtx src srcCtx (n * sizeOf x) stream-    stream   = fromMaybe defaultStream st--{-# INLINE cuMemcpyPeerAsync #-}-{# fun unsafe cuMemcpyPeerAsync-  { useDeviceHandle `DevicePtr a'-  , useContext      `Context'-  , useDeviceHandle `DevicePtr a'-  , useContext      `Context'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}-#endif-------------------------------------------------------------------------------------- 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 memory copies: firstly from a Haskell--- list to a heap allocated array, and from there onto the graphics device. The--- memory 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 to the array, the result of which is returned.--- Similar to 'newListArray', this requires copying the data twice.------ As with 'allocaArray', the memory is freed once the action completes, so you--- should not return the pointer from the action, and be wary of asynchronous--- kernel execution.----{-# 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------------------------------------------------------------------------------------- |--- Set a number of data elements to the specified value, which may be either 8-,--- 16-, or 32-bits wide.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g6e582bf866e9e2fb014297bfaf354d7b>------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g7d805e610054392a4d11e8a8bf5eb35c>------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g983e8d8759acd1b64326317481fbf132>----{-# INLINEABLE memset #-}-memset :: Storable a => DevicePtr a -> Int -> a -> IO ()-memset !dptr !n !val = case sizeOf val of-    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"------- We use unsafe coerce below to reinterpret the bits of the value to memset as,--- into the integer type required by the setting functions.----{-# INLINE cuMemsetD8 #-}-{# fun unsafe cuMemsetD8-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'         } -> `Status' cToEnum #}--{-# INLINE cuMemsetD16 #-}-{# fun unsafe cuMemsetD16-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'         } -> `Status' cToEnum #}--{-# INLINE cuMemsetD32 #-}-{# fun unsafe cuMemsetD32-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'         } -> `Status' cToEnum #}----- |--- Set the number of data elements to the specified value, which may be either--- 8-, 16-, or 32-bits wide. The operation is asynchronous and may optionally be--- associated with a stream.------ Requires CUDA-3.2.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gaef08a7ccd61112f94e82f2b30d43627>------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf731438877dd8ec875e4c43d848c878c>------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g58229da5d30f1c0cdf667b320ec2c0f5>----{-# INLINEABLE memsetAsync #-}-memsetAsync :: Storable a => DevicePtr a -> Int -> a -> Maybe Stream -> IO ()-#if CUDA_VERSION < 3020-memsetAsync _ _ _ _            = requireSDK 'memsetAsync 3.2-#else-memsetAsync !dptr !n !val !mst = case sizeOf val of-    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"-    where-      stream = fromMaybe defaultStream mst--{-# INLINE cuMemsetD8Async #-}-{# fun unsafe cuMemsetD8Async-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}--{-# INLINE cuMemsetD16Async #-}-{# fun unsafe cuMemsetD16Async-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}--{-# INLINE cuMemsetD32Async #-}-{# fun unsafe cuMemsetD32Async-  { useDeviceHandle `DevicePtr a'-  , unsafeCoerce    `a'-  ,                 `Int'-  , useStream       `Stream'      } -> `Status' cToEnum #}-#endif----- |--- Return the device pointer associated with a mapped, pinned host buffer, which--- was allocated with the 'DeviceMapped' option by 'mallocHostArray'.------ Currently, no options are supported and this must be empty.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g57a39e5cba26af4d06be67fc77cc62f0>----{-# INLINEABLE getDevicePtr #-}-getDevicePtr :: [AllocFlag] -> HostPtr a -> IO (DevicePtr a)-getDevicePtr !flags !hp = resultIfOk =<< cuMemHostGetDevicePointer hp flags--{-# INLINE cuMemHostGetDevicePointer #-}-{# fun unsafe cuMemHostGetDevicePointer-  { alloca'-        `DevicePtr a' peekDeviceHandle*-  , useHP           `HostPtr a'-  , combineBitMasks `[AllocFlag]'                   } -> `Status' cToEnum #}-  where-    alloca'  = F.alloca-    useHP    = castPtr . useHostPtr----- |--- Return the base address and allocation size of the given device pointer.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g64fee5711274a2a0573a789c94d8299b>----{-# INLINEABLE getBasePtr #-}-getBasePtr :: DevicePtr a -> IO (DevicePtr a, Int64)-getBasePtr !dptr = do-  (status,base,size) <- cuMemGetAddressRange dptr-  resultIfOk (status, (base,size))--{-# INLINE cuMemGetAddressRange #-}-{# fun unsafe cuMemGetAddressRange-  { alloca'-        `DevicePtr a' peekDeviceHandle*-  , alloca'-        `Int64'       peekIntConv*-  , useDeviceHandle `DevicePtr a'                   } -> `Status' cToEnum #}-  where-    alloca' :: Storable a => (Ptr a -> IO b) -> IO b-    alloca' = F.alloca---- |--- Return the amount of free and total memory respectively available to the--- current context (bytes).------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g808f555540d0143a331cc42aa98835c0>----{-# INLINEABLE getMemInfo #-}-getMemInfo :: IO (Int64, Int64)-getMemInfo = do-  (!status,!f,!t) <- cuMemGetInfo-  resultIfOk (status,(f,t))--{-# INLINE cuMemGetInfo #-}-{# fun unsafe cuMemGetInfo-  { alloca'- `Int64' peekIntConv*-  , alloca'- `Int64' peekIntConv* } -> `Status' cToEnum #}-  where-    alloca' = F.alloca-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------type DeviceHandle = {# type CUdeviceptr #}---- Lift an opaque handle to a typed DevicePtr representation. This occasions--- arcane distinctions for the different driver versions and Tesla (compute 1.x)--- and Fermi (compute 2.x) class architectures on 32- and 64-bit hosts.----{-# INLINE peekDeviceHandle #-}-peekDeviceHandle :: Ptr DeviceHandle -> IO (DevicePtr a)-peekDeviceHandle !p = DevicePtr . intPtrToPtr . fromIntegral <$> peek p---- Use a device pointer as an opaque handle type----{-# INLINE useDeviceHandle #-}-useDeviceHandle :: DevicePtr a -> DeviceHandle-useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr-
− Foreign/CUDA/Driver/Module.hs 
@@ -1,20 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Module--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Module management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Module (--  module Foreign.CUDA.Driver.Module.Base,-  module Foreign.CUDA.Driver.Module.Query,--) where--import Foreign.CUDA.Driver.Module.Base  hiding ( JITOptionInternal(..), useModule, jitOptionUnpack, jitTargetOfCompute )-import Foreign.CUDA.Driver.Module.Query-
− Foreign/CUDA/Driver/Module/Base.chs 
@@ -1,322 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}-{-# OPTIONS_HADDOCK prune #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Module.Base--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Module loading for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Module.Base (--  -- * Module Management-  Module(..),-  JITOption(..), JITTarget(..), JITResult(..), JITFallback(..), JITInputType(..),-  JITOptionInternal(..),--  -- ** Loading and unloading modules-  loadFile,-  loadData,   loadDataFromPtr,-  loadDataEx, loadDataFromPtrEx,-  unload,--  -- Internal-  jitOptionUnpack, jitTargetOfCompute,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Analysis.Device-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Unsafe.Coerce--import Control.Monad                                    ( liftM )-import Data.ByteString.Char8                            ( ByteString )-import qualified Data.ByteString.Char8                  as B-import qualified Data.ByteString.Internal               as B-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A reference to a Module object, containing collections of device functions----newtype Module = Module { useModule :: {# type CUmodule #}}-  deriving (Eq, Show)---- |--- Just-in-time compilation and linking options----data JITOption-  = MaxRegisters       !Int             -- ^ maximum number of registers per thread-  | ThreadsPerBlock    !Int             -- ^ number of threads per block to target for-  | OptimisationLevel  !Int             -- ^ level of optimisation to apply (1-4, default 4)-  | Target             !Compute         -- ^ compilation target, otherwise determined from context-  | FallbackStrategy   !JITFallback     -- ^ fallback strategy if matching cubin not found-  | GenerateDebugInfo                   -- ^ generate debug info (-g) (requires cuda >= 5.5)-  | GenerateLineInfo                    -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)-  | Verbose                             -- ^ verbose log messages (requires cuda >= 5.5)-  deriving (Show)---- |--- Results of online compilation----data JITResult = JITResult-  {-    jitTime     :: !Float,              -- ^ milliseconds spent compiling PTX-    jitInfoLog  :: !ByteString,         -- ^ information about PTX assembly-    jitModule   :: !Module              -- ^ the compiled module-  }-  deriving (Show)----- |--- Online compilation target architecture----{# enum CUjit_target as JITTarget-    { underscoreToCase }-    with prefix="CU_TARGET" deriving (Eq, Show) #}---- |--- Online compilation fallback strategy----{# enum CUjit_fallback as JITFallback-    { underscoreToCase-    , CU_PREFER_PTX as PreferPTX }-    with prefix="CU" deriving (Eq, Show) #}---- |--- Device code formats that can be used for online linking----#if CUDA_VERSION < 5050-data JITInputType-#else-{# enum CUjitInputType as JITInputType-    { underscoreToCase-    , CU_JIT_INPUT_PTX as PTX }-    with prefix="CU_JIT_INPUT" deriving (Eq, Show) #}-#endif--{# enum CUjit_option as JITOptionInternal-    { }-    with prefix="CU" deriving (Eq, Show) #}-------------------------------------------------------------------------------------- Module management------------------------------------------------------------------------------------- |--- Load the contents of the specified file (either a ptx or cubin file) to--- create a new module, and load that module into the current context.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g366093bd269dafd0af21f1c7d18115d3>----{-# INLINEABLE loadFile #-}-loadFile :: FilePath -> IO Module-loadFile !ptx = resultIfOk =<< cuModuleLoad ptx--{-# INLINE cuModuleLoad #-}-{# fun unsafe cuModuleLoad-  { alloca-      `Module'   peekMod*-  , withCString* `FilePath'          } -> `Status' cToEnum #}----- |--- Load the contents of the given image into a new module, and load that module--- into the current context. The image is (typically) the contents of a cubin or--- PTX file.------ Note that the 'ByteString' will be copied into a temporary staging area so--- that it can be passed to C.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g04ce266ce03720f479eab76136b90c0b>----{-# INLINEABLE loadData #-}-loadData :: ByteString -> IO Module-loadData !img =-  B.useAsCString img (\p -> loadDataFromPtr (castPtr p))---- |--- As 'loadData', but read the image data from the given pointer. The image is a--- NULL-terminated sequence of bytes.----{-# INLINEABLE loadDataFromPtr #-}-loadDataFromPtr :: Ptr Word8 -> IO Module-loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img--{-# INLINE cuModuleLoadData #-}-{# fun unsafe cuModuleLoadData-  { alloca- `Module'    peekMod*-  , castPtr `Ptr Word8'          } -> ` Status' cToEnum #}----- |--- Load the contents of the given image into a module with online compiler--- options, and load the module into the current context. The image is--- (typically) the contents of a cubin or PTX file. The actual attributes of the--- compiled kernel can be probed using 'requires'.------ Note that the 'ByteString' will be copied into a temporary staging area so--- that it can be passed to C.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9e8047e9dbf725f0cd7cafd18bfd4d12>----{-# INLINEABLE loadDataEx #-}-loadDataEx :: ByteString -> [JITOption] -> IO JITResult-loadDataEx !img !options =-  B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)---- |--- As 'loadDataEx', but read the image data from the given pointer. The image is--- a NULL-terminated sequence of bytes.----{-# INLINEABLE loadDataFromPtrEx #-}-loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult-loadDataFromPtrEx !img !options = do-  let logSize = 2048--  fp_ilog <- B.mallocByteString logSize--  allocaArray logSize    $ \p_elog -> do-  withForeignPtr fp_ilog $ \p_ilog -> do--  let (opt,val) = unzip $-        [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below-        , (JIT_INFO_LOG_BUFFER_SIZE_BYTES,  logSize)-        , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize)-        , (JIT_INFO_LOG_BUFFER,  unsafeCoerce (p_ilog :: CString))-        , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString))-        ]-        ++-        map jitOptionUnpack options--  withArrayLen (map cFromEnum opt)    $ \i p_opts -> do-  withArray    (map unsafeCoerce val) $ \  p_vals -> do--  (s,mdl) <- cuModuleLoadDataEx img i p_opts p_vals--  case s of-    Success -> do-      time    <- peek (castPtr p_vals)-      bytes   <- c_strnlen p_ilog logSize-      let infoLog | bytes == 0 = B.empty-                  | otherwise  = B.fromForeignPtr (castForeignPtr fp_ilog) 0 bytes-      return  $! JITResult time infoLog mdl--    _       -> do-      errLog  <- peekCString p_elog-      cudaError (unlines [describe s, errLog])---{-# INLINE cuModuleLoadDataEx #-}-{# fun unsafe cuModuleLoadDataEx-  { alloca- `Module'       peekMod*-  , castPtr `Ptr Word8'-  ,         `Int'-  , id      `Ptr CInt'-  , id      `Ptr (Ptr ())'          } -> `Status' cToEnum #}----- |--- Unload a module from the current context.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g8ea3d716524369de3763104ced4ea57b>----{-# INLINEABLE unload #-}-unload :: Module -> IO ()-unload !m = nothingIfOk =<< cuModuleUnload m--{-# INLINE cuModuleUnload #-}-{# fun unsafe cuModuleUnload-  { useModule `Module' } -> `Status' cToEnum #}-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------{-# INLINE peekMod #-}-peekMod :: Ptr {# type CUmodule #} -> IO Module-peekMod = liftM Module . peek---{-# INLINE jitOptionUnpack #-}-jitOptionUnpack :: JITOption -> (JITOptionInternal, Int)-jitOptionUnpack (MaxRegisters x)      = (JIT_MAX_REGISTERS,       x)-jitOptionUnpack (ThreadsPerBlock x)   = (JIT_THREADS_PER_BLOCK,   x)-jitOptionUnpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL,  x)-jitOptionUnpack (Target x)            = (JIT_TARGET,              fromEnum (jitTargetOfCompute x))-jitOptionUnpack (FallbackStrategy x)  = (JIT_FALLBACK_STRATEGY,   fromEnum x)-#if CUDA_VERSION >= 5050-jitOptionUnpack GenerateDebugInfo     = (JIT_GENERATE_DEBUG_INFO, fromEnum True)-jitOptionUnpack GenerateLineInfo      = (JIT_GENERATE_LINE_INFO,  fromEnum True)-jitOptionUnpack Verbose               = (JIT_LOG_VERBOSE,         fromEnum True)-#else-jitOptionUnpack GenerateDebugInfo     = requireSDK 'GenerateDebugInfo 5.5-jitOptionUnpack GenerateLineInfo      = requireSDK 'GenerateLineInfo 5.5-jitOptionUnpack Verbose               = requireSDK 'Verbose 5.5-#endif---{-# INLINE jitTargetOfCompute #-}-jitTargetOfCompute :: Compute -> JITTarget-jitTargetOfCompute (Compute 1 0) = Compute10-jitTargetOfCompute (Compute 1 1) = Compute11-jitTargetOfCompute (Compute 1 2) = Compute12-jitTargetOfCompute (Compute 1 3) = Compute13-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)-
− Foreign/CUDA/Driver/Module/Link.chs 
@@ -1,224 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE CPP                      #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Module.Link--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Module linking for low-level driver interface------ Since CUDA-5.5--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Module.Link (--  -- ** JIT module linking-  LinkState, JITOption(..), JITInputType(..),--  create, destroy, complete,-  addFile,-  addData, addDataFromPtr,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Driver.Module.Base-import Foreign.CUDA.Internal.C2HS---- System-import Control.Monad                                    ( liftM )-import Foreign-import Foreign.C-import Unsafe.Coerce--import Data.ByteString.Char8                            ( ByteString )-import qualified Data.ByteString.Char8                  as B-------------------------------------------------------------------------------------- Data Types------------------------------------------------------------------------------------- |--- A pending JIT linker state----#if CUDA_VERSION < 5050-data LinkState-#else-newtype LinkState = LinkState { useLinkState :: {# type CUlinkState #} }-  deriving (Show)-#endif-------------------------------------------------------------------------------------- JIT linking------------------------------------------------------------------------------------- |--- Create a pending JIT linker invocation. The returned 'LinkState' should--- be 'destroy'ed once no longer needed. The device code machine size will--- match the calling application.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g86ca4052a2fab369cb943523908aa80d>----{-# INLINEABLE create #-}-create :: [JITOption] -> IO LinkState-#if CUDA_VERSION < 5050-create _        = requireSDK 'create 5.5-#else-create !options =-  let (opt,val) = unzip $ map jitOptionUnpack options-  in-  withArray (map cFromEnum opt)    $ \p_opts ->-  withArray (map unsafeCoerce val) $ \p_vals ->-    resultIfOk =<< cuLinkCreate (length opt) p_opts p_vals--{-# INLINE cuLinkCreate #-}-{# fun unsafe cuLinkCreate-  {         `Int'-  , id      `Ptr CInt'-  , id      `Ptr (Ptr ())'-  , alloca- `LinkState'    peekLS* } -> `Status' cToEnum #}-  where-    peekLS = liftM LinkState . peek-#endif----- |--- Destroy the state of a JIT linker invocation.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g01b7ae2a34047b05716969af245ce2d9>----{-# INLINEABLE destroy #-}-destroy :: LinkState -> IO ()-#if CUDA_VERSION < 5050-destroy _  = requireSDK 'destroy 5.5-#else-destroy !s = nothingIfOk =<< cuLinkDestroy s--{-# INLINE cuLinkDestroy #-}-{# fun unsafe cuLinkDestroy-  { useLinkState `LinkState' } -> `Status' cToEnum #}-#endif----- |--- Complete a pending linker invocation and load the current module. The--- link state will be destroyed.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g818fcd84a4150a997c0bba76fef4e716>----{-# INLINEABLE complete #-}-complete :: LinkState -> IO Module-#if CUDA_VERSION < 5050-complete _   = requireSDK 'complete 5.5-#else-complete !ls = do-  cubin <- resultIfOk =<< cuLinkComplete ls nullPtr-  mdl   <- loadDataFromPtr (castPtr cubin)-  destroy ls-  return mdl--{-# INLINE cuLinkComplete #-}-{# fun unsafe cuLinkComplete-  { useLinkState `LinkState'-  , alloca-      `Ptr ()'    peek*-  , castPtr      `Ptr Int'-  }-  -> `Status' cToEnum #}-#endif----- |--- Add an input file to a pending linker invocation.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g1224c0fd48d4a683f3ce19997f200a8c>----{-# INLINEABLE addFile #-}-addFile :: LinkState -> FilePath -> JITInputType -> [JITOption] -> IO ()-#if CUDA_VERSION < 5050-addFile _ _ _ _ = requireSDK 'addFile 5.5-#else-addFile !ls !fp !t !options =-  let (opt,val) = unzip $ map jitOptionUnpack options-  in-  withArrayLen (map cFromEnum opt)    $ \i p_opts ->-  withArray    (map unsafeCoerce val) $ \  p_vals ->-    nothingIfOk =<< cuLinkAddFile ls t fp i p_opts p_vals--{-# INLINE cuLinkAddFile #-}-{# fun unsafe cuLinkAddFile-  { useLinkState `LinkState'-  , cFromEnum    `JITInputType'-  , withCString* `FilePath'-  ,              `Int'-  , id           `Ptr CInt'-  , id           `Ptr (Ptr ())'-  }-  -> `Status' cToEnum #}-#endif----- |--- Add an input to a pending linker invocation.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g3ebcd2ccb772ba9c120937a2d2831b77>----{-# INLINEABLE addData #-}-addData :: LinkState -> ByteString -> JITInputType -> [JITOption] -> IO ()-#if CUDA_VERSION < 5050-addData _ _ _ = requireSDK 'addData 5.5-#else-addData !ls !img !k !options =-  B.useAsCStringLen img (\(p, n) -> addDataFromPtr ls n (castPtr p) k options)-#endif---- |--- As 'addData', but read the specified number of bytes of image data from--- the given pointer.----{-# INLINEABLE addDataFromPtr #-}-addDataFromPtr :: LinkState -> Int -> Ptr Word8 -> JITInputType -> [JITOption] -> IO ()-#if CUDA_VERSION < 5050-addDataFromPtr _ _ _ _ = requireSDK 'addDataFromPtr 5.5-#else-addDataFromPtr !ls !n !img !t !options =-  let (opt,val) = unzip $ map jitOptionUnpack options-  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--{-# INLINE cuLinkAddData #-}-{# fun unsafe cuLinkAddData-  { useLinkState `LinkState'-  , cFromEnum    `JITInputType'-  , castPtr      `Ptr Word8'-  ,              `Int'-  ,              `String'-  ,              `Int'-  , id           `Ptr CInt'-  , id           `Ptr (Ptr ())'-  }-  -> `Status' cToEnum #}-#endif-
− Foreign/CUDA/Driver/Module/Query.chs 
@@ -1,108 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Module.Query--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Querying module attributes for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Module.Query (--  -- ** Querying module inhabitants-  getFun, getPtr, getTex,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Error-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---- System-import Foreign-import Foreign.C-import Control.Exception                                ( throwIO )-import Control.Monad                                    ( liftM )-------------------------------------------------------------------------------------- Querying module attributes------------------------------------------------------------------------------------- |--- Returns a function handle.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1ga52be009b0d4045811b30c965e1cb2cf>----{-# INLINEABLE getFun #-}-getFun :: Module -> String -> 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----- |--- Return a global pointer, and size of the global (in bytes).------ <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 !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 #}-------------------------------------------------------------------------------------- Internal-----------------------------------------------------------------------------------{-# INLINE resultIfFound #-}-resultIfFound :: String -> String -> (Status, a) -> IO a-resultIfFound kind name (!status,!result) =-  case status of-       Success  -> return result-       NotFound -> cudaError (kind ++ ' ' : describe status ++ ": " ++ name)-       _        -> throwIO (ExitCode status)-
− Foreign/CUDA/Driver/Profiler.chs 
@@ -1,100 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Profiler--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Profiler control for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Profiler (--  OutputMode(..),-  initialise,-  start, stop,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- friends-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- system-import Foreign-import Foreign.C----- | Profiler output mode----{# enum CUoutput_mode as OutputMode-    { underscoreToCase-    , CU_OUT_CSV as CSV }-    with prefix="CU_OUT" deriving (Eq, Show) #}----- | Initialise the CUDA profiler.------ The configuration file is used to specify profiling options and profiling--- counters. Refer to the "Compute Command Line Profiler User Guide" for--- supported profiler options and counters.------ Note that the CUDA profiler can not be initialised with this function if--- another profiling tool is already active.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER>----{-# INLINEABLE initialise #-}-initialise-    :: FilePath     -- ^ configuration file that itemises which counters and/or options to profile-    -> FilePath     -- ^ output file where profiling results will be stored-    -> OutputMode-    -> IO ()-initialise config output mode-  = nothingIfOk =<< cuProfilerInitialize config output mode--{-# INLINE cuProfilerInitialize #-}-{# fun unsafe cuProfilerInitialize-  {           `String'-  ,           `String'-  , cFromEnum `OutputMode'-  }-  -> `Status' cToEnum #}----- | Begin profiling collection by the active profiling tool for the current--- context. If profiling is already enabled, then this has no effect.------ 'start' and 'stop' can be used to programatically control profiling--- granularity, by allowing profiling to be done only on selected pieces of--- code.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g8a5314de2292c2efac83ac7fcfa9190e>----{-# INLINEABLE start #-}-start :: IO ()-start = nothingIfOk =<< cuProfilerStart--{-# INLINE cuProfilerStart #-}-{# fun unsafe cuProfilerStart-  { } -> `Status' cToEnum #}----- | Stop profiling collection by the active profiling tool for the current--- context, and force all pending profiler events to be written to the output--- file. If profiling is already inactive, this has no effect.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g4d8edef6174fd90165e6ac838f320a5f>----{-# INLINEABLE stop #-}-stop :: IO ()-stop = nothingIfOk =<< cuProfilerStop--{-# INLINE cuProfilerStop #-}-{# fun unsafe cuProfilerStop-  { } -> `Status' cToEnum #}-
− Foreign/CUDA/Driver/Stream.chs 
@@ -1,167 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Stream--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Stream management for low-level driver interface--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Stream (--  -- * Stream Management-  Stream(..), StreamFlag,-  create, createWithPriority, destroy, finished, block, getPriority,--  defaultStream,--) where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Types-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C-import Control.Monad                                    ( liftM )-import Control.Exception                                ( throwIO )-------------------------------------------------------------------------------------- Stream management------------------------------------------------------------------------------------- |--- Create a new stream.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1ga581f0c5833e21ded8b5a56594e243f4>----{-# INLINEABLE create #-}-create :: [StreamFlag] -> IO Stream-create !flags = resultIfOk =<< cuStreamCreate flags--{-# INLINE cuStreamCreate #-}-{# fun unsafe cuStreamCreate-  { alloca-         `Stream'       peekStream*-  , combineBitMasks `[StreamFlag]'             } -> `Status' cToEnum #}-  where-    peekStream = liftM Stream . peek----- |--- Create a stream with the given priority. Work submitted to--- a higher-priority stream may preempt work already executing in a lower--- priority stream.------ The convention is that lower numbers represent higher priorities. The--- default priority is zero. The range of meaningful numeric priorities can--- be queried using 'Foreign.CUDA.Driver.Context.Config.getStreamPriorityRange'.--- If the specified priority is outside the supported numerical range, it--- will automatically be clamped to the highest or lowest number in the--- range.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g95c1a8c7c3dacb13091692dd9c7f7471>----{-# INLINEABLE createWithPriority #-}-createWithPriority :: StreamPriority -> [StreamFlag] -> IO Stream-#if CUDA_VERSION < 5050-createWithPriority _ _              = requireSDK 'createWithPriority 5.5-#else-createWithPriority !priority !flags = resultIfOk =<< cuStreamCreateWithPriority flags priority--{-# INLINE cuStreamCreateWithPriority #-}-{# fun unsafe cuStreamCreateWithPriority-  { alloca-         `Stream'         peekStream*-  , combineBitMasks `[StreamFlag]'-  , cIntConv        `StreamPriority'-  }-  -> `Status' cToEnum #}-  where-    peekStream = liftM Stream . peek-#endif----- |--- Destroy a stream. If the device is still doing work in the stream when--- 'destroy' is called, the function returns immediately and the resources--- associated with the stream will be released automatically once the--- device has completed all work.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g244c8833de4596bcd31a06cdf21ee758>----{-# INLINEABLE destroy #-}-destroy :: Stream -> IO ()-destroy !st = nothingIfOk =<< cuStreamDestroy st--{-# INLINE cuStreamDestroy #-}-{# fun unsafe cuStreamDestroy-  { useStream `Stream' } -> `Status' cToEnum #}----- |--- Check if all operations in the stream have completed.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g1b0d24bbe97fa68e4bc511fb6adfeb0b>----{-# INLINEABLE finished #-}-finished :: Stream -> IO Bool-finished !st =-  cuStreamQuery st >>= \rv ->-  case rv of-    Success  -> return True-    NotReady -> return False-    _        -> throwIO (ExitCode rv)--{-# INLINE cuStreamQuery #-}-{# fun unsafe cuStreamQuery-  { useStream `Stream' } -> `Status' cToEnum #}----- |--- Wait until the device has completed all operations in the Stream.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g15e49dd91ec15991eb7c0a741beb7dad>----{-# INLINEABLE block #-}-block :: Stream -> IO ()-block !st = nothingIfOk =<< cuStreamSynchronize st--{-# INLINE cuStreamSynchronize #-}-{# fun cuStreamSynchronize-  { useStream `Stream' } -> `Status' cToEnum #}----- |--- Query the priority of a stream.------ Requires CUDA-5.5.------ <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g5bd5cb26915a2ecf1921807339488484>----{-# INLINEABLE getPriority #-}-getPriority :: Stream -> IO StreamPriority-#if CUDA_VERSION < 5050-getPriority _   = requireSDK 'getPriority 5.5-#else-getPriority !st = resultIfOk =<< cuStreamGetPriority st--{-# INLINE cuStreamGetPriority #-}-{# fun unsafe cuStreamGetPriority-  { useStream `Stream'-  , alloca-   `StreamPriority' peekIntConv*-  }-  -> `Status' cToEnum #}-#endif-
− Foreign/CUDA/Driver/Texture.chs 
@@ -1,308 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# OPTIONS_HADDOCK prune #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Texture--- Copyright : [2009..2014] 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-
− Foreign/CUDA/Driver/Utils.chs 
@@ -1,37 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Driver.Utils--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Utility functions--------------------------------------------------------------------------------------module Foreign.CUDA.Driver.Utils (driverVersion)-  where--#include "cbits/stubs.h"-{# context lib="cuda" #}---- Friends-import Foreign.CUDA.Driver.Error-import Foreign.CUDA.Internal.C2HS---- System-import Foreign-import Foreign.C----- |--- Return the version number of the installed CUDA driver.----{-# INLINEABLE driverVersion #-}-driverVersion :: IO Int-driverVersion =  resultIfOk =<< cuDriverGetVersion--{-# INLINE cuDriverGetVersion #-}-{# fun unsafe cuDriverGetVersion-  { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}-
− Foreign/CUDA/Internal/C2HS.hs 
@@ -1,230 +0,0 @@---  C->Haskell Compiler: Marshalling library------  Copyright (c) [1999...2005] Manuel M T Chakravarty------  Redistribution and use in source and binary forms, with or without---  modification, are permitted provided that the following conditions are met:------  1. Redistributions of source code must retain the above copyright notice,---     this list of conditions and the following disclaimer.---  2. Redistributions in binary form must reproduce the above copyright---     notice, this list of conditions and the following disclaimer in the---     documentation and/or other materials provided with the distribution.---  3. The name of the author may not be used to endorse or promote products---     derived from this software without specific prior written permission.------  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR---  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES---  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN---  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,---  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED---  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR---  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF---  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING---  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS---  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description ---------------------------------------------------------------------  Language: Haskell 98------  This module provides the marshaling routines for Haskell files produced by---  C->Haskell for binding to C library interfaces.  It exports all of the---  low-level FFI (language-independent plus the C-specific parts) together---  with the C->HS-specific higher-level marshalling routines.-----module Foreign.CUDA.Internal.C2HS (--  -- * Composite marshalling functions-  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,-  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,-  peekArrayWith,--  -- * Conditional results using 'Maybe'-  nothingIf, nothingIfNull,--  -- * Bit masks-  combineBitMasks, containsBitMask, extractBitMasks,--  -- * Conversion between C and Haskell types-  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where---import Foreign-import Foreign.C-import Control.Monad                                    ( liftM )----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv :: String -> (CStringLen -> IO a) -> IO a-withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)--peekCStringLenIntConv :: CStringLen -> IO String-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv :: (Storable b, Integral a, Integral b) => a -> (Ptr b -> IO c) -> IO c-withIntConv = with . cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c-withFloatConv = with . cFloatConv--peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b-peekIntConv = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b-peekFloatConv = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool = liftM toBool . peek----- Read and marshal array elements-----peekArrayWith :: Storable a => (a -> b) -> Int -> Ptr a -> IO [b]-peekArrayWith f n p = map f `fmap` peekArray n p----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum = with . cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum = liftM cToEnum . peek---{---- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where-  sizeOf    _ = sizeOf    (undefined :: Ptr ())-  alignment _ = alignment (undefined :: Ptr ())--  peek p = do-             ptr <- peek (castPtr p)-             if ptr == nullPtr-               then return Nothing-               else liftM Just $ peek ptr--  poke p v = do-               ptr <- case v of-                        Nothing -> return nullPtr-                        Just v' -> new v'-               poke (castPtr p) ptr--}----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,---   ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some---   other domain----nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Num b, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Num a, Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm-                            in-                            bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when---   combined yield the bit pattern, instead all contained bit masks are---   produced.----extractBitMasks :: (Num a, Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits =-  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----{-# INLINE [1] cIntConv #-}-cIntConv :: (Integral a, Integral b) => a -> b-cIntConv  = fromIntegral---- |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- #-}---- |Obtain C value from Haskell 'Bool'.----{-# INLINE [1] cFromBool #-}-cFromBool :: Num a => Bool -> a-cFromBool  = fromBool---- |Obtain Haskell 'Bool' from C value.----{-# INLINE [1] cToBool #-}-cToBool :: (Eq a, Num a) => a -> Bool-cToBool  = toBool---- |Convert a C enumeration to Haskell.----{-# INLINE [1] cToEnum #-}-cToEnum :: (Integral i, Enum e) => i -> e-cToEnum  = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----{-# INLINE [1] cFromEnum #-}-cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum  = cIntConv . fromEnum-
− Foreign/CUDA/Ptr.hs 
@@ -1,184 +0,0 @@-{-# LANGUAGE BangPatterns #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Ptr--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Data pointers on the host and device. These can be shared freely between the--- CUDA runtime and Driver APIs.--------------------------------------------------------------------------------------module Foreign.CUDA.Ptr (--  -- * Device pointers-  DevicePtr(..),-  withDevicePtr,-  devPtrToWordPtr,-  wordPtrToDevPtr,-  nullDevPtr,-  castDevPtr,-  plusDevPtr,-  alignDevPtr,-  minusDevPtr,-  advanceDevPtr,--  -- * Host pointers-  HostPtr(..),-  withHostPtr,-  nullHostPtr,-  castHostPtr,-  plusHostPtr,-  alignHostPtr,-  minusHostPtr,-  advanceHostPtr,--) where---- friends-import Foreign.CUDA.Types---- system-import Foreign.Ptr-import Foreign.Storable-------------------------------------------------------------------------------------- Device Pointer------------------------------------------------------------------------------------- |--- 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.----{-# INLINEABLE withDevicePtr #-}-withDevicePtr :: DevicePtr a -> (Ptr a -> IO b) -> IO b-withDevicePtr !p !f = f (useDevicePtr p)---- |--- Return a unique handle associated with the given device pointer----{-# INLINEABLE devPtrToWordPtr #-}-devPtrToWordPtr :: DevicePtr a -> WordPtr-devPtrToWordPtr = ptrToWordPtr . useDevicePtr---- |--- Return a device pointer from the given handle----{-# INLINEABLE wordPtrToDevPtr #-}-wordPtrToDevPtr :: WordPtr -> DevicePtr a-wordPtrToDevPtr = DevicePtr . wordPtrToPtr---- |--- The constant 'nullDevPtr' contains the distinguished memory location that is--- not associated with a valid memory location----{-# INLINEABLE nullDevPtr #-}-nullDevPtr :: DevicePtr a-nullDevPtr =  DevicePtr nullPtr---- |--- Cast a device pointer from one type to another----{-# INLINEABLE castDevPtr #-}-castDevPtr :: DevicePtr a -> DevicePtr b-castDevPtr (DevicePtr !p) = DevicePtr (castPtr p)---- |--- Advance the pointer address by the given offset in bytes.----{-# INLINEABLE plusDevPtr #-}-plusDevPtr :: DevicePtr a -> Int -> DevicePtr a-plusDevPtr (DevicePtr !p) !d = DevicePtr (p `plusPtr` d)---- |--- Given an alignment constraint, align the device pointer to the next highest--- address satisfying the constraint----{-# INLINEABLE alignDevPtr #-}-alignDevPtr :: DevicePtr a -> Int -> DevicePtr a-alignDevPtr (DevicePtr !p) !i = DevicePtr (p `alignPtr` i)---- |--- Compute the difference between the second and first argument. This fulfils--- the relation------ > p2 == p1 `plusDevPtr` (p2 `minusDevPtr` p1)----{-# INLINEABLE minusDevPtr #-}-minusDevPtr :: DevicePtr a -> DevicePtr a -> Int-minusDevPtr (DevicePtr !a) (DevicePtr !b) = a `minusPtr` b---- |--- Advance a pointer into a device array by the given number of elements----{-# INLINEABLE advanceDevPtr #-}-advanceDevPtr :: Storable a => DevicePtr a -> Int -> DevicePtr a-advanceDevPtr = doAdvance undefined-  where-    doAdvance :: Storable a' => a' -> DevicePtr a' -> Int -> DevicePtr a'-    doAdvance x !p !i = p `plusDevPtr` (i * sizeOf x)-------------------------------------------------------------------------------------- Host Pointer------------------------------------------------------------------------------------- |--- Apply an IO action to the memory reference living inside the host pointer--- object. All uses of the pointer should be inside the 'withHostPtr' bracket.----{-# INLINEABLE withHostPtr #-}-withHostPtr :: HostPtr a -> (Ptr a -> IO b) -> IO b-withHostPtr !p !f = f (useHostPtr p)----- |--- The constant 'nullHostPtr' contains the distinguished memory location that is--- not associated with a valid memory location----{-# INLINEABLE nullHostPtr #-}-nullHostPtr :: HostPtr a-nullHostPtr =  HostPtr nullPtr---- |--- Cast a host pointer from one type to another----{-# INLINEABLE castHostPtr #-}-castHostPtr :: HostPtr a -> HostPtr b-castHostPtr (HostPtr !p) = HostPtr (castPtr p)---- |--- Advance the pointer address by the given offset in bytes----{-# INLINEABLE plusHostPtr #-}-plusHostPtr :: HostPtr a -> Int -> HostPtr a-plusHostPtr (HostPtr !p) !d = HostPtr (p `plusPtr` d)---- |--- Given an alignment constraint, align the host pointer to the next highest--- address satisfying the constraint----{-# INLINEABLE alignHostPtr #-}-alignHostPtr :: HostPtr a -> Int -> HostPtr a-alignHostPtr (HostPtr !p) !i = HostPtr (p `alignPtr` i)---- |--- Compute the difference between the second and first argument----{-# INLINEABLE minusHostPtr #-}-minusHostPtr :: HostPtr a -> HostPtr a -> Int-minusHostPtr (HostPtr !a) (HostPtr !b) = a `minusPtr` b---- |--- Advance a pointer into a host array by a given number of elements----{-# INLINEABLE advanceHostPtr #-}-advanceHostPtr :: Storable a => HostPtr a -> Int -> HostPtr a-advanceHostPtr = doAdvance undefined-  where-    doAdvance :: Storable a' => a' -> HostPtr a' -> Int -> HostPtr a'-    doAdvance x !p !i = p `plusHostPtr` (i * sizeOf x)-
− Foreign/CUDA/Runtime.hs 
@@ -1,28 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime--- Copyright : [2009..2014] 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-
− 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..2014] 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-
− Foreign/CUDA/Runtime/Error.chs 
@@ -1,116 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE DeriveDataTypeable       #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime.Error--- Copyright : [2009..2014] 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---- 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----{# fun pure unsafe cudaGetErrorString as describe-    { cFromEnum `Status' } -> `String' #}------ Logically, this must be a pure function, returning a pointer to a statically--- defined string constant.-------- |--- 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)-
− 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..2014] 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 #}-
− 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..2014] 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-
− Foreign/CUDA/Runtime/Marshal.chs 
@@ -1,648 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE EmptyDataDecls           #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell          #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime.Marshal--- Copyright : [2009..2014] 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-
− Foreign/CUDA/Runtime/Stream.chs 
@@ -1,115 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime.Stream--- Copyright : [2009..2014] 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-
− Foreign/CUDA/Runtime/Texture.chs 
@@ -1,203 +0,0 @@-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime.Texture--- Copyright : [2009..2014] 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)-
− Foreign/CUDA/Runtime/Utils.chs 
@@ -1,49 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Runtime.Utils--- Copyright : [2009..2014] Trevor L. McDonell--- License   : BSD------ Utility functions--------------------------------------------------------------------------------------module Foreign.CUDA.Runtime.Utils (runtimeVersion, driverVersion)-  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 #}-
− Foreign/CUDA/Types.chs 
@@ -1,155 +0,0 @@-{-# LANGUAGE BangPatterns   #-}-{-# LANGUAGE CPP            #-}-{-# LANGUAGE EmptyDataDecls #-}-#ifdef USE_EMPTY_CASE-{-# LANGUAGE EmptyCase      #-}-#endif------------------------------------------------------------------------------------ |--- Module    : Foreign.CUDA.Types--- Copyright : [2009..2014] 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(..), StreamPriority, StreamFlag,-  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 }-    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---- |--- Possible option flags for stream initialisation. Dummy instance until the API--- exports actual option values.----data StreamFlag-instance Enum StreamFlag where-#ifdef USE_EMPTY_CASE-  toEnum   x = case x of {}-  fromEnum x = case x of {}-#endif---- |--- The main execution stream. No operations overlap with operations in the--- default stream.----{-# INLINE defaultStream #-}-defaultStream :: Stream-defaultStream = Stream nullPtr-
Setup.hs view
@@ -1,18 +1,32 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-} +-- 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.Parse import Distribution.Simple import Distribution.Simple.BuildPaths import Distribution.Simple.Command-import Distribution.Simple.Program.Db import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PreProcess                               hiding ( ppC2hs ) import Distribution.Simple.Program+import Distribution.Simple.Program.Db+import Distribution.Simple.Program.Find import Distribution.Simple.Setup-import Distribution.Simple.Utils+import Distribution.Simple.Utils                                    hiding ( isInfixOf ) import Distribution.System import Distribution.Verbosity +#if MIN_VERSION_Cabal(1,25,0)+import Distribution.PackageDescription.PrettyPrint+import Distribution.Version+#endif+ import Control.Exception import Control.Monad import Data.Function@@ -473,9 +487,14 @@ findProgram :: Verbosity -> FilePath -> IO (Maybe FilePath) findProgram verbosity prog = do   result <- findProgramOnSearchPath verbosity defaultProgramSearchPath prog-  case result of-    Nothing       -> return Nothing-    Just (path,_) -> return (Just path)+#if MIN_VERSION_Cabal(1,25,0)+  return (fmap fst result)+#else+  $( case withinRange cabalVersion (orLaterVersion (Version [1,24] [])) of+       True  -> [| return (fmap fst result) |]+       False -> [| return result |]+    )+#endif   -- Reads user-provided `cuda.buildinfo` if present, otherwise loads `cuda.buildinfo.generated`@@ -506,8 +525,13 @@ -- -- Everything below copied from Distribution.Simple.PreProcess --+#if MIN_VERSION_Cabal(1,25,0)+ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor+ppC2hs bi lbi _clbi+#else ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor ppC2hs bi lbi+#endif     = PreProcessor {         platformIndependent = False,         runPreProcessor     = \(inBaseDir, inRelativeFile)@@ -541,7 +565,15 @@ -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all the other -- compilers. Check if that's really what they want. versionInt :: Version -> String-versionInt (Version { versionBranch = [] })      = "1"-versionInt (Version { versionBranch = [n] })     = show n-versionInt (Version { versionBranch = n1:n2:_ }) = printf "%d%02d" n1 n2+versionInt v =+  case versionBranch v of+    []      -> "1"+    [n]     -> show n+    n1:n2:_ -> printf "%d%02d" n1 n2+++#if MIN_VERSION_Cabal(1,25,0)+versionBranch :: Version -> [Int]+versionBranch = versionNumbers+#endif
cuda.cabal view
@@ -1,5 +1,5 @@ Name:                   cuda-Version:                0.7.5.0+Version:                0.7.5.1 Synopsis:               FFI binding to the CUDA interface for programming NVIDIA GPUs Description:     The CUDA library provides a direct, general purpose C-like SPMD programming@@ -24,10 +24,10 @@     .     [/NOTES:/]     .-    The setup script for this package requires at least Cabal-1.24. To upgrade,+    The setup script for this package requires at least Cabal-1.22. To upgrade,     execute one of:     .-    * cabal users: @cabal install Cabal --constraint="Cabal >= 1.24"@+    * cabal users: @cabal install Cabal --constraint="Cabal >= 1.22"@     .     * stack users: @stack setup --upgrade-cabal@     .@@ -52,7 +52,7 @@ Homepage:               https://github.com/tmcdonell/cuda Bug-reports:            https://github.com/tmcdonell/cuda/issues Category:               Foreign-Cabal-version:          >= 1.24+Cabal-version:          >= 1.22 Tested-with:            GHC >= 7.6  Build-type:             Custom@@ -67,11 +67,12 @@ custom-setup   setup-depends:       base              >= 4.6-    , Cabal             >= 1.24+    , Cabal             >= 1.22     , directory         >= 1.0     , filepath          >= 1.0  Library+  hs-source-dirs:       src   Exposed-Modules:      Foreign.CUDA                         Foreign.CUDA.Ptr                         Foreign.CUDA.Types@@ -110,6 +111,7 @@                         Foreign.CUDA.Driver.Utils    Other-modules:        Foreign.CUDA.Internal.C2HS+                        Text.Show.Describe    Include-dirs:         .   C-sources:            cbits/stubs.c@@ -147,7 +149,7 @@ source-repository this     type:               git     location:           https://github.com/tmcdonell/cuda-    tag:                0.7.5.0+    tag:                0.7.5.1  -- vim: nospell
examples/src/deviceQueryDrv/DeviceQuery.hs view
@@ -80,11 +80,7 @@   in   putStrLn . render     $ hang table 4-    $ case computeMode of-        Default          -> text "Multiple host threads can use the device simultaneously"-        Exclusive        -> text "Only one host thread in a process is able to use this device"-        Prohibited       -> text "No host thread can use this device"-        ExclusiveProcess -> text "Multiple threads in one process can use the device simultaneously"+    $ text (describe computeMode)   showFreq :: Integral i => i -> String
+ src/Foreign/CUDA.hs view
@@ -0,0 +1,19 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA+-- Copyright : [2009..2014] 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
@@ -0,0 +1,20 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Analysis+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Meta-module exporting CUDA analysis routines+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Analysis (++  module Foreign.CUDA.Analysis.Device,+  module Foreign.CUDA.Analysis.Occupancy++) where++import Foreign.CUDA.Analysis.Device+import Foreign.CUDA.Analysis.Occupancy+
+ src/Foreign/CUDA/Analysis/Device.chs view
@@ -0,0 +1,196 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Analysis.Device+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Common device functions+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Analysis.Device (++    Compute(..), ComputeMode(..),+    DeviceProperties(..), DeviceResources(..), Allocation(..), PCI(..),+    deviceResources,+    describe++) where++#include "cbits/stubs.h"++import Data.Int+import Text.Show.Describe++import Debug.Trace+++-- |+-- The compute mode the device is currently in+--+{# enum CUcomputemode as ComputeMode+    { underscoreToCase }+    with prefix="CU_COMPUTEMODE" deriving (Eq, Show) #}++instance Describe ComputeMode where+  describe Default          = "Multiple contexts are allowed on the device simultaneously"+#if CUDA_VERSION < 8000+  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"+  describe ExclusiveProcess = "Only one context used by a single process can be present on this device at a time"+++-- |+-- GPU compute capability, major and minor revision number respectively.+--+data Compute = Compute !Int !Int+  deriving Eq++instance Show Compute where+  show (Compute major minor) = show major ++ "." ++ show minor++instance Ord Compute where+  compare (Compute m1 n1) (Compute m2 n2) =+    case compare m1 m2 of+      EQ -> compare n1 n2+      x  -> x++{--+cap :: Int -> Int -> Double+cap a 0 = fromIntegral a+cap a b = let a' = fromIntegral a in+            let b' = fromIntegral b in+            a' + b' / max 10 (10^ ((ceiling . logBase 10) b' :: Int))+--}++-- |+-- The properties of a compute device+--+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+#if CUDA_VERSION >= 4000+  , 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+#if CUDA_VERSION >= 3000+  , 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+#if CUDA_VERSION >= 4000+  , 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+#if CUDA_VERSION >= 3000+  , 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+#endif+  , 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+#endif+#if CUDA_VERSION >= 5050+  , 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+#endif+  }+  deriving (Show)+++data PCI = PCI+  {+    busID       :: !Int,                -- ^ PCI bus ID of the device+    deviceID    :: !Int,                -- ^ PCI device ID+    domainID    :: !Int                 -- ^ PCI domain ID+  }+  deriving (Show)+++-- GPU Hardware Resources+--+data Allocation      = Warp | Block+data DeviceResources = DeviceResources+  {+    threadsPerWarp      :: !Int,        -- ^ Warp size+    threadsPerMP        :: !Int,        -- ^ Maximum number of in-flight threads on a multiprocessor+    threadBlocksPerMP   :: !Int,        -- ^ Maximum number of thread blocks resident on a multiprocessor+    warpsPerMP          :: !Int,        -- ^ Maximum number of in-flight warps per multiprocessor+    coresPerMP          :: !Int,        -- ^ Number of SIMD arithmetic units per multiprocessor+    sharedMemPerMP      :: !Int,        -- ^ Total amount of shared memory per multiprocessor (bytes)+    sharedMemAllocUnit  :: !Int,        -- ^ Shared memory allocation unit size (bytes)+    regFileSize         :: !Int,        -- ^ Total number of registers in a multiprocessor+    regAllocUnit        :: !Int,        -- ^ Register allocation unit size+    regAllocWarp        :: !Int,        -- ^ Register allocation granularity for warps+    regPerThread        :: !Int,        -- ^ Maximum number of registers per thread+    allocation          :: !Allocation  -- ^ How multiprocessor resources are divided+  }+++-- |+-- Extract some additional hardware resource limitations for a given device.+--+deviceResources :: DeviceProperties -> DeviceResources+deviceResources = resources . computeCapability+  where+    -- This is mostly extracted from tables in the CUDA occupancy calculator.+    --+    resources compute = case compute of+      Compute 1 0 -> DeviceResources 32  768  8 24   8  16384 512   8192 256 2 124 Block  -- Tesla G80+      Compute 1 1 -> DeviceResources 32  768  8 24   8  16384 512   8192 256 2 124 Block  -- Tesla G8x+      Compute 1 2 -> DeviceResources 32 1024  8 32   8  16384 512  16384 512 2 124 Block  -- Tesla G9x+      Compute 1 3 -> DeviceResources 32 1024  8 32   8  16384 512  16384 512 2 124 Block  -- Tesla GT200+      Compute 2 0 -> DeviceResources 32 1536  8 48  32  49152 128  32768  64 2  63 Warp   -- Fermi GF100+      Compute 2 1 -> DeviceResources 32 1536  8 48  48  49152 128  32768  64 2  63 Warp   -- Fermi GF10x+      Compute 3 0 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4  63 Warp   -- Kepler GK10x+      Compute 3 2 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4 255 Warp   -- Jetson TK1+      Compute 3 5 -> DeviceResources 32 2048 16 64 192  49152 256  65536 256 4 255 Warp   -- Kepler GK11x+      Compute 3 7 -> DeviceResources 32 2048 16 64 192 114688 256 131072 256 4 266 Warp   -- Kepler GK21x+      Compute 5 0 -> DeviceResources 32 2048 32 64 128  65536 256  65536 256 4 255 Warp   -- Maxwell GM10x+      Compute 5 2 -> DeviceResources 32 2048 32 64 128  98304 256  65536 256 4 255 Warp   -- Maxwell GM20x+      Compute 5 3 -> DeviceResources 32 2048 32 64 128  65536 256  65536 256 4 255 Warp   -- Maxwell GM20B+      Compute 6 0 -> DeviceResources 32 2048 32 64  64  65536 256  65536 256 4 255 Warp   -- Pascal GP100 (?)+      Compute 6 1 -> DeviceResources 32 2048 32 64 128  98304 256  65536 256 4 255 Warp   -- Pascal GP10x (?)+      Compute 6 2 -> DeviceResources 32 2048 32 64 128  65536 256  65536 256 4 255 Warp   -- Pascal (?)++      -- 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.+      --+      -- This is slightly dodgy as the warning message is coming from pure code.+      -- 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" ]+
+ src/Foreign/CUDA/Analysis/Occupancy.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE BangPatterns #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Analysis.Occupancy+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Occupancy calculations for CUDA kernels+--+-- <http://developer.download.nvidia.com/compute/cuda/3_0/sdk/docs/CUDA_Occupancy_calculator.xls>+--+-- /Determining Registers Per Thread and Shared Memory Per Block/+--+-- To determine the number of registers used per thread in your kernel, simply+-- compile the kernel code using the option+--+-- > --ptxas-options=-v+--+-- to nvcc.  This will output information about register, local memory, shared+-- memory, and constant memory usage for each kernel in the @.cu@ file.+-- Alternatively, you can compile with the @-cubin@ option to nvcc.  This will+-- generate a @.cubin@ file, which you can open in a text editor.  Look for the+-- @code@ section with your kernel's name.  Within the curly braces (@{ ... }@)+-- for that code block, you will see a line with @reg = X@, where @x@ is the+-- number of registers used by your kernel.  You can also see the amount of+-- shared memory used as @smem = Y@.  However, if your kernel declares any+-- external shared memory that is allocated dynamically, you will need to add+-- the number in the @.cubin@ file to the amount you dynamically allocate at run+-- time to get the correct shared memory usage.+--+-- /Notes About Occupancy/+--+-- Higher occupancy does not necessarily mean higher performance.  If a kernel+-- is not bandwidth bound, then increasing occupancy will not necessarily+-- increase performance.  If a kernel invocation is already running at least one+-- thread block per multiprocessor in the GPU, and it is bottlenecked by+-- computation and not by global memory accesses, then increasing occupancy may+-- have no effect.  In fact, making changes just to increase occupancy can have+-- other effects, such as additional instructions, spills to local memory (which+-- is off chip), divergent branches, etc.  As with any optimization, you should+-- experiment to see how changes affect the *wall clock time* of the kernel+-- execution.  For bandwidth bound applications, on the other hand, increasing+-- occupancy can help better hide the latency of memory accesses, and therefore+-- improve performance.+--+--------------------------------------------------------------------------------+++module Foreign.CUDA.Analysis.Occupancy (++    Occupancy(..),+    occupancy, optimalBlockSize, optimalBlockSizeOf, maxResidentBlocks,+    incPow2, incWarp, decPow2, decWarp++) where++import Data.Ord+import Data.List++import Foreign.CUDA.Analysis.Device+++-- GPU Occupancy per multiprocessor+--+data Occupancy = Occupancy+  {+    activeThreads      :: !Int,         -- ^ Active threads per multiprocessor+    activeThreadBlocks :: !Int,         -- ^ Active thread blocks per multiprocessor+    activeWarps        :: !Int,         -- ^ Active warps per multiprocessor+    occupancy100       :: !Double       -- ^ Occupancy of each multiprocessor (percent)+  }+  deriving (Eq, Ord, Show)+++-- |+-- Calculate occupancy data for a given GPU and kernel resource usage+--+{-# INLINEABLE occupancy #-}+occupancy+    :: DeviceProperties -- ^ Properties of the card in question+    -> Int              -- ^ Threads per block+    -> Int              -- ^ Registers per thread+    -> Int              -- ^ Shared memory per block (bytes)+    -> Occupancy+occupancy !dev !thds !regs !smem+  = Occupancy at ab aw oc+  where+    at = ab * thds+    aw = ab * warps+    ab = minimum [limitWarpBlock, limitRegMP, limitSMemMP]+    oc = 100 * fromIntegral aw / fromIntegral (warpsPerMP gpu)++    regs' = 1 `max` regs+    smem' = 1 `max` smem++    ceiling'      = ceiling :: Double -> Int+    ceilingBy x s = s * ceiling' (fromIntegral x / fromIntegral s)++    -- Physical resources+    --+    gpu = deviceResources dev++    -- Allocation per thread block+    --+    warps     = ceiling' (fromIntegral thds / fromIntegral (threadsPerWarp gpu))+    sharedMem = ceilingBy smem' (sharedMemAllocUnit gpu)+    registers = case allocation gpu of+      Block -> (warps `ceilingBy` regAllocWarp gpu * regs' * threadsPerWarp gpu) `ceilingBy` regAllocUnit gpu+      Warp  -> warps * ceilingBy (regs' * threadsPerWarp gpu) (regAllocUnit gpu)++    -- Maximum thread blocks per multiprocessor+    --+    limitWarpBlock = threadBlocksPerMP gpu `min` (warpsPerMP gpu     `div` warps)+    limitRegMP     = threadBlocksPerMP gpu `min` (regFileSize gpu    `div` registers)+    limitSMemMP    = threadBlocksPerMP gpu `min` (sharedMemPerMP gpu `div` sharedMem)+++-- |+-- Optimise multiprocessor occupancy as a function of thread block size and+-- resource usage. This returns the smallest satisfying block size in increments+-- of a single warp.+--+{-# INLINEABLE optimalBlockSize #-}+optimalBlockSize+    :: DeviceProperties         -- ^ Architecture to optimise for+    -> (Int -> Int)             -- ^ Register count as a function of thread block size+    -> (Int -> Int)             -- ^ Shared memory usage (bytes) as a function of thread block size+    -> (Int, Occupancy)+optimalBlockSize dev = optimalBlockSizeOf dev (decWarp dev)+++-- |+-- As 'optimalBlockSize', but with a generator that produces the specific thread+-- block sizes that should be tested. The generated list can produce values in+-- any order, but the last satisfying block size will be returned. Hence, values+-- should be monotonically decreasing to return the smallest block size yielding+-- maximum occupancy, and vice-versa.+--+{-# INLINEABLE optimalBlockSizeOf #-}+optimalBlockSizeOf+    :: DeviceProperties         -- ^ Architecture to optimise for+    -> [Int]                    -- ^ Thread block sizes to consider+    -> (Int -> Int)             -- ^ Register count as a function of thread block size+    -> (Int -> Int)             -- ^ Shared memory usage (bytes) as a function of thread block size+    -> (Int, Occupancy)+optimalBlockSizeOf !dev !threads !freg !fsmem+  = maximumBy (comparing (occupancy100 . snd))+  $ [ (t, occupancy dev t (freg t) (fsmem t)) | t <- threads ]+++-- | Increments in powers-of-two, over the range of supported thread block sizes+-- for the given device.+--+{-# INLINEABLE incPow2 #-}+incPow2 :: DeviceProperties -> [Int]+incPow2 !dev = map ((2::Int)^) [lb, lb+1 .. ub]+  where+    round' = round :: Double -> Int+    lb     = round' . logBase 2 . fromIntegral $ warpSize dev+    ub     = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev++-- | Decrements in powers-of-two, over the range of supported thread block sizes+-- for the given device.+--+{-# INLINEABLE decPow2 #-}+decPow2 :: DeviceProperties -> [Int]+decPow2 !dev = map ((2::Int)^) [ub, ub-1 .. lb]+  where+    round' = round :: Double -> Int+    lb     = round' . logBase 2 . fromIntegral $ warpSize dev+    ub     = round' . logBase 2 . fromIntegral $ maxThreadsPerBlock dev++-- | Decrements in the warp size of the device, over the range of supported+-- thread block sizes.+--+{-# INLINEABLE decWarp #-}+decWarp :: DeviceProperties -> [Int]+decWarp !dev = [block, block-warp .. warp]+  where+    !warp  = warpSize dev+    !block = maxThreadsPerBlock dev++-- | Increments in the warp size of the device, over the range of supported+-- thread block sizes.+--+{-# INLINEABLE incWarp #-}+incWarp :: DeviceProperties -> [Int]+incWarp !dev = [warp, 2*warp .. block]+  where+    warp  = warpSize dev+    block = maxThreadsPerBlock dev+++-- |+-- Determine the maximum number of CTAs that can be run simultaneously for a+-- given kernel / device combination.+--+{-# INLINEABLE maxResidentBlocks #-}+maxResidentBlocks+  :: DeviceProperties   -- ^ Properties of the card in question+  -> Int                -- ^ Threads per block+  -> Int                -- ^ Registers per thread+  -> Int                -- ^ Shared memory per block (bytes)+  -> Int                -- ^ Maximum number of resident blocks+maxResidentBlocks !dev !thds !regs !smem =+  multiProcessorCount dev * activeThreadBlocks (occupancy dev thds regs smem)+
+ src/Foreign/CUDA/Driver.hs view
@@ -0,0 +1,238 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- This module defines an interface to the CUDA driver API. The Driver API+-- is a lower-level interface to CUDA devices than that provided by the+-- Runtime API. Using the Driver API, the programmer must deal explicitly+-- with operations such as initialisation, context management, and loading+-- (kernel) modules. Although more difficult to use initially, the Driver+-- API provides more control over how CUDA is used. Furthermore, since it+-- does not require compiling and linking the program with 'nvcc', the+-- Driver API provides better inter-language compatibility.+--+-- The following is a short tutorial on using the Driver API. The steps can+-- be copied into a file, or run directly in @ghci@, in which case @ghci@+-- should be launched with the option @-fno-ghci-sandbox@. This is because+-- CUDA maintains CPU-local state, so operations should always be run from+-- a bound thread.+--+--+-- [/Using the Driver API/]+--+-- Before any operation can be performed, the Driver API must be+-- initialised:+--+-- >>> import Foreign.CUDA.Driver+-- >>> initialise []+--+-- 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+-- 'props'. The number of available CUDA-capable devices is given via+-- 'count'. For example:+--+-- >>> count+-- 1+-- >>> dev0 <- device 0+-- >>> props dev0+-- DeviceProperties {deviceName = "GeForce GT 650M", computeCapability = 3.0, ...}+--+-- This package also includes the executable 'nvidia-device-query', which when+-- executed displays the key properties of all available devices. See+-- "Foreign.CUDA.Driver.Device" for additional operations to query the+-- capabilities or status of a device.+--+-- Once you have chosen a device to use, the next step is to create a CUDA+-- context. A context is associated with a particular device, and all+-- operations, such as memory allocation and kernel execution, take place+-- with respect to that context. For example, to 'create' a new execution+-- context on CUDA device 0:+--+-- >>> ctx <- create dev0 []+--+-- The second argument is a set of 'ContextFlag's which control how the+-- context behaves in various situations, for example, whether or not the+-- CPU should actively spin when waiting for results from the GPU+-- ('SchedSpin'), or to yield control to other threads instead+-- ('SchedYield').+--+-- The newly created context is now the /active/ context, and all+-- subsequent operations take place within that context. More than one+-- context can be created per device, but resources, such as memory+-- allocated in the GPU, are unique to each context. The module+-- "Foreign.CUDA.Driver.Context" contains operations for managing multiple+-- contexts. Some devices allow data to be shared between contexts without+-- copying, see "Foreign.CUDA.Driver.Context.Peer" for more information.+--+-- Once the context is no longer needed, it should be 'destroy'ed in order+-- to free up any resources that were allocated to it.+--+-- >>> destroy ctx+--+-- Each device also has a unique context which is used by the Runtime API.+-- This context can be accessed with the module+-- "Foreign.CUDA.Driver.Context.Primary".+--+--+-- [/Executing kernels onto the GPU/]+--+-- Once the Driver API is initialised and an execution context is created+-- on the GPU, we can begin to interact with it.+--+-- At an example, we'll step through executing the CUDA equivalent of the+-- following Haskell function, which element-wise adds the elements of two+-- arrays:+--+-- >>> vecAdd xs ys = zipWith (+) xs ys+--+-- The following CUDA kernel can be used to implement this on the GPU:+--+-- > extern "C" __global__ void vecAdd(float *xs, float *ys, float *zs, int N)+-- > {+-- >     int ix = blockIdx.x * blockDim.x + threadIdx.x;+-- >+-- >     if ( ix < N ) {+-- >         zs[ix] = xs[ix] + ys[ix];+-- >     }+-- > }+--+-- Here, the @__global__@ keyword marks the function as a kernel that+-- should be computed on the GPU in data parallel. When we execute this+-- function on the GPU, (at least) /N/ threads will execute /N/ individual+-- instances of the kernel function @vecAdd@. Each thread will operate on+-- a single element of each input array to create a single value in the+-- result. See the CUDA programming guide for more details.+--+-- We can save this to a file @vector_add.cu@, and compile it using @nvcc@+-- into a form that we can then load onto the GPU and execute:+--+-- > $ nvcc --ptx vector_add.cu+--+-- The module "Foreign.CUDA.Driver.Module" contains functions for loading+-- the resulting .ptx file (or .cubin files) into the running program.+--+-- >>> mdl <- loadFile "vector_add.ptx"+--+-- Once finished with the module, it is also a good idea to 'unload' it.+--+-- Modules may export kernel functions, global variables, and texture+-- references. Before we can execute our function, we need to look it up in+-- the module by name.+--+-- >>> vecAdd <- getFun mdl "vecAdd"+--+-- Given this reference to our kernel function, we are almost ready to+-- execute it on the device using 'launchKernel', but first, we must create+-- some data that we can execute the function on.+--+--+-- [/Transferring data to and from the GPU/]+--+-- GPUs typically have their own memory which is separate from the CPU's+-- memory, and we need to explicitly copy data back and forth between these+-- two regions. The module "Foreign.CUDA.Driver.Marshal" provides functions+-- for allocating memory on the GPU, and copying data between the CPU and+-- GPU, as well as directly between multiple GPUs.+--+-- For simplicity, we'll use standard Haskell lists for our input and+-- output data structure. Note however that this will have significantly+-- lower effective bandwidth than reading a single contiguous region of+-- memory, so for most practical purposes you will want to use some kind of+-- unboxed array.+--+-- >>> let xs = [1..1024]   :: [Float]+-- >>> let ys = [2,4..2048] :: [Float]+--+-- In CUDA, like C, all memory management is explicit, and arrays on the+-- device must be explicitly allocated and freed. As mentioned previously,+-- data transfer is also explicit. However, we do provide convenience+-- functions for combined allocation and marshalling, as well as bracketed+-- operations.+--+-- >>> xs_dev <- newListArray xs+-- >>> ys_dev <- newListArray ys+-- >>> zs_dev <- mallocArray 1024 :: IO (DevicePtr Float)+--+-- After executing the kernel (see next section), we transfer the result+-- back to the host, and free the memory that was allocated on the GPU.+--+-- >>> zs <- peekListArray 1024 zs_dev+-- >>> free xs_dev+-- >>> free ys_dev+-- >>> free zs_dev+--+--+-- [/Piecing it all together/]+--+-- Finally, we have everything in place to execute our operation on the+-- GPU. Launching a kernel on the GPU consists of creating many threads on+-- the GPU which all execute the same function, and each thread has+-- a unique identifier in the grid/block hierarchy which can be used to+-- identify exactly which element this thread should process (the+-- @blockIdx@ and @threadIdx@ parameters that we saw earlier,+-- respectively).+--+-- To execute our function, we will use a grid of 4 blocks, each containing+-- 256 threads. Thus, a total of 1024 threads will be launched, which will+-- each compute a single element of the output array (recall that our input+-- arrays each have 1024 elements). The module+-- "Foreign.CUDA.Analysis.Occupancy" contains functions to help determine+-- the ideal thread block size for a given kernel and GPU combination.+--+-- >>> launchKernel vecAdd (4,1,1) (256,1,1) 0 Nothing [VArg xs_dev, VArg ys_dev, VArg zs_dev, IArg 1024]+--+-- Note that kernel execution is asynchronous, so we should also wait for+-- the operation to complete before attempting to read the results back.+--+-- >>> sync+--+-- And that's it!+--+--+-- [/Next steps/]+--+-- As mentioned at the end of the previous section, kernels on the GPU are+-- executed asynchronously with respect to the host, and other operations+-- such as data transfers can also be executed asynchronously. This allows+-- the CPU to continue doing other work while the GPU is busy.+-- 'Foreign.CUDA.Driver.Event.Event's can be used to check whether an+-- operation has completed yet.+--+-- It is also possible to execute multiple kernels or data transfers+-- concurrently with each other, by assigning those operations to different+-- execution 'Foreign.CUDA.Driver.Stream.Stream's. Used in conjunction with+-- 'Foreign.CUDA.Driver.Event.Event's, operations will be scheduled+-- efficiently only once all dependencies (in the form of+-- 'Foreign.CUDA.Driver.Event.Event's) have been cleared.+--+-- See "Foreign.CUDA.Driver.Event" and "Foreign.CUDA.Driver.Stream" for+-- more information on this topic.+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver (++  module Foreign.CUDA.Ptr,+  module Foreign.CUDA.Driver.Context,+  module Foreign.CUDA.Driver.Device,+  module Foreign.CUDA.Driver.Error,+  module Foreign.CUDA.Driver.Exec,+  module Foreign.CUDA.Driver.Marshal,+  module Foreign.CUDA.Driver.Module,+  module Foreign.CUDA.Driver.Utils++) where++import Foreign.CUDA.Ptr+import Foreign.CUDA.Driver.Context      hiding ( useContext, device )+import Foreign.CUDA.Driver.Device       hiding ( useDevice )+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Exec+import Foreign.CUDA.Driver.Marshal      hiding ( useDeviceHandle, peekDeviceHandle )+import Foreign.CUDA.Driver.Module+import Foreign.CUDA.Driver.Utils+
+ src/Foreign/CUDA/Driver/Context.hs view
@@ -0,0 +1,23 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Context+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- Context management for low-level driver interface+--+--------------------------------------------------------------------------------+++module Foreign.CUDA.Driver.Context (++  module Foreign.CUDA.Driver.Context.Base,+  module Foreign.CUDA.Driver.Context.Config,+  module Foreign.CUDA.Driver.Context.Peer,++) where++import Foreign.CUDA.Driver.Context.Base+import Foreign.CUDA.Driver.Context.Config+import Foreign.CUDA.Driver.Context.Peer+
+ src/Foreign/CUDA/Driver/Context/Base.chs view
@@ -0,0 +1,241 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase                #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Context.Base+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- Context management for the low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Context.Base (++  -- * Context Management+  Context(..), ContextFlag(..),+  create, destroy, device, pop, push, sync, get, set,++  -- Deprecated in CUDA-4.0+  attach, detach,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Device                       ( Device(..) )+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+import Control.Monad                                    ( liftM )+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A device context+--+newtype Context = Context { useContext :: {# type CUcontext #}}+  deriving (Eq, Show)+++-- |+-- Context creation flags+--+{# enum CUctx_flags as ContextFlag+    { underscoreToCase }+    with prefix="CU_CTX" deriving (Eq, Show, Bounded) #}+++#if CUDA_VERSION >= 4000+{-# DEPRECATED attach, detach "as of CUDA-4.0" #-}+{-# DEPRECATED BlockingSync "use SchedBlockingSync instead" #-}+#endif+++--------------------------------------------------------------------------------+-- Context management+--------------------------------------------------------------------------------++-- |+-- Create a new CUDA context and associate it with the calling thread. The+-- context is created with a usage count of one, and the caller of 'create'+-- must call 'destroy' when done using the context. If a context is already+-- current to the thread, it is supplanted by the newly created context and+-- must be restored by a subsequent call to 'pop'.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g65dc0012348bc84810e2103a40d8e2cf>+--+{-# INLINEABLE create #-}+create :: Device -> [ContextFlag] -> IO Context+create !dev !flags = resultIfOk =<< cuCtxCreate flags dev++{-# INLINE cuCtxCreate #-}+{# fun unsafe cuCtxCreate+  { alloca-         `Context'       peekCtx*+  , combineBitMasks `[ContextFlag]'+  , useDevice       `Device'                 } -> `Status' cToEnum #}+  where peekCtx = liftM Context . peek+++-- |+-- Increments the usage count of the context. API: no context flags are+-- currently supported, so this parameter must be empty.+--+{-# INLINEABLE attach #-}+attach :: Context -> [ContextFlag] -> IO ()+attach !ctx !flags = nothingIfOk =<< cuCtxAttach ctx flags++{-# INLINE cuCtxAttach #-}+{# fun unsafe cuCtxAttach+  { withCtx*        `Context'+  , combineBitMasks `[ContextFlag]' } -> `Status' cToEnum #}+  where withCtx = with . useContext+++-- |+-- Detach the context, and destroy if no longer used+--+{-# INLINEABLE detach #-}+detach :: Context -> IO ()+detach !ctx = nothingIfOk =<< cuCtxDetach ctx++{-# INLINE cuCtxDetach #-}+{# fun unsafe cuCtxDetach+  { useContext `Context' } -> `Status' cToEnum #}+++-- |+-- Destroy the specified context, regardless of how many threads it is+-- current to. The context will be 'pop'ed from the current thread's+-- context stack, but if it is current on any other threads it will remain+-- current to those threads, and attempts to access it will result in an+-- error.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g27a365aebb0eb548166309f58a1e8b8e>+--+{-# INLINEABLE destroy #-}+destroy :: Context -> IO ()+destroy !ctx = nothingIfOk =<< cuCtxDestroy ctx++{-# INLINE cuCtxDestroy #-}+{# fun unsafe cuCtxDestroy+  { useContext `Context' } -> `Status' cToEnum #}+++-- |+-- Return the context bound to the calling CPU thread.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g8f13165846b73750693640fb3e8380d0>+--+{-# INLINEABLE get #-}+get :: IO (Maybe Context)+#if CUDA_VERSION < 4000+get = requireSDK 'get 4.0+#else+get = resultIfOk =<< cuCtxGetCurrent++{-# INLINE cuCtxGetCurrent #-}+{# fun unsafe cuCtxGetCurrent+  { alloca- `Maybe Context' peekCtx* } -> `Status' cToEnum #}+  where peekCtx = liftM (nothingIfNull Context) . peek+#endif+++-- |+-- Bind the specified context to the calling thread.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gbe562ee6258b4fcc272ca6478ca2a2f7>+--+{-# INLINEABLE set #-}+set :: Context -> IO ()+#if CUDA_VERSION < 4000+set _    = requireSDK 'set 4.0+#else+set !ctx = nothingIfOk =<< cuCtxSetCurrent ctx++{-# INLINE cuCtxSetCurrent #-}+{# fun unsafe cuCtxSetCurrent+  { useContext `Context' } -> `Status' cToEnum #}+#endif+++-- |+-- Return the device of the currently active context+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g4e84b109eba36cdaaade167f34ae881e>+--+{-# INLINEABLE device #-}+device :: IO Device+device = resultIfOk =<< cuCtxGetDevice++{-# INLINE cuCtxGetDevice #-}+{# fun unsafe cuCtxGetDevice+  { alloca- `Device' dev* } -> `Status' cToEnum #}+  where dev = liftM Device . peekIntConv+++-- |+-- Pop the current CUDA context from the CPU thread. The context may then+-- be attached to a different CPU thread by calling 'push'.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2fac188026a062d92e91a8687d0a7902>+--+{-# INLINEABLE pop #-}+pop :: IO Context+pop = resultIfOk =<< cuCtxPopCurrent++{-# INLINE cuCtxPopCurrent #-}+{# fun unsafe cuCtxPopCurrent+  { alloca- `Context' peekCtx* } -> `Status' cToEnum #}+  where peekCtx = liftM Context . peek+++-- |+-- Push the given context onto the CPU's thread stack of current contexts.+-- The specified context becomes the CPU thread's current context, so all+-- operations that operate on the current context are affected.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gb02d4c850eb16f861fe5a29682cc90ba>+--+{-# INLINEABLE push #-}+push :: Context -> IO ()+push !ctx = nothingIfOk =<< cuCtxPushCurrent ctx++{-# INLINE cuCtxPushCurrent #-}+{# fun unsafe cuCtxPushCurrent+  { useContext `Context' } -> `Status' cToEnum #}+++-- |+-- Block until the device has completed all preceding requests. If the+-- context was created with the 'SchedBlockingSync' flag, the CPU thread+-- will block until the GPU has finished its work.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g7a54725f28d34b8c6299f0c6ca579616>+--+{-# INLINEABLE sync #-}+sync :: IO ()+sync = nothingIfOk =<< cuCtxSynchronize++{-# INLINE cuCtxSynchronize #-}+{# fun cuCtxSynchronize+  { } -> `Status' cToEnum #}+
+ src/Foreign/CUDA/Driver/Context/Config.chs view
@@ -0,0 +1,297 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase                #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Context.Config+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- Context configuration for the low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Context.Config (++  -- * Context configuration+  getFlags,++  -- ** Resource limits+  Limit(..),+  getLimit, setLimit,++  -- ** Cache+  Cache(..),+  getCache, setCache,++  -- ** Shared memory+  SharedMem(..),+  getSharedMem, setSharedMem,++  -- ** Streams+  StreamPriority,+  getStreamPriorityRange,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Context.Base+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Types++-- System+import Control.Monad+import Foreign+import Foreign.C+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- Device limits flags+--+#if CUDA_VERSION < 3010+data Limit+#else+{# enum CUlimit_enum as Limit+    { underscoreToCase }+    with prefix="CU_LIMIT" deriving (Eq, Show) #}+#endif+++-- |+-- Device cache configuration preference+--+#if CUDA_VERSION < 3020+data Cache+#else+{# enum CUfunc_cache_enum as Cache+    { underscoreToCase }+    with prefix="CU_FUNC_CACHE" deriving (Eq, Show) #}+#endif+++-- |+-- Device shared memory configuration preference+--+#if CUDA_VERSION < 4020+data SharedMem+#else+{# enum CUsharedconfig as SharedMem+    { underscoreToCase }+    with prefix="CU_SHARED_MEM_CONFIG" deriving (Eq, Show) #}+#endif+++--------------------------------------------------------------------------------+-- Context configuration+--------------------------------------------------------------------------------++-- |+-- Return the flags that were used to create the current context.+--+-- Requires CUDA-7.0+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gf81eef983c1e3b2ef4f166d7a930c86d>+--+{-# INLINEABLE getFlags #-}+getFlags :: IO [ContextFlag]+#if CUDA_VERSION < 7000+getFlags = requireSDK 'getFlags 7.0+#else+getFlags = resultIfOk =<< cuCtxGetFlags++{-# INLINE cuCtxGetFlags #-}+{# fun unsafe cuCtxGetFlags+  { alloca- `[ContextFlag]' peekFlags* } -> `Status' cToEnum #}+  where+    peekFlags = liftM extractBitMasks . peek+#endif+++-- |+-- Query compute 2.0 call stack limits.+--+-- Requires CUDA-3.1.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g9f2d47d1745752aa16da7ed0d111b6a8>+--+{-# INLINEABLE getLimit #-}+getLimit :: Limit -> IO Int+#if CUDA_VERSION < 3010+getLimit _  = requireSDK 'getLimit 3.1+#else+getLimit !l = resultIfOk =<< cuCtxGetLimit l++{-# INLINE cuCtxGetLimit #-}+{# fun unsafe cuCtxGetLimit+  { alloca-   `Int' peekIntConv*+  , cFromEnum `Limit'            } -> `Status' cToEnum #}+#endif+++-- |+-- Specify the size of the call stack, for compute 2.0 devices.+--+-- Requires CUDA-3.1.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g0651954dfb9788173e60a9af7201e65a>+--+{-# INLINEABLE setLimit #-}+setLimit :: Limit -> Int -> IO ()+#if CUDA_VERSION < 3010+setLimit _ _   = requireSDK 'setLimit 3.1+#else+setLimit !l !n = nothingIfOk =<< cuCtxSetLimit l n++{-# INLINE cuCtxSetLimit #-}+{# fun unsafe cuCtxSetLimit+  { cFromEnum `Limit'+  , cIntConv  `Int'   } -> `Status' cToEnum #}+#endif+++-- |+-- On devices where the L1 cache and shared memory use the same hardware+-- resources, this function returns the preferred cache configuration for+-- the current context.+--+-- Requires CUDA-3.2.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g40b6b141698f76744dea6e39b9a25360>+--+{-# INLINEABLE getCache #-}+getCache :: IO Cache+#if CUDA_VERSION < 3020+getCache = requireSDK 'getCache 3.2+#else+getCache = resultIfOk =<< cuCtxGetCacheConfig++{-# INLINE cuCtxGetCacheConfig #-}+{# fun unsafe cuCtxGetCacheConfig+  { alloca- `Cache' peekEnum* } -> `Status' cToEnum #}+#endif+++-- |+-- On devices where the L1 cache and shared memory use the same hardware+-- resources, this sets the preferred cache configuration for the current+-- context. This is only a preference.+--+-- Any function configuration set via+-- 'Foreign.CUDA.Driver.Exec.setCacheConfigFun' will be preferred over this+-- context-wide setting.+--+-- Requires CUDA-3.2.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g54699acf7e2ef27279d013ca2095f4a3>+--+{-# INLINEABLE setCache #-}+setCache :: Cache -> IO ()+#if CUDA_VERSION < 3020+setCache _  = requireSDK 'setCache 3.2+#else+setCache !c = nothingIfOk =<< cuCtxSetCacheConfig c++{-# INLINE cuCtxSetCacheConfig #-}+{# fun unsafe cuCtxSetCacheConfig+  { cFromEnum `Cache' } -> `Status' cToEnum #}+#endif+++-- |+-- Return the current size of the shared memory banks in the current+-- context. On devices with configurable shared memory banks,+-- 'setSharedMem' can be used to change the configuration, so that+-- subsequent kernel launches will by default us the new bank size. On+-- devices without configurable shared memory, this function returns the+-- fixed bank size of the hardware.+--+-- Requires CUDA-4.2+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g17153a1b8b8c756f7ab8505686a4ad74>+--+{-# INLINEABLE getSharedMem #-}+getSharedMem :: IO SharedMem+#if CUDA_VERSION < 4020+getSharedMem = requireSDK 'getSharedMem 4.2+#else+getSharedMem = resultIfOk =<< cuCtxGetSharedMemConfig++{-# INLINE cuCtxGetSharedMemConfig #-}+{# fun unsafe cuCtxGetSharedMemConfig+  { alloca- `SharedMem' peekEnum*+  } -> `Status' cToEnum #}+#endif+++-- |+-- On devices with configurable shared memory banks, this function will set+-- the context's shared memory bank size that will be used by default for+-- subsequent kernel launches.+--+-- Changing the shared memory configuration between launches may insert+-- a device synchronisation.+--+-- Shared memory bank size does not affect shared memory usage or kernel+-- occupancy, but may have major effects on performance. Larger bank sizes+-- allow for greater potential bandwidth to shared memory, but change the+-- kinds of accesses which result in bank conflicts.+--+-- Requires CUDA-4.2+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2574235fa643f8f251bf7bc28fac3692>+--+{-# INLINEABLE setSharedMem #-}+setSharedMem :: SharedMem -> IO ()+#if CUDA_VERSION < 4020+setSharedMem _  = requireSDK 'setSharedMem 4.2+#else+setSharedMem !c = nothingIfOk =<< cuCtxSetSharedMemConfig c++{-# INLINE cuCtxSetSharedMemConfig #-}+{# fun unsafe cuCtxSetSharedMemConfig+  { cFromEnum `SharedMem' } -> `Status' cToEnum #}+#endif++++-- |+-- Returns the numerical values that correspond to the greatest and least+-- priority execution streams in the current context respectively. Stream+-- priorities follow the convention that lower numerical numbers correspond+-- to higher priorities. The range of meaningful stream priorities is given+-- by the inclusive range [greatestPriority,leastPriority].+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g137920ab61a71be6ce67605b9f294091>+--+{-# INLINEABLE getStreamPriorityRange #-}+getStreamPriorityRange :: IO (StreamPriority, StreamPriority)+#if CUDA_VERSION < 5050+getStreamPriorityRange = requireSDK 'getStreamPriorityRange 5.5+#else+getStreamPriorityRange = do+  (r,l,h) <- cuCtxGetStreamPriorityRange+  resultIfOk (r, (h,l))++{-# INLINE cuCtxGetStreamPriorityRange #-}+{# fun unsafe cuCtxGetStreamPriorityRange+  { alloca- `Int' peekIntConv*+  , alloca- `Int' peekIntConv*+  }+  -> `Status' cToEnum #}+#endif+
+ src/Foreign/CUDA/Driver/Context/Peer.chs view
@@ -0,0 +1,131 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase                #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Context.Peer+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- Direct peer context access functions for the low-level driver interface.+--+-- Since: CUDA-4.0+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Context.Peer (++  -- * Peer Access+  PeerFlag,+  accessible, add, remove,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Context.Base                 ( Context(..) )+import Foreign.CUDA.Driver.Device                       ( Device(..) )+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- 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+++--------------------------------------------------------------------------------+-- Peer access+--------------------------------------------------------------------------------++-- |+-- 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.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g496bdaae1f632ebfb695b99d2c40f19e>+--+{-# INLINEABLE accessible #-}+accessible :: Device -> Device -> IO Bool+#if CUDA_VERSION < 4000+accessible _ _        = requireSDK 'accessible 4.0+#else+accessible !dev !peer = resultIfOk =<< cuDeviceCanAccessPeer dev peer++{-# INLINE cuDeviceCanAccessPeer #-}+{# fun unsafe cuDeviceCanAccessPeer+  { alloca-   `Bool'   peekBool*+  , useDevice `Device'+  , useDevice `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.+--+-- Note that access is unidirectional, and in order to access memory in the+-- current context from the peer context, a separate symmetric call to+-- 'add' is required.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g0889ec6728e61c05ed359551d67b3f5a>+--+{-# INLINEABLE add #-}+add :: Context -> [PeerFlag] -> IO ()+#if CUDA_VERSION < 4000+add _ _         = requireSDK 'add 4.0+#else+add !ctx !flags = nothingIfOk =<< cuCtxEnablePeerAccess ctx flags++{-# INLINE cuCtxEnablePeerAccess #-}+{# fun unsafe cuCtxEnablePeerAccess+  { useContext      `Context'+  , combineBitMasks `[PeerFlag]' } -> `Status' cToEnum #}+#endif+++-- |+-- Disable direct memory access from the current context to the supplied+-- peer context, and unregisters any registered allocations.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PEER__ACCESS.html#group__CUDA__PEER__ACCESS_1g5b4b6936ea868d4954ce4d841a3b4810>+--+{-# INLINEABLE remove #-}+remove :: Context -> IO ()+#if CUDA_VERSION < 4000+remove _    = requireSDK 'remave 4.0+#else+remove !ctx = nothingIfOk =<< cuCtxDisablePeerAccess ctx++{-# INLINE cuCtxDisablePeerAccess #-}+{# fun unsafe cuCtxDisablePeerAccess+  { useContext `Context' } -> `Status' cToEnum #}+#endif+
+ src/Foreign/CUDA/Driver/Context/Primary.chs view
@@ -0,0 +1,170 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Context.Primary+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Primary context management for low-level driver interface. The primary+-- context is unique per device and shared with the Runtime API. This+-- allows integration with other libraries using CUDA.+--+-- Since: CUDA-7.0+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Context.Primary (++  status, setup, reset, retain, release,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Context.Base+import Foreign.CUDA.Driver.Device+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Control.Exception+import Control.Monad+import Foreign+import Foreign.C+++--------------------------------------------------------------------------------+-- Primary context management+--------------------------------------------------------------------------------+++-- |+-- Get the status of the primary context. Returns whether the current+-- context is active, and the flags it was (or will be) created with.+--+-- Requires CUDA-7.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g65f3e018721b6d90aa05cfb56250f469>+--+{-# INLINEABLE status #-}+status :: Device -> IO (Bool, [ContextFlag])+#if CUDA_VERSION < 7000+status _    = requireSDK 'status 7.0+#else+status !dev =+  cuDevicePrimaryCtxGetState dev >>= \(rv, !flags, !active) ->+  case rv of+    Success -> return (active, flags)+    _       -> throwIO (ExitCode rv)++{# fun unsafe cuDevicePrimaryCtxGetState+  { useDevice `Device'+  , alloca-   `[ContextFlag]' peekFlags*+  , alloca-   `Bool'          peekBool*+  } -> `Status' cToEnum #}+  where+    peekFlags = liftM extractBitMasks . peek+#endif+++-- |+-- Specify the flags that the primary context should be created with. Note+-- that this is an error if the primary context is already active.+--+-- Requires CUDA-7.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gd779a84f17acdad0d9143d9fe719cfdf>+--+{-# INLINEABLE setup #-}+setup :: Device -> [ContextFlag] -> IO ()+#if CUDA_VERSION < 7000+setup _    _      = requireSDK 'setup 7.0+#else+setup !dev !flags = nothingIfOk =<< cuDevicePrimaryCtxSetFlags dev flags++{-# INLINE cuDevicePrimaryCtxSetFlags #-}+{# fun unsafe cuDevicePrimaryCtxSetFlags+  { useDevice       `Device'+  , combineBitMasks `[ContextFlag]'+  } -> `Status' cToEnum #}+#endif+++-- |+-- Destroy all allocations and reset all state on the primary context of+-- the given device in the current process. Requires cuda-7.0+--+-- Requires CUDA-7.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g5d38802e8600340283958a117466ce12>+--+{-# INLINEABLE reset #-}+reset :: Device -> IO ()+#if CUDA_VERSION < 7000+reset _    = requireSDK 'reset 7.0+#else+reset !dev = nothingIfOk =<< cuDevicePrimaryCtxReset dev++{-# INLINE cuDevicePrimaryCtxReset #-}+{# fun unsafe cuDevicePrimaryCtxReset+  { useDevice `Device' } -> `Status' cToEnum #}+#endif+++-- |+-- Release the primary context on the given device. If there are no more+-- references to the primary context it will be destroyed, regardless of+-- how many threads it is current to.+--+-- Unlike 'Foreign.CUDA.Driver.Context.Base.pop' this does not pop the+-- context from the stack in any circumstances.+--+-- Requires CUDA-7.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1gf2a8bc16f8df0c88031f6a1ba3d6e8ad>+--+{-# INLINEABLE release #-}+release :: Device -> IO ()+#if CUDA_VERSION < 7000+release _    = requireSDK 'release 7.0+#else+release !dev = nothingIfOk =<< cuDevicePrimaryCtxRelease dev++{-# INLINE cuDevicePrimaryCtxRelease #-}+{# fun unsafe cuDevicePrimaryCtxRelease+  { useDevice `Device' } -> `Status' cToEnum #}+#endif+++-- |+-- Retain the primary context for the given device, creating it if+-- necessary, and increasing its usage count. The caller must call+-- 'release' when done using the context. Unlike+-- 'Foreign.CUDA.Driver.Context.Base.create' the newly retained context is+-- not pushed onto the stack.+--+-- Requires CUDA-7.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PRIMARY__CTX.html#group__CUDA__PRIMARY__CTX_1g9051f2d5c31501997a6cb0530290a300>+--+{-# INLINEABLE retain #-}+retain :: Device -> IO Context+#if CUDA_VERSION < 7000+retain _    = requireSDK 'retain 7.0+#else+retain !dev = resultIfOk =<< cuDevicePrimaryCtxRetain dev++{-# INLINE cuDevicePrimaryCtxRetain #-}+{# fun unsafe cuDevicePrimaryCtxRetain+  { alloca-   `Context' peekCtx*+  , useDevice `Device'+  } -> `Status' cToEnum #}+  where+    peekCtx = liftM Context . peek+#endif+
+ src/Foreign/CUDA/Driver/Device.chs view
@@ -0,0 +1,403 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase                #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Device+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Device management for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Device (++  -- * Device Management+  Device(..),+  DeviceProperties(..), DeviceAttribute(..), Compute(..), ComputeMode(..), InitFlag,+  initialise, capability, device, attribute, count, name, props, totalMem++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Analysis.Device+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+import Control.Monad                                    ( liftM )+import Control.Applicative+import Prelude+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A CUDA device+--+newtype Device = Device { useDevice :: {# type CUdevice #}}+  deriving (Eq, Show)+++-- |+-- Device attributes+--+{# enum CUdevice_attribute as DeviceAttribute+    { underscoreToCase+    , MAX as CU_DEVICE_ATTRIBUTE_MAX }          -- ignore+    with prefix="CU_DEVICE_ATTRIBUTE" deriving (Eq, Show) #}+++#if CUDA_VERSION < 5000+{# pointer *CUdevprop as ^ foreign -> CUDevProp nocode #}++--+-- Properties of the compute device (internal helper).+-- Replaced by cuDeviceGetAttribute in CUDA-5.0 and later.+--+data CUDevProp = CUDevProp+  {+    cuMaxThreadsPerBlock :: !Int,               -- Maximum number of threads per block+    cuMaxBlockSize       :: !(Int,Int,Int),     -- Maximum size of each dimension of a block+    cuMaxGridSize        :: !(Int,Int,Int),     -- Maximum size of each dimension of a grid+    cuSharedMemPerBlock  :: !Int64,             -- Shared memory available per block in bytes+    cuTotalConstMem      :: !Int64,             -- Constant memory available on device in bytes+    cuWarpSize           :: !Int,               -- Warp size in threads (SIMD width)+    cuMemPitch           :: !Int64,             -- Maximum pitch in bytes allowed by memory copies+    cuRegsPerBlock       :: !Int,               -- 32-bit registers available per block+    cuClockRate          :: !Int,               -- Clock frequency in kilohertz+    cuTextureAlignment   :: !Int64              -- Alignment requirement for textures+  }+  deriving (Show)+++instance Storable CUDevProp where+  sizeOf _    = {#sizeof CUdevprop#}+  alignment _ = alignment (undefined :: Ptr ())++  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++    [t1,t2,t3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxThreadsDim#} p+    [g1,g2,g3] <- peekArrayWith cIntConv 3 =<< {#get CUdevprop.maxGridSize#} p++    return CUDevProp+      {+        cuMaxThreadsPerBlock = tb,+        cuMaxBlockSize       = (t1,t2,t3),+        cuMaxGridSize        = (g1,g2,g3),+        cuSharedMemPerBlock  = sm,+        cuTotalConstMem      = cm,+        cuWarpSize           = ws,+        cuMemPitch           = mp,+        cuRegsPerBlock       = rb,+        cuClockRate          = cl,+        cuTextureAlignment   = ta+      }+#endif+++-- |+-- Possible option flags for CUDA initialisation. Dummy instance until the API+-- exports actual option values.+--+data InitFlag+instance Enum InitFlag where+#ifdef USE_EMPTY_CASE+  toEnum   x = case x of {}+  fromEnum x = case x of {}+#endif+++--------------------------------------------------------------------------------+-- Initialisation+--------------------------------------------------------------------------------++-- |+-- Initialise the CUDA driver API. This must be called before any other+-- driver function.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__INITIALIZE.html#group__CUDA__INITIALIZE_1g0a2f1517e1bd8502c7194c3a8c134bc3>+--+{-# INLINEABLE initialise #-}+initialise :: [InitFlag] -> IO ()+initialise !flags = nothingIfOk =<< cuInit flags <* enable_constructors++{-# INLINE enable_constructors #-}+{# fun unsafe enable_constructors { } -> `()' #}++{-# INLINE cuInit #-}+{# fun unsafe cuInit+  { combineBitMasks `[InitFlag]' } -> `Status' cToEnum #}+++--------------------------------------------------------------------------------+-- Device Management+--------------------------------------------------------------------------------++-- |+-- Return the compute compatibility revision supported by the device+--+{-# INLINEABLE capability #-}+capability :: Device -> IO Compute+#if CUDA_VERSION >= 5000+capability !dev =+  Compute <$> attribute dev ComputeCapabilityMajor+          <*> attribute dev ComputeCapabilityMinor+#else+-- Deprecated as of CUDA-5.0+--+capability !dev =+  (\(!s,!a,!b) -> resultIfOk (s,Compute a b)) =<< cuDeviceComputeCapability dev++{-# INLINE cuDeviceComputeCapability #-}+{# fun unsafe cuDeviceComputeCapability+  { alloca-   `Int'    peekIntConv*+  , alloca-   `Int'    peekIntConv*+  , useDevice `Device'              } -> `Status' cToEnum #}+#endif+++-- |+-- Return a handle to the compute device at the given ordinal.+--+-- <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+  { alloca-  `Device' dev*+  , cIntConv `Int'           } -> `Status' cToEnum #}+  where dev = liftM Device . peek+++-- |+-- Return the selected attribute for the given device.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g9c3e1414f0ad901d3278a4d6645fc266>+--+{-# 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 #}+++-- |+-- Return the number of device with compute capability > 1.0.+--+-- <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 #}+++-- |+-- The identifying name of the device.+--+-- <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+  { allocaS-  `String'& peekS*+  , useDevice `Device'         } -> `Status' cToEnum #}+  where+    len       = 512+    allocaS a = allocaBytes len $ \p -> a (p, cIntConv len)+    peekS s _ = peekCString s+++-- |+-- Return the properties of the selected device+--+{-# INLINEABLE props #-}+props :: Device -> IO DeviceProperties+props !d = do++#if CUDA_VERSION < 5000+  -- Old versions of the CUDA API used the separate cuDeviceGetProperties+  -- function to probe some properties, and cuDeviceGetAttribute for+  -- others. As of CUDA-5.0, the former was deprecated and its+  -- 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+#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+#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+#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+#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+#endif+#if CUDA_VERSION >= 5050+  sp  <- toBool `fmap` 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+#endif+#if CUDA_VERSION >= 5050+    , streamPriorities                  = sp+#endif+#if CUDA_VERSION >= 6000+    , globalL1Cache                     = gl1+    , localL1Cache                      = ll1+    , managedMemory                     = mm+    , multiGPUBoard                     = mg+    , multiGPUBoardGroupID              = mid+#endif+    }++#if CUDA_VERSION < 5000+-- Deprecated as of CUDA-5.0+{-# INLINE cuDeviceGetProperties #-}+{# fun unsafe cuDeviceGetProperties+  { alloca-   `CUDevProp' peek*+  , useDevice `Device'          } -> `Status' cToEnum #}+#endif+++-- |+-- The total memory available on the device (bytes).+--+-- <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+  { alloca-   `Int64'  peekIntConv*+  , useDevice `Device'              } -> `Status' cToEnum #}+
+ src/Foreign/CUDA/Driver/Error.chs view
@@ -0,0 +1,212 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE DeriveDataTypeable       #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Error+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Error handling+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Error (++  -- * CUDA Errors+  Status(..), CUDAException(..),+  describe,+  cudaError, cudaErrorIO, requireSDK,+  resultIfOk, nothingIfOk,++) where++-- Friends+import Foreign.CUDA.Internal.C2HS+import Text.Show.Describe++-- System+import Control.Exception+import Control.Monad+import Data.Typeable+import Foreign.C+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import Language.Haskell.TH+import System.IO.Unsafe+import Text.Printf+++#include "cbits/stubs.h"+{# context lib="cuda" #}+++--------------------------------------------------------------------------------+-- Return Status+--------------------------------------------------------------------------------++--+-- Error Codes+--+{# enum CUresult as Status+    { underscoreToCase+    , CUDA_SUCCESS                      as Success+    , CUDA_ERROR_NO_BINARY_FOR_GPU      as NoBinaryForGPU+    , CUDA_ERROR_INVALID_PTX            as InvalidPTX+    , CUDA_ERROR_INVALID_PC             as InvalidPC+    }+    with prefix="CUDA_ERROR" deriving (Eq, Show) #}+++-- |+-- Return a descriptive error string associated with a particular error code+--+instance Describe Status where+#if CUDA_VERSION >= 6000+  describe status =+    case cuGetErrorString status of+      (Success, msg) -> msg+      (err, _)       -> throw (ExitCode err)++{# fun pure unsafe cuGetErrorString+    { cFromEnum `Status'+    , alloca-   `String' ppeek* } -> `Status' cToEnum #}+    where+      ppeek = peek >=> peekCString+#else+  describe Success                        = "no error"+  describe InvalidValue                   = "invalid argument"+  describe OutOfMemory                    = "out of memory"+  describe NotInitialized                 = "driver not initialised"+  describe Deinitialized                  = "driver deinitialised"+  describe NoDevice                       = "no CUDA-capable device is available"+  describe InvalidDevice                  = "invalid device ordinal"+  describe InvalidImage                   = "invalid kernel image"+  describe InvalidContext                 = "invalid context handle"+  describe ContextAlreadyCurrent          = "context already current"+  describe MapFailed                      = "map failed"+  describe UnmapFailed                    = "unmap failed"+  describe ArrayIsMapped                  = "array is mapped"+  describe AlreadyMapped                  = "already mapped"+  describe NoBinaryForGPU                 = "no binary available for this GPU"+  describe AlreadyAcquired                = "resource already acquired"+  describe NotMapped                      = "not mapped"+  describe InvalidSource                  = "invalid source"+  describe FileNotFound                   = "file not found"+  describe InvalidHandle                  = "invalid handle"+  describe NotFound                       = "not found"+  describe NotReady                       = "device not ready"+  describe LaunchFailed                   = "unspecified launch failure"+  describe LaunchOutOfResources           = "too many resources requested for launch"+  describe LaunchTimeout                  = "the launch timed out and was terminated"+  describe LaunchIncompatibleTexturing    = "launch with incompatible texturing"+#if CUDA_VERSION >= 3000+  describe NotMappedAsArray               = "mapped resource not available for access as an array"+  describe NotMappedAsPointer             = "mapped resource not available for access as a pointer"+  describe EccUncorrectable               = "uncorrectable ECC error detected"+#endif+#if CUDA_VERSION >= 3000 && CUDA_VERSION < 3020+  describe PointerIs64bit                 = "attempt to retrieve a 64-bit pointer via a 32-bit API function"+  describe SizeIs64bit                    = "attempt to retrieve 64-bit size via a 32-bit API function"+#endif+#if CUDA_VERSION >= 3010+  describe UnsupportedLimit               = "limits not supported by device"+  describe SharedObjectSymbolNotFound     = "link to a shared object failed to resolve"+  describe SharedObjectInitFailed         = "shared object initialisation failed"+#endif+#if CUDA_VERSION >= 3020+  describe OperatingSystem                = "operating system call failed"+#endif+#if CUDA_VERSION >= 4000+  describe ProfilerDisabled               = "profiling APIs disabled: application running with visual profiler"+  describe ProfilerNotInitialized         = "profiler not initialised"+  describe ProfilerAlreadyStarted         = "profiler already started"+  describe ProfilerAlreadyStopped         = "profiler already stopped"+  describe ContextAlreadyInUse            = "context is already bound to a thread and in use"+  describe PeerAccessAlreadyEnabled       = "peer access already enabled"+  describe PeerAccessNotEnabled           = "peer access has not been enabled"+  describe PrimaryContextActive           = "primary context for this device has already been initialised"+  describe ContextIsDestroyed             = "context already destroyed"+#endif+#if CUDA_VERSION >= 4010+  describe Assert                         = "device-side assert triggered"+  describe TooManyPeers                   = "peer mapping resources exhausted"+  describe HostMemoryAlreadyRegistered    = "part or all of the requested memory range is already mapped"+  describe HostMemoryNotRegistered        = "pointer does not correspond to a registered memory region"+#endif+#if CUDA_VERSION >= 5000+  describe PeerAccessUnsupported          = "peer access is not supported across the given devices"+  describe NotPermitted                   = "not permitted"+  describe NotSupported                   = "not supported"+#endif+  describe Unknown                        = "unknown error"+#endif+++--------------------------------------------------------------------------------+-- 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. Exceptions can be thrown from pure code, but can only+-- be caught in the 'IO' monad.+--+{-# RULES "cudaError/IO" cudaError = cudaErrorIO #-}+{-# NOINLINE [1] cudaError #-}+cudaError :: String -> a+cudaError s = throw (UserError s)++-- |+-- Raise a CUDAException in the IO Monad+--+cudaErrorIO :: String -> IO a+cudaErrorIO s = throwIO (UserError s)++-- |+-- A specially formatted error message+--+requireSDK :: Name -> Double -> a+requireSDK n v = cudaError $ printf "'%s' requires at least cuda-%3.1f\n" (show n) v+++--------------------------------------------------------------------------------+-- Helper Functions+--------------------------------------------------------------------------------+++-- |+-- Return the results of a function on successful execution, otherwise throw an+-- exception with an 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)+++-- |+-- Throw an exception with an error string associated with an unsuccessful+-- return code, otherwise return unit.+--+{-# INLINE nothingIfOk #-}+nothingIfOk :: Status -> IO ()+nothingIfOk status =+    case status of+        Success -> return  ()+        _       -> throwIO (ExitCode status)+
+ src/Foreign/CUDA/Driver/Event.chs view
@@ -0,0 +1,163 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Event+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Event management for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Event (++  -- * Event Management+  Event(..), EventFlag(..), WaitFlag,+  create, destroy, elapsedTime, query, record, wait, block++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Types+import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Driver.Error++-- System+import Foreign+import Foreign.C+import Data.Maybe+import Control.Monad                                    ( liftM )+import Control.Exception                                ( throwIO )+++--------------------------------------------------------------------------------+-- Event management+--------------------------------------------------------------------------------++-- |+-- Create a new event+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g450687e75f3ff992fe01662a43d9d3db>+--+{-# INLINEABLE create #-}+create :: [EventFlag] -> IO Event+create !flags = resultIfOk =<< cuEventCreate flags++{-# INLINE cuEventCreate #-}+{# fun unsafe cuEventCreate+  { alloca-         `Event'       peekEvt*+  , combineBitMasks `[EventFlag]'          } -> `Status' cToEnum #}+  where peekEvt = liftM Event . peek+++-- |+-- Destroy an event+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g593ec73a8ec5a5fc031311d3e4dca1ef>+--+{-# INLINEABLE destroy #-}+destroy :: Event -> IO ()+destroy !ev = nothingIfOk =<< cuEventDestroy ev++{-# INLINE cuEventDestroy #-}+{# fun unsafe cuEventDestroy+  { useEvent `Event' } -> `Status' cToEnum #}+++-- |+-- Determine the elapsed time (in milliseconds) between two events+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1gdfb1178807353bbcaa9e245da497cf97>+--+{-# INLINEABLE elapsedTime #-}+elapsedTime :: Event -> Event -> IO Float+elapsedTime !ev1 !ev2 = resultIfOk =<< cuEventElapsedTime ev1 ev2++{-# INLINE cuEventElapsedTime #-}+{# fun unsafe cuEventElapsedTime+  { alloca-  `Float' peekFloatConv*+  , useEvent `Event'+  , useEvent `Event'                } -> `Status' cToEnum #}+++-- |+-- Determines if a event has actually been recorded+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g6f0704d755066b0ee705749ae911deef>+--+{-# INLINEABLE query #-}+query :: Event -> IO Bool+query !ev =+  cuEventQuery ev >>= \rv ->+  case rv of+    Success  -> return True+    NotReady -> return False+    _        -> throwIO (ExitCode rv)++{-# INLINE cuEventQuery #-}+{# fun unsafe cuEventQuery+  { useEvent `Event' } -> `Status' cToEnum #}+++-- |+-- Record an event once all operations in the current context (or optionally+-- specified stream) have completed. This operation is asynchronous.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g95424d3be52c4eb95d83861b70fb89d1>+--+{-# INLINEABLE record #-}+record :: Event -> Maybe Stream -> IO ()+record !ev !mst =+  nothingIfOk =<< cuEventRecord ev (fromMaybe defaultStream mst)++{-# INLINE cuEventRecord #-}+{# fun unsafe cuEventRecord+  { 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.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g6a898b652dfc6aa1d5c8d97062618b2f>+--+{-# INLINEABLE wait #-}+wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()+#if CUDA_VERSION < 3020+wait _ _ _           = requireSDK 'wait 3.2+#else+wait !ev !mst !flags =+  nothingIfOk =<< cuStreamWaitEvent (fromMaybe defaultStream mst) ev flags++{-# INLINE cuStreamWaitEvent #-}+{# fun unsafe cuStreamWaitEvent+  { useStream       `Stream'+  , useEvent        `Event'+  , combineBitMasks `[WaitFlag]' } -> `Status' cToEnum #}+#endif++-- |+-- Wait until the event has been recorded+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g9e520d34e51af7f5375610bca4add99c>+--+{-# INLINEABLE block #-}+block :: Event -> IO ()+block !ev = nothingIfOk =<< cuEventSynchronize ev++{-# INLINE cuEventSynchronize #-}+{# fun cuEventSynchronize+  { useEvent `Event' } -> `Status' cToEnum #}+
+ src/Foreign/CUDA/Driver/Exec.chs view
@@ -0,0 +1,380 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GADTs                    #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Exec+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Kernel execution control for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Exec (++  -- * Kernel Execution+  Fun(Fun), FunParam(..), FunAttribute(..), SharedMem(..),+  requires,+  setCacheConfigFun,+  setSharedMemConfigFun,+  launchKernel, launchKernel',++  -- Deprecated since CUDA-4.0+  setBlockShape, setSharedSize, setParams, launch,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Context                      ( Cache(..), SharedMem(..) )+import Foreign.CUDA.Driver.Stream                       ( Stream(..), defaultStream )++-- System+import Foreign+import Foreign.C+import Data.Maybe+import Control.Monad                                    ( zipWithM_ )+++#if CUDA_VERSION >= 4000+{-# DEPRECATED setBlockShape, setSharedSize, setParams, launch+      "use launchKernel instead" #-}+#endif+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A @\_\_global\_\_@ device function+--+newtype Fun = Fun { useFun :: {# type CUfunction #}}+++-- |+-- Function attributes+--+{# enum CUfunction_attribute as FunAttribute+    { underscoreToCase+    , MAX_THREADS_PER_BLOCK as MaxKernelThreadsPerBlock+    , MAX as CU_FUNC_ATTRIBUTE_MAX }    -- ignore+    with prefix="CU_FUNC_ATTRIBUTE" deriving (Eq, Show) #}++-- |+-- Kernel function parameters+--+data FunParam where+  IArg :: !Int32           -> FunParam+  FArg :: !Float           -> FunParam+  VArg :: Storable a => !a -> FunParam++instance Storable FunParam where+  sizeOf (IArg _)       = sizeOf (undefined :: CUInt)+  sizeOf (FArg _)       = sizeOf (undefined :: CFloat)+  sizeOf (VArg v)       = sizeOf v++  alignment (IArg _)    = alignment (undefined :: CUInt)+  alignment (FArg _)    = alignment (undefined :: CFloat)+  alignment (VArg v)    = alignment v++  poke p (IArg i)       = poke (castPtr p) i+  poke p (FArg f)       = poke (castPtr p) f+  poke p (VArg v)       = poke (castPtr p) v++  peek _                = error "Can not peek Foreign.CUDA.Driver.FunParam"+++--------------------------------------------------------------------------------+-- Execution Control+--------------------------------------------------------------------------------++-- |+-- Returns the value of the selected attribute requirement for the given kernel.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g5e92a1b0d8d1b82cb00dcfb2de15961b>+--+{-# INLINEABLE requires #-}+requires :: Fun -> FunAttribute -> IO Int+requires !fn !att = resultIfOk =<< cuFuncGetAttribute att fn++{-# INLINE cuFuncGetAttribute #-}+{# fun unsafe cuFuncGetAttribute+  { alloca-   `Int'          peekIntConv*+  , cFromEnum `FunAttribute'+  , useFun    `Fun'                       } -> `Status' cToEnum #}+++-- |+-- 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.+--+-- Requires CUDA-3.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g40f8c11e81def95dc0072a375f965681>+--+{-# INLINEABLE setCacheConfigFun #-}+setCacheConfigFun :: Fun -> Cache -> IO ()+#if CUDA_VERSION < 3000+setCacheConfigFun _ _       = requireSDK 'setCacheConfigFun 3.0+#else+setCacheConfigFun !fn !pref = nothingIfOk =<< cuFuncSetCacheConfig fn pref++{-# INLINE cuFuncSetCacheConfig #-}+{# fun unsafe cuFuncSetCacheConfig+  { useFun    `Fun'+  , cFromEnum `Cache' } -> `Status' cToEnum #}+#endif+++-- |+-- Set the shared memory configuration of a device function.+--+-- On devices with configurable shared memory banks, this will force all+-- subsequent launches of the given device function to use the specified+-- shared memory bank size configuration. On launch of the function, the+-- shared memory configuration of the device will be temporarily changed if+-- needed to suit the function configuration. Changes in shared memory+-- configuration may introduction a device side synchronisation between+-- kernel launches.+--+-- Any per-function configuration specified by 'setSharedMemConfig' will+-- override the context-wide configuration set with+-- 'Foreign.CUDA.Driver.Context.Config.setSharedMem'.+--+-- Changing the shared memory bank size will not increase shared memory+-- usage or affect occupancy of kernels, but may have major effects on+-- performance. Larger bank sizes will allow for greater potential+-- bandwidth to shared memory, but will change what kinds of accesses to+-- shared memory will result in bank conflicts.+--+-- This function will do nothing on devices with fixed shared memory bank+-- size.+--+-- Requires CUDA-5.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1g430b913f24970e63869635395df6d9f5>+--+{-# INLINEABLE setSharedMemConfigFun #-}+setSharedMemConfigFun :: Fun -> SharedMem -> IO ()+#if CUDA_VERSION < 5000+setSharedMemConfigFun _    _     = requireSDK 'setSharedMemConfigFun 5.0+#else+setSharedMemConfigFun !fun !pref = nothingIfOk =<< cuFuncSetSharedMemConfig fun pref++{-# INLINE cuFuncSetSharedMemConfig #-}+{# fun unsafe cuFuncSetSharedMemConfig+  { useFun    `Fun'+  , cFromEnum `SharedMem'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Invoke a kernel on a @(gx * gy * gz)@ 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'.+--+-- In 'launchKernel', the number of kernel parameters and their offsets and+-- sizes do not need to be specified, as this information is retrieved directly+-- from the kernel's image. This requires the kernel to have been compiled with+-- toolchain version 3.2 or later.+--+-- The alternative 'launchKernel'' will pass the arguments in directly,+-- requiring the application to know the size and alignment/padding of each+-- kernel parameter.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1gb8f3dc3031b40da29d5f9a7139e52e15>+--+{-# INLINEABLE launchKernel  #-}+{-# INLINEABLE launchKernel' #-}+launchKernel, launchKernel'+    :: Fun                      -- ^ function to execute+    -> (Int,Int,Int)            -- ^ block grid dimension+    -> (Int,Int,Int)            -- ^ thread block shape+    -> Int                      -- ^ shared memory (bytes)+    -> Maybe Stream             -- ^ (optional) stream to execute in+    -> [FunParam]               -- ^ list of function parameters+    -> IO ()+#if CUDA_VERSION >= 4000+launchKernel !fn (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !mst !args+  = (=<<) nothingIfOk+  $ withMany withFP args+  $ \pa -> withArray pa+  $ \pp -> cuLaunchKernel fn gx gy gz tx ty tz sm st pp nullPtr+  where+    !st = fromMaybe defaultStream mst++    withFP :: FunParam -> (Ptr FunParam -> IO b) -> IO b+    withFP !p !f = case p of+      IArg v -> with' v (f . castPtr)+      FArg v -> with' v (f . castPtr)+      VArg v -> with' v (f . castPtr)++    -- can't use the standard 'with' because 'alloca' will pass an undefined+    -- dummy argument when determining 'sizeOf' and 'alignment', but sometimes+    -- instances in Accelerate need to evaluate this argument.+    --+    with' :: Storable a => a -> (Ptr a -> IO b) -> IO b+    with' !val !f =+      allocaBytes (sizeOf val) $ \ptr -> do+        poke ptr val+        f ptr+++launchKernel' !fn (!gx,!gy,!gz) (!tx,!ty,!tz) !sm !mst !args+  = (=<<) nothingIfOk+  $ with bytes+  $ \pb -> withArray' args+  $ \pa -> withArray0 nullPtr [buffer, castPtr pa, size, castPtr pb]+  $ \pp -> cuLaunchKernel fn gx gy gz tx ty tz sm st nullPtr pp+  where+    buffer      = wordPtrToPtr 0x01     -- CU_LAUNCH_PARAM_BUFFER_POINTER+    size        = wordPtrToPtr 0x02     -- CU_LAUNCH_PARAM_BUFFER_SIZE+    bytes       = foldl (\a x -> a + sizeOf x) 0 args+    st          = fromMaybe defaultStream mst++    -- can't use the standard 'withArray' because 'mallocArray' will pass+    -- 'undefined' to 'sizeOf' when determining how many bytes to allocate, but+    -- our Storable instance for FunParam needs to dispatch on each constructor,+    -- hence evaluating the undefined.+    --+    withArray' !vals !f =+      allocaBytes bytes $ \ptr -> do+        pokeArray ptr vals+        f ptr+++{-# INLINE cuLaunchKernel #-}+{# fun unsafe cuLaunchKernel+  { useFun    `Fun'+  ,           `Int', `Int', `Int'+  ,           `Int', `Int', `Int'+  ,           `Int'+  , useStream `Stream'+  , castPtr   `Ptr (Ptr FunParam)'+  , castPtr   `Ptr (Ptr ())'       } -> `Status' cToEnum #}++#else+launchKernel !fn (!gx,!gy,_) (!tx,!ty,!tz) !sm !mst !args = do+  setParams     fn args+  setSharedSize fn (toInteger sm)+  setBlockShape fn (tx,ty,tz)+  launch        fn (gx,gy) mst++launchKernel' = launchKernel+#endif+++--------------------------------------------------------------------------------+-- Deprecated+--------------------------------------------------------------------------------++-- |+-- Invoke the kernel on a size @(w,h)@ grid of blocks. Each block contains the+-- number of threads specified by a previous call to 'setBlockShape'. The launch+-- may also be associated with a specific 'Stream'.+--+{-# INLINEABLE launch #-}+launch :: Fun -> (Int,Int) -> Maybe Stream -> IO ()+launch !fn (!w,!h) mst =+  nothingIfOk =<< cuLaunchGridAsync fn w h (fromMaybe defaultStream mst)++{-# INLINE cuLaunchGridAsync #-}+{# fun unsafe cuLaunchGridAsync+  { useFun    `Fun'+  ,           `Int'+  ,           `Int'+  , useStream `Stream' } -> `Status' cToEnum #}+++-- |+-- Specify the @(x,y,z)@ dimensions of the thread blocks that are created when+-- the given kernel function is launched.+--+{-# INLINEABLE setBlockShape #-}+setBlockShape :: Fun -> (Int,Int,Int) -> IO ()+setBlockShape !fn (!x,!y,!z) = nothingIfOk =<< cuFuncSetBlockShape fn x y z++{-# INLINE cuFuncSetBlockShape #-}+{# fun unsafe cuFuncSetBlockShape+  { useFun `Fun'+  ,        `Int'+  ,        `Int'+  ,        `Int' } -> `Status' cToEnum #}+++-- |+-- Set the number of bytes of dynamic shared memory to be available to each+-- thread block when the function is launched+--+{-# INLINEABLE setSharedSize #-}+setSharedSize :: Fun -> Integer -> IO ()+setSharedSize !fn !bytes = nothingIfOk =<< cuFuncSetSharedSize fn bytes++{-# INLINE cuFuncSetSharedSize #-}+{# fun unsafe cuFuncSetSharedSize+  { useFun   `Fun'+  , cIntConv `Integer' } -> `Status' cToEnum #}+++-- |+-- Set the parameters that will specified next time the kernel is invoked+--+{-# INLINEABLE setParams #-}+setParams :: Fun -> [FunParam] -> IO ()+setParams !fn !prs = do+  zipWithM_ (set fn) offsets prs+  nothingIfOk =<< cuParamSetSize fn (last offsets)+  where+    offsets = scanl (\a b -> a + size b) 0 prs++    size (IArg _)    = sizeOf (undefined :: CUInt)+    size (FArg _)    = sizeOf (undefined :: CFloat)+    size (VArg v)    = sizeOf v++    set f o (IArg v) = nothingIfOk =<< cuParamSeti f o v+    set f o (FArg v) = nothingIfOk =<< cuParamSetf f o v+    set f o (VArg v) = with v $ \p -> (nothingIfOk =<< cuParamSetv f o p (sizeOf v))+++{-# INLINE cuParamSetSize #-}+{# fun unsafe cuParamSetSize+  { useFun `Fun'+  ,        `Int' } -> `Status' cToEnum #}++{-# INLINE cuParamSeti #-}+{# fun unsafe cuParamSeti+  { useFun `Fun'+  ,        `Int'+  ,        `Int32' } -> `Status' cToEnum #}++{-# INLINE cuParamSetf #-}+{# fun unsafe cuParamSetf+  { useFun `Fun'+  ,        `Int'+  ,        `Float' } -> `Status' cToEnum #}++{-# INLINE cuParamSetv #-}+{# fun unsafe cuParamSetv+  `Storable a' =>+  { useFun  `Fun'+  ,         `Int'+  , castPtr `Ptr a'+  ,         `Int'   } -> `Status' cToEnum #}++
+ src/Foreign/CUDA/Driver/IPC/Event.chs view
@@ -0,0 +1,140 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.IPC.Event+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- IPC event management for low-level driver interface.+--+-- Restricted to devices which support unified addressing on Linux+-- operating systems.+--+-- Since CUDA-4.1.+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.IPC.Event (++  IPCEvent,+  export, open,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Event+import Foreign.CUDA.Internal.C2HS++-- System+import Control.Monad+import Prelude++import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal+import Foreign.Storable+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A CUDA inter-process event handle.+--+newtype IPCEvent = IPCEvent { useIPCEvent :: IPCEventHandle }+  deriving (Eq, Show)+++--------------------------------------------------------------------------------+-- IPC event management+--------------------------------------------------------------------------------++-- |+-- Create an inter-process event handle for a previously allocated event.+-- The event must be created with the 'Interprocess' and 'DisableTiming'+-- event flags. The returned handle may then be sent to another process and+-- 'open'ed to allow efficient hardware synchronisation between GPU work in+-- other processes.+--+-- After the event has been opened in the importing process, 'record',+-- 'block', 'wait', 'query' may be used in either process.+--+-- Performing operations on the imported event after the event has been+-- 'destroy'ed in the exporting process is undefined.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gea02eadd12483de5305878b13288a86c>+--+{-# INLINEABLE export #-}+export :: Event -> IO IPCEvent+#if CUDA_VERSION < 4010+export _   = requireSDK 'create 4.1+#else+export !ev = do+  h <- newIPCEventHandle+  r <- cuIpcGetEventHandle h ev+  resultIfOk (r, IPCEvent h)++{-# INLINE cuIpcGetEventHandle #-}+{# fun unsafe cuIpcGetEventHandle+  { withForeignPtr* `IPCEventHandle'+  , useEvent        `Event'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Open an inter-process event handle for use in the current process,+-- returning an event that can be used in the current process and behaving+-- as a locally created event with the 'DisableTiming' flag specified.+--+-- The event must be freed with 'destroy'. Performing operations on the+-- imported event after the exported event has been 'destroy'ed in the+-- exporting process is undefined.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf1d525918b6c643b99ca8c8e42e36c2e>+--+{-# INLINEABLE open #-}+open :: IPCEvent -> IO Event+#if CUDA_VERSION < 4010+open _    = requireSDK 'open 4.1+#else+open !ev = resultIfOk =<< cuIpcOpenEventHandle (useIPCEvent ev)++{-# INLINE cuIpcOpenEventHandle #-}+{# fun unsafe cuIpcOpenEventHandle+  { alloca-         `Event'          peekEvent*+  , withForeignPtr* `IPCEventHandle'+  }+  -> `Status' cToEnum #}+  where+    peekEvent = liftM Event . peek+#endif+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++type IPCEventHandle = ForeignPtr ()++newIPCEventHandle :: IO IPCEventHandle+#if CUDA_VERSION < 4010+newIPCEventHandle = requireSDK 'newIPCEventHandle 4.1+#else+newIPCEventHandle = mallocForeignPtrBytes {#sizeof CUipcEventHandle#}+#endif+
+ src/Foreign/CUDA/Driver/IPC/Marshal.chs view
@@ -0,0 +1,177 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.IPC.Marshal+-- Copyright : [2009..2015] Trevor L. McDonell+-- License   : BSD+--+-- IPC memory management for low-level driver interface.+--+-- Restricted to devices which support unified addressing on Linux+-- operating systems.+--+-- Since CUDA-4.0.+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.IPC.Marshal (++  -- ** IPC memory management+  IPCDevicePtr, IPCFlag(..),+  export, open, close,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Ptr+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS+import Foreign.CUDA.Driver.Marshal++-- System+import Control.Monad+import Prelude++import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A CUDA memory handle used for inter-process communication.+--+newtype IPCDevicePtr a = IPCDevicePtr { useIPCDevicePtr :: IPCMemHandle }+  deriving (Eq, Show)+++-- |+-- Flags for controlling IPC memory access+--+#if CUDA_VERSION < 4010+data IPCFlag+#else+{# enum CUipcMem_flags as IPCFlag+  { underscoreToCase }+  with prefix="CU_IPC_MEM" deriving (Eq, Show, Bounded) #}+#endif+++--------------------------------------------------------------------------------+-- IPC memory management+--------------------------------------------------------------------------------++-- |+-- Create an inter-process memory handle for an existing device memory+-- allocation. The handle can then be sent to another process and made+-- available to that process via 'open'.+--+-- Requires CUDA-4.1.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g6f1b5be767b275f016523b2ac49ebec1>+--+{-# INLINEABLE export #-}+export :: DevicePtr a -> IO (IPCDevicePtr a)+#if CUDA_VERSION < 4010+export _     = requireSDK 'export 4.1+#else+export !dptr = do+  h <- newIPCMemHandle+  r <- cuIpcGetMemHandle h dptr+  resultIfOk (r, IPCDevicePtr h)++{-# INLINE cuIpcGetMemHandle #-}+{# fun unsafe cuIpcGetMemHandle+  { withForeignPtr* `IPCMemHandle'+  , useDeviceHandle `DevicePtr a'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Open an inter-process memory handle exported from another process,+-- returning a device pointer usable in the current process.+--+-- Maps memory exported by another process with 'create' into the current+-- device address space. For contexts on different devices, 'open' can+-- attempt to enable peer access if the user called+-- 'Foreign.CUDA.Driver.Context.Peer.add', and is controlled by the+-- 'LazyEnablePeerAccess' flag.+--+-- Each handle from a given device and context may only be 'open'ed by one+-- context per device per other process. Memory returned by 'open' must be+-- freed via 'close'.+--+-- Requires CUDA-4.1.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1ga8bd126fcff919a0c996b7640f197b79>+--+{-# INLINEABLE open #-}+open :: IPCDevicePtr a -> [IPCFlag]-> IO (DevicePtr a)+#if CUDA_VERSION < 4010+open _    _      = requireSDK 'open 4.1+#else+open !hdl !flags = resultIfOk =<< cuIpcOpenMemHandle (useIPCDevicePtr hdl) flags++{-# INLINE cuIpcOpenMemHandle #-}+{# fun unsafe cuIpcOpenMemHandle+  { alloca-         `DevicePtr a'  peekDeviceHandle*+  , withForeignPtr* `IPCMemHandle'+  , combineBitMasks `[IPCFlag]'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Close and unmap memory returned by 'open'. The original allocation in+-- the exporting process as well as imported mappings in other processes+-- are unaffected.+--+-- Any resources used to enable peer access will be freed if this is the+-- last mapping using them.+--+-- Requires CUDA-4.1.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gd6f5d5bcf6376c6853b64635b0157b9e>+--+{-# INLINEABLE close #-}+close :: DevicePtr a -> IO ()+#if CUDA_VERSION < 4010+close _     = requireSDK 'close 4.1+#else+close !dptr = nothingIfOk =<< cuIpcCloseMemHandle dptr++{-# INLINE cuIpcCloseMemHandle #-}+{# fun unsafe cuIpcCloseMemHandle+  { useDeviceHandle `DevicePtr a'+  }+  -> `Status' cToEnum #}+#endif+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++type IPCMemHandle = ForeignPtr ()++newIPCMemHandle :: IO IPCMemHandle+#if CUDA_VERSION < 4010+newIPCMemHandle = requireSDK 'newIPCMemHandle 4.1+#else+newIPCMemHandle = mallocForeignPtrBytes {#sizeof CUipcMemHandle#}+#endif+
+ src/Foreign/CUDA/Driver/Marshal.chs view
@@ -0,0 +1,1117 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+{-# OPTIONS_HADDOCK prune #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Marshal+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Memory management for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Marshal (++  -- * Host Allocation+  AllocFlag(..),+  mallocHostArray, mallocHostForeignPtr, freeHost,+  registerArray, unregisterArray,++  -- * 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,+  copyArrayPeer, copyArrayPeerAsync,++  -- * Combined Allocation and Marshalling+  newListArray,  newListArrayLen,+  withListArray, withListArrayLen,++  -- * Utility+  memset, memsetAsync,+  getDevicePtr, getBasePtr, getMemInfo,++  -- Internal+  useDeviceHandle, peekDeviceHandle++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Ptr+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Stream                       ( Stream(..), defaultStream )+import Foreign.CUDA.Driver.Context.Base                 ( Context(..) )+import Foreign.CUDA.Internal.C2HS++-- System+import Data.Int+import Data.Maybe+import Data.Word+import Unsafe.Coerce+import Control.Applicative+import Control.Exception+import Prelude++import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import qualified Foreign.Marshal                        as F++#c+typedef enum CUmemhostalloc_option_enum {+    CU_MEMHOSTALLOC_OPTION_PORTABLE       = CU_MEMHOSTALLOC_PORTABLE,+    CU_MEMHOSTALLOC_OPTION_DEVICE_MAPPED  = CU_MEMHOSTALLOC_DEVICEMAP,+    CU_MEMHOSTALLOC_OPTION_WRITE_COMBINED = CU_MEMHOSTALLOC_WRITECOMBINED+} CUmemhostalloc_option;+#endc+++--------------------------------------------------------------------------------+-- Host Allocation+--------------------------------------------------------------------------------++-- |+-- Options for host allocation+--+{# enum CUmemhostalloc_option as AllocFlag+    { underscoreToCase }+    with prefix="CU_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.+--+-- 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.+--+-- Host memory allocated in this way is automatically and immediately+-- accessible to all contexts on all devices which support unified+-- addressing.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gdd8311286d2c2691605362c689bc64e0>+--+{-# 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 =<< cuMemHostAlloc (n * sizeOf x) flags++-- |+-- As 'mallocHostArray', but return a 'ForeignPtr' instead. The array will be+-- deallocated automatically once the last reference to the 'ForeignPtr' is+-- dropped.+--+{-# INLINEABLE mallocHostForeignPtr #-}+{-# SPECIALISE mallocHostForeignPtr :: [AllocFlag] -> Int -> IO (ForeignPtr Word8) #-}+mallocHostForeignPtr :: Storable a => [AllocFlag] -> Int -> IO (ForeignPtr a)+mallocHostForeignPtr !flags !size = do+  HostPtr ptr <- mallocHostArray flags size+  newForeignPtr finalizerMemFreeHost ptr++{-# INLINE cuMemHostAlloc #-}+{# fun unsafe cuMemHostAlloc+  { alloca'-        `HostPtr a'   peekHP*+  ,                 `Int'+  , combineBitMasks `[AllocFlag]'         } -> `Status' cToEnum #}+  where+    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)+    peekHP !p  = HostPtr . castPtr <$> peek p++-- Pointer to the foreign function to release host arrays, which may be used as+-- a finalizer. Technically this function has a non-void return type, but I am+-- hoping that that doesn't matter...+--+foreign import ccall "&cuMemFreeHost" finalizerMemFreeHost :: FinalizerPtr a++-- |+-- Free a section of page-locked host memory.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g62e0fdbe181dab6b1c90fa1a51c7b92c>+--+{-# INLINEABLE freeHost #-}+freeHost :: HostPtr a -> IO ()+freeHost !p = nothingIfOk =<< cuMemFreeHost p++{-# INLINE cuMemFreeHost #-}+{# fun unsafe cuMemFreeHost+  { useHP `HostPtr a' } -> `Status' cToEnum #}+  where+    useHP = castPtr . useHostPtr+++-- |+-- Page-locks the specified array (on the host) and maps it for the device(s) as+-- specified by the given allocation flags. Subsequently, the memory is accessed+-- directly by the device so can be read and written with much higher bandwidth+-- than pageable memory that has not been registered. The memory range is added+-- to the same tracking mechanism as 'mallocHostArray' to automatically+-- accelerate calls to functions such as 'pokeArray'.+--+-- Note that page-locking excessive amounts of memory may degrade system+-- performance, since it reduces the amount of pageable memory available. This+-- is best used sparingly to allocate staging areas for data exchange.+--+-- This function has limited support on Mac OS X. OS 10.7 or later is+-- required.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf0a9fe11544326dabd743b7aa6b54223>+--+{-# INLINEABLE registerArray #-}+registerArray :: Storable a => [AllocFlag] -> Int -> Ptr a -> IO (HostPtr a)+#if CUDA_VERSION < 4000+registerArray _ _ _     = requireSDK 'registerArray 4.0+#else+registerArray !flags !n = go undefined+  where+    go :: Storable b => b -> Ptr b -> IO (HostPtr b)+    go x !p = do+      status <- cuMemHostRegister p (n * sizeOf x) flags+      resultIfOk (status,HostPtr p)++{-# INLINE cuMemHostRegister #-}+{# fun unsafe cuMemHostRegister+  { castPtr         `Ptr a'+  ,                 `Int'+  , combineBitMasks `[AllocFlag]' } -> `Status' cToEnum #}+#endif+++-- |+-- Unmaps the memory from the given pointer, and makes it pageable again.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g63f450c8125359be87b7623b1c0b2a14>+--+{-# INLINEABLE unregisterArray #-}+unregisterArray :: HostPtr a -> IO (Ptr a)+#if CUDA_VERSION < 4000+unregisterArray _           = requireSDK 'unregisterArray 4.0+#else+unregisterArray (HostPtr !p) = do+  status <- cuMemHostUnregister p+  resultIfOk (status,p)++{-# INLINE cuMemHostUnregister #-}+{# fun unsafe cuMemHostUnregister+  { castPtr `Ptr a' } -> `Status' cToEnum #}+#endif+++--------------------------------------------------------------------------------+-- 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 suitably aligned for any type, and is not cleared.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gb82d2a09844a58dd9e744dc31e8aa467>+--+{-# 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 =<< cuMemAlloc (n * sizeOf x)++{-# INLINE cuMemAlloc #-}+{# fun unsafe cuMemAlloc+  { alloca'- `DevicePtr a' peekDeviceHandle*+  ,          `Int'                           } -> `Status' cToEnum #}+  where+    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)+++-- |+-- Execute a computation on the device, 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 want to add a+-- synchronisation point using 'Foreign.CUDA.Driver.Context.sync' as part+-- of the continuation.+--+{-# INLINEABLE allocaArray #-}+allocaArray :: Storable a => Int -> (DevicePtr a -> IO b) -> IO b+allocaArray !n = bracket (mallocArray n) free+++-- |+-- Release a section of device memory.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g89b3f154e17cc89b6eea277dbdf5c93a>+--+{-# INLINEABLE free #-}+free :: DevicePtr a -> IO ()+free !dp = nothingIfOk =<< cuMemFree dp++{-# INLINE cuMemFree #-}+{# fun unsafe cuMemFree+  { useDeviceHandle `DevicePtr a' } -> `Status' cToEnum #}+++--------------------------------------------------------------------------------+-- Unified memory allocations+--------------------------------------------------------------------------------++-- |+-- Options for unified memory allocations+--+#if CUDA_VERSION < 6000+data AttachFlag+#else+{# enum CUmemAttach_flags as AttachFlag+    { underscoreToCase }+    with prefix="CU_MEM_ATTACH_OPTION" deriving (Eq, Show, Bounded) #}+#endif++-- |+-- Allocates memory that will be automatically managed by the Unified Memory+-- system. The returned pointer is valid on the CPU and on all GPUs which+-- supported managed memory. All accesses to this pointer must obey the+-- Unified Memory programming model.+--+-- On a multi-GPU system with peer-to-peer support, where multiple GPUs+-- support managed memory, the physical storage is created on the GPU which+-- is active at the time 'mallocManagedArray' is called. All other GPUs+-- will access the array at reduced bandwidth via peer mapping over the+-- PCIe bus. The Unified Memory system does not migrate memory between+-- GPUs.+--+-- On a multi-GPU system where multiple GPUs support managed memory, but+-- not all pairs of such GPUs have peer-to-peer support between them, the+-- physical storage is allocated in system memory (zero-copy memory) and+-- all GPUs will access the data at reduced bandwidth over the PCIe bus.+--+-- Requires CUDA-6.0+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gb347ded34dc326af404aa02af5388a32>+--+{-# INLINEABLE mallocManagedArray #-}+mallocManagedArray :: Storable a => [AttachFlag] -> Int -> IO (DevicePtr a)+#if CUDA_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 =<< cuMemAllocManaged (n * sizeOf x) flags++{-# INLINE cuMemAllocManaged #-}+{# fun unsafe cuMemAllocManaged+  { alloca'-        `DevicePtr a' peekDeviceHandle*+  ,                 `Int'+  , combineBitMasks `[AttachFlag]'                  } -> `Status' cToEnum #}+  where+    alloca' !f = F.alloca $ \ !p -> poke p nullPtr >> f (castPtr p)+#endif+++--------------------------------------------------------------------------------+-- Marshalling+--------------------------------------------------------------------------------++-- Device -> Host+-- --------------++-- |+-- Copy a number of elements from the device to host memory. This is a+-- synchronous operation.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g3480368ee0208a98f75019c9a8450893>+--+{-# INLINEABLE peekArray #-}+peekArray :: Storable a => Int -> DevicePtr a -> Ptr a -> IO ()+peekArray !n !dptr !hptr = doPeek undefined dptr+  where+    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPeek x _ = nothingIfOk =<< cuMemcpyDtoH hptr dptr (n * sizeOf x)++{-# INLINE cuMemcpyDtoH #-}+{# fun cuMemcpyDtoH+  { castPtr         `Ptr a'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'         } -> `Status' cToEnum #}+++-- |+-- Copy memory from the device asynchronously, possibly associated with a+-- particular stream. The destination host memory must be page-locked.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g56f30236c7c5247f8e061b59d3268362>+--+{-# INLINEABLE peekArrayAsync #-}+peekArrayAsync :: Storable a => Int -> DevicePtr a -> HostPtr a -> Maybe Stream -> IO ()+peekArrayAsync !n !dptr !hptr !mst = doPeek undefined dptr+  where+    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPeek x _ = nothingIfOk =<< cuMemcpyDtoHAsync hptr dptr (n * sizeOf x) (fromMaybe defaultStream mst)++{-# INLINE cuMemcpyDtoHAsync #-}+{# fun cuMemcpyDtoHAsync+  { useHP           `HostPtr a'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}+  where+    useHP = castPtr . useHostPtr+++-- |+-- Copy a 2D array from the device to the host.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>+--+{-# INLINEABLE peekArray2D #-}+peekArray2D+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> DevicePtr a              -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> Ptr a                    -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> IO ()+peekArray2D !w !h !dptr !dw !dx !dy !hptr !hw !hx !hy = doPeek undefined dptr+  where+    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPeek x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+      in+      nothingIfOk =<< cuMemcpy2DDtoH hptr hw' hx' hy dptr dw' dx' dy w' h++{-# INLINE cuMemcpy2DDtoH #-}+{# fun cuMemcpy2DDtoH+  { castPtr         `Ptr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  }+  -> `Status' cToEnum #}+++-- |+-- Copy a 2D array from the device to the host asynchronously, possibly+-- associated with a particular execution stream. The destination host memory+-- must be page-locked.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>+--+{-# INLINEABLE peekArray2DAsync #-}+peekArray2DAsync+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> DevicePtr a              -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> HostPtr a                -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> Maybe Stream             -- ^ stream to associate to+    -> IO ()+peekArray2DAsync !w !h !dptr !dw !dx !dy !hptr !hw !hx !hy !mst = doPeek undefined dptr+  where+    doPeek :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPeek x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+          st    = fromMaybe defaultStream mst+      in+      nothingIfOk =<< cuMemcpy2DDtoHAsync hptr hw' hx' hy dptr dw' dx' dy w' h st++{-# INLINE cuMemcpy2DDtoHAsync #-}+{# fun cuMemcpy2DDtoHAsync+  { useHP           `HostPtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useStream       `Stream'+  }+  -> `Status' cToEnum #}+  where+    useHP = castPtr . useHostPtr+++-- |+-- 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+++-- Host -> Device+-- --------------++-- |+-- Copy a number of elements onto the device. This is a synchronous operation.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4d32266788c440b0220b1a9ba5795169>+--+{-# INLINEABLE pokeArray #-}+pokeArray :: Storable a => Int -> Ptr a -> DevicePtr a -> IO ()+pokeArray !n !hptr !dptr = doPoke undefined dptr+  where+    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPoke x _ = nothingIfOk =<< cuMemcpyHtoD dptr hptr (n * sizeOf x)++{-# INLINE cuMemcpyHtoD #-}+{# fun cuMemcpyHtoD+  { useDeviceHandle `DevicePtr a'+  , castPtr         `Ptr a'+  ,                 `Int'         } -> `Status' cToEnum #}+++-- |+-- Copy memory onto the device asynchronously, possibly associated with a+-- particular stream. The source host memory must be page-locked.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g1572263fe2597d7ba4f6964597a354a3>+--+{-# INLINEABLE pokeArrayAsync #-}+pokeArrayAsync :: Storable a => Int -> HostPtr a -> DevicePtr a -> Maybe Stream -> IO ()+pokeArrayAsync !n !hptr !dptr !mst = dopoke undefined dptr+  where+    dopoke :: Storable a' => a' -> DevicePtr a' -> IO ()+    dopoke x _ = nothingIfOk =<< cuMemcpyHtoDAsync dptr hptr (n * sizeOf x) (fromMaybe defaultStream mst)++{-# INLINE cuMemcpyHtoDAsync #-}+{# fun cuMemcpyHtoDAsync+  { useDeviceHandle `DevicePtr a'+  , useHP           `HostPtr a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}+  where+    useHP = castPtr . useHostPtr+++-- |+-- Copy a 2D array from the host to the device.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>+--+{-# INLINEABLE pokeArray2D #-}+pokeArray2D+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> Ptr a                    -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> DevicePtr a              -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> IO ()+pokeArray2D !w !h !hptr !hw !hx !hy !dptr !dw !dx !dy = doPoke undefined dptr+  where+    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPoke x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+      in+      nothingIfOk =<< cuMemcpy2DHtoD dptr dw' dx' dy hptr hw' hx' hy w' h++{-# INLINE cuMemcpy2DHtoD #-}+{# fun cuMemcpy2DHtoD+  { useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , castPtr         `Ptr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  }+  -> `Status' cToEnum #}+++-- |+-- Copy a 2D array from the host to the device asynchronously, possibly+-- associated with a particular execution stream. The source host memory must be+-- page-locked.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>+--+{-# INLINEABLE pokeArray2DAsync #-}+pokeArray2DAsync+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> HostPtr a                -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> DevicePtr a              -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> Maybe Stream             -- ^ stream to associate to+    -> IO ()+pokeArray2DAsync !w !h !hptr !hw !hx !hy !dptr !dw !dx !dy !mst = doPoke undefined dptr+  where+    doPoke :: Storable a' => a' -> DevicePtr a' -> IO ()+    doPoke x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+          st    = fromMaybe defaultStream mst+      in+      nothingIfOk =<< cuMemcpy2DHtoDAsync dptr dw' dx' dy hptr hw' hx' hy w' h st++{-# INLINE cuMemcpy2DHtoDAsync #-}+{# fun cuMemcpy2DHtoDAsync+  { useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useHP           `HostPtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useStream       `Stream'+  }+  -> `Status' cToEnum #}+  where+    useHP = castPtr . useHostPtr+++-- |+-- Write a list of storable elements into a device array. The device 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+++-- Device -> Device+-- ----------------++-- |+-- Copy the given number of elements from the first device array (source) to the+-- second device (destination). The copied areas may not overlap. This operation+-- is asynchronous with respect to the host, but will never overlap with kernel+-- execution.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g1725774abf8b51b91945f3336b778c8b>+--+{-# INLINEABLE copyArray #-}+copyArray :: Storable a => Int -> DevicePtr a -> DevicePtr a -> IO ()+copyArray !n = docopy undefined+  where+    docopy :: Storable a' => a' -> DevicePtr a' -> DevicePtr a' -> IO ()+    docopy x src dst = nothingIfOk =<< cuMemcpyDtoD dst src (n * sizeOf x)++{-# INLINE cuMemcpyDtoD #-}+{# fun unsafe cuMemcpyDtoD+  { useDeviceHandle `DevicePtr a'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'         } -> `Status' cToEnum #}+++-- |+-- Copy the given number of elements from the first device array (source) to the+-- second device array (destination). The copied areas may not overlap. The+-- operation is asynchronous with respect to the host, and can be asynchronous+-- to other device operations by associating it with a particular stream.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g39ea09ba682b8eccc9c3e0c04319b5c8>+--+{-# INLINEABLE copyArrayAsync #-}+copyArrayAsync :: Storable a => Int -> DevicePtr a -> DevicePtr a -> Maybe Stream -> IO ()+copyArrayAsync !n !src !dst !mst = docopy undefined src+  where+    docopy :: Storable a' => a' -> DevicePtr a' -> IO ()+    docopy x _ = nothingIfOk =<< cuMemcpyDtoDAsync dst src (n * sizeOf x) (fromMaybe defaultStream mst)++{-# INLINE cuMemcpyDtoDAsync #-}+{# fun unsafe cuMemcpyDtoDAsync+  { useDeviceHandle `DevicePtr a'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}+++-- |+-- Copy a 2D array from the first device array (source) to the second device+-- array (destination). The copied areas must not overlap. This operation is+-- asynchronous with respect to the host, but will never overlap with kernel+-- execution.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g27f885b30c34cc20a663a671dbf6fc27>+--+{-# INLINEABLE copyArray2D #-}+copyArray2D+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> DevicePtr a              -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> DevicePtr a              -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> IO ()+copyArray2D !w !h !src !hw !hx !hy !dst !dw !dx !dy = doCopy undefined dst+  where+    doCopy :: Storable a' => a' -> DevicePtr a' -> IO ()+    doCopy x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+      in+      nothingIfOk =<< cuMemcpy2DDtoD dst dw' dx' dy src hw' hx' hy w' h++{-# INLINE cuMemcpy2DDtoD #-}+{# fun unsafe cuMemcpy2DDtoD+  { useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  }+  -> `Status' cToEnum #}+++-- |+-- Copy a 2D array from the first device array (source) to the second device+-- array (destination). The copied areas may not overlap. The operation is+-- asynchronous with respect to the host, and can be asynchronous to other+-- device operations by associating it with a particular execution stream.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g4acf155faeb969d9d21f5433d3d0f274>+--+{-# INLINEABLE copyArray2DAsync #-}+copyArray2DAsync+    :: Storable a+    => Int                      -- ^ width to copy (elements)+    -> Int                      -- ^ height to copy (elements)+    -> DevicePtr a              -- ^ source array+    -> Int                      -- ^ source array width+    -> Int                      -- ^ source x-coordinate+    -> Int                      -- ^ source y-coordinate+    -> DevicePtr a              -- ^ destination array+    -> Int                      -- ^ destination array width+    -> Int                      -- ^ destination x-coordinate+    -> Int                      -- ^ destination y-coordinate+    -> Maybe Stream             -- ^ stream to associate to+    -> IO ()+copyArray2DAsync !w !h !src !hw !hx !hy !dst !dw !dx !dy !mst = doCopy undefined dst+  where+    doCopy :: Storable a' => a' -> DevicePtr a' -> IO ()+    doCopy x _ =+      let bytes = sizeOf x+          w'    = w  * bytes+          hw'   = hw * bytes+          hx'   = hx * bytes+          dw'   = dw * bytes+          dx'   = dx * bytes+          st    = fromMaybe defaultStream mst+      in+      nothingIfOk =<< cuMemcpy2DDtoDAsync dst dw' dx' dy src hw' hx' hy w' h st++{-# INLINE cuMemcpy2DDtoDAsync #-}+{# fun unsafe cuMemcpy2DDtoDAsync+  { useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useDeviceHandle `DevicePtr a'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  ,                 `Int'+  , useStream       `Stream'+  }+  -> `Status' cToEnum #}++++-- Context -> Context+-- ------------------++-- |+-- Copies an array from device memory in one context to device memory in another+-- context. Note that this function is asynchronous with respect to the host,+-- but serialised with respect to all pending and future asynchronous work in+-- the source and destination contexts. To avoid this synchronisation, use+-- 'copyArrayPeerAsync' instead.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1ge1f5c7771544fee150ada8853c7cbf4a>+--+{-# INLINEABLE copyArrayPeer #-}+copyArrayPeer :: Storable a+              => Int                            -- ^ number of array elements+              -> DevicePtr a -> Context         -- ^ source array and context+              -> DevicePtr a -> Context         -- ^ destination array and context+              -> IO ()+#if CUDA_VERSION < 4000+copyArrayPeer _ _ _ _ _                    = requireSDK 'copyArrayPeer 4.0+#else+copyArrayPeer !n !src !srcCtx !dst !dstCtx = go undefined src dst+  where+    go :: Storable b => b -> DevicePtr b -> DevicePtr b -> IO ()+    go x _ _ = nothingIfOk =<< cuMemcpyPeer dst dstCtx src srcCtx (n * sizeOf x)++{-# INLINE cuMemcpyPeer #-}+{# fun unsafe cuMemcpyPeer+  { useDeviceHandle `DevicePtr a'+  , useContext      `Context'+  , useDeviceHandle `DevicePtr a'+  , useContext      `Context'+  ,                 `Int'         } -> `Status' cToEnum #}+#endif+++-- |+-- Copies from device memory in one context to device memory in another context.+-- Note that this function is asynchronous with respect to the host and all work+-- in other streams and devices.+--+-- Requires CUDA-4.0.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g82fcecb38018e64b98616a8ac30112f2>+--+{-# INLINEABLE copyArrayPeerAsync #-}+copyArrayPeerAsync :: Storable a+                   => Int                       -- ^ number of array elements+                   -> DevicePtr a -> Context    -- ^ source array and context+                   -> DevicePtr a -> Context    -- ^ destination array and device context+                   -> Maybe Stream              -- ^ stream to associate with+                   -> IO ()+#if CUDA_VERSION < 4000+copyArrayPeerAsync _ _ _ _ _ _                      = requireSDK 'copyArrayPeerAsync 4.0+#else+copyArrayPeerAsync !n !src !srcCtx !dst !dstCtx !st = go undefined src dst+  where+    go :: Storable b => b -> DevicePtr b -> DevicePtr b -> IO ()+    go x _ _ = nothingIfOk =<< cuMemcpyPeerAsync dst dstCtx src srcCtx (n * sizeOf x) stream+    stream   = fromMaybe defaultStream st++{-# INLINE cuMemcpyPeerAsync #-}+{# fun unsafe cuMemcpyPeerAsync+  { useDeviceHandle `DevicePtr a'+  , useContext      `Context'+  , useDeviceHandle `DevicePtr a'+  , useContext      `Context'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}+#endif+++--------------------------------------------------------------------------------+-- 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 memory copies: firstly from a Haskell+-- list to a heap allocated array, and from there onto the graphics device. The+-- memory 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 to the array, the result of which is returned.+-- Similar to 'newListArray', this requires copying the data twice.+--+-- As with 'allocaArray', the memory is freed once the action completes, so you+-- should not return the pointer from the action, and be wary of asynchronous+-- kernel execution.+--+{-# 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+--------------------------------------------------------------------------------++-- |+-- Set a number of data elements to the specified value, which may be either 8-,+-- 16-, or 32-bits wide.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g6e582bf866e9e2fb014297bfaf354d7b>+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g7d805e610054392a4d11e8a8bf5eb35c>+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g983e8d8759acd1b64326317481fbf132>+--+{-# INLINEABLE memset #-}+memset :: Storable a => DevicePtr a -> Int -> a -> IO ()+memset !dptr !n !val = case sizeOf val of+    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"++--+-- We use unsafe coerce below to reinterpret the bits of the value to memset as,+-- into the integer type required by the setting functions.+--+{-# INLINE cuMemsetD8 #-}+{# fun unsafe cuMemsetD8+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'         } -> `Status' cToEnum #}++{-# INLINE cuMemsetD16 #-}+{# fun unsafe cuMemsetD16+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'         } -> `Status' cToEnum #}++{-# INLINE cuMemsetD32 #-}+{# fun unsafe cuMemsetD32+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'         } -> `Status' cToEnum #}+++-- |+-- Set the number of data elements to the specified value, which may be either+-- 8-, 16-, or 32-bits wide. The operation is asynchronous and may optionally be+-- associated with a stream.+--+-- Requires CUDA-3.2.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gaef08a7ccd61112f94e82f2b30d43627>+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1gf731438877dd8ec875e4c43d848c878c>+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g58229da5d30f1c0cdf667b320ec2c0f5>+--+{-# INLINEABLE memsetAsync #-}+memsetAsync :: Storable a => DevicePtr a -> Int -> a -> Maybe Stream -> IO ()+#if CUDA_VERSION < 3020+memsetAsync _ _ _ _            = requireSDK 'memsetAsync 3.2+#else+memsetAsync !dptr !n !val !mst = case sizeOf val of+    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"+    where+      stream = fromMaybe defaultStream mst++{-# INLINE cuMemsetD8Async #-}+{# fun unsafe cuMemsetD8Async+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}++{-# INLINE cuMemsetD16Async #-}+{# fun unsafe cuMemsetD16Async+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}++{-# INLINE cuMemsetD32Async #-}+{# fun unsafe cuMemsetD32Async+  { useDeviceHandle `DevicePtr a'+  , unsafeCoerce    `a'+  ,                 `Int'+  , useStream       `Stream'      } -> `Status' cToEnum #}+#endif+++-- |+-- Return the device pointer associated with a mapped, pinned host buffer, which+-- was allocated with the 'DeviceMapped' option by 'mallocHostArray'.+--+-- Currently, no options are supported and this must be empty.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g57a39e5cba26af4d06be67fc77cc62f0>+--+{-# INLINEABLE getDevicePtr #-}+getDevicePtr :: [AllocFlag] -> HostPtr a -> IO (DevicePtr a)+getDevicePtr !flags !hp = resultIfOk =<< cuMemHostGetDevicePointer hp flags++{-# INLINE cuMemHostGetDevicePointer #-}+{# fun unsafe cuMemHostGetDevicePointer+  { alloca'-        `DevicePtr a' peekDeviceHandle*+  , useHP           `HostPtr a'+  , combineBitMasks `[AllocFlag]'                   } -> `Status' cToEnum #}+  where+    alloca'  = F.alloca+    useHP    = castPtr . useHostPtr+++-- |+-- Return the base address and allocation size of the given device pointer.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g64fee5711274a2a0573a789c94d8299b>+--+{-# INLINEABLE getBasePtr #-}+getBasePtr :: DevicePtr a -> IO (DevicePtr a, Int64)+getBasePtr !dptr = do+  (status,base,size) <- cuMemGetAddressRange dptr+  resultIfOk (status, (base,size))++{-# INLINE cuMemGetAddressRange #-}+{# fun unsafe cuMemGetAddressRange+  { alloca'-        `DevicePtr a' peekDeviceHandle*+  , alloca'-        `Int64'       peekIntConv*+  , useDeviceHandle `DevicePtr a'                   } -> `Status' cToEnum #}+  where+    alloca' :: Storable a => (Ptr a -> IO b) -> IO b+    alloca' = F.alloca++-- |+-- Return the amount of free and total memory respectively available to the+-- current context (bytes).+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MEM.html#group__CUDA__MEM_1g808f555540d0143a331cc42aa98835c0>+--+{-# INLINEABLE getMemInfo #-}+getMemInfo :: IO (Int64, Int64)+getMemInfo = do+  (!status,!f,!t) <- cuMemGetInfo+  resultIfOk (status,(f,t))++{-# INLINE cuMemGetInfo #-}+{# fun unsafe cuMemGetInfo+  { alloca'- `Int64' peekIntConv*+  , alloca'- `Int64' peekIntConv* } -> `Status' cToEnum #}+  where+    alloca' = F.alloca+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++type DeviceHandle = {# type CUdeviceptr #}++-- Lift an opaque handle to a typed DevicePtr representation. This occasions+-- arcane distinctions for the different driver versions and Tesla (compute 1.x)+-- and Fermi (compute 2.x) class architectures on 32- and 64-bit hosts.+--+{-# INLINE peekDeviceHandle #-}+peekDeviceHandle :: Ptr DeviceHandle -> IO (DevicePtr a)+peekDeviceHandle !p = DevicePtr . intPtrToPtr . fromIntegral <$> peek p++-- Use a device pointer as an opaque handle type+--+{-# INLINE useDeviceHandle #-}+useDeviceHandle :: DevicePtr a -> DeviceHandle+useDeviceHandle = fromIntegral . ptrToIntPtr . useDevicePtr+
+ src/Foreign/CUDA/Driver/Module.hs view
@@ -0,0 +1,20 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Module+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Module management for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Module (++  module Foreign.CUDA.Driver.Module.Base,+  module Foreign.CUDA.Driver.Module.Query,++) where++import Foreign.CUDA.Driver.Module.Base  hiding ( JITOptionInternal(..), useModule, jitOptionUnpack, jitTargetOfCompute )+import Foreign.CUDA.Driver.Module.Query+
+ src/Foreign/CUDA/Driver/Module/Base.chs view
@@ -0,0 +1,322 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+{-# OPTIONS_HADDOCK prune #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Module.Base+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Module loading for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Module.Base (++  -- * Module Management+  Module(..),+  JITOption(..), JITTarget(..), JITResult(..), JITFallback(..), JITInputType(..),+  JITOptionInternal(..),++  -- ** Loading and unloading modules+  loadFile,+  loadData,   loadDataFromPtr,+  loadDataEx, loadDataFromPtrEx,+  unload,++  -- Internal+  jitOptionUnpack, jitTargetOfCompute,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Analysis.Device+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+import Unsafe.Coerce++import Control.Monad                                    ( liftM )+import Data.ByteString.Char8                            ( ByteString )+import qualified Data.ByteString.Char8                  as B+import qualified Data.ByteString.Internal               as B+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A reference to a Module object, containing collections of device functions+--+newtype Module = Module { useModule :: {# type CUmodule #}}+  deriving (Eq, Show)++-- |+-- Just-in-time compilation and linking options+--+data JITOption+  = MaxRegisters       !Int             -- ^ maximum number of registers per thread+  | ThreadsPerBlock    !Int             -- ^ number of threads per block to target for+  | OptimisationLevel  !Int             -- ^ level of optimisation to apply (1-4, default 4)+  | Target             !Compute         -- ^ compilation target, otherwise determined from context+  | FallbackStrategy   !JITFallback     -- ^ fallback strategy if matching cubin not found+  | GenerateDebugInfo                   -- ^ generate debug info (-g) (requires cuda >= 5.5)+  | GenerateLineInfo                    -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)+  | Verbose                             -- ^ verbose log messages (requires cuda >= 5.5)+  deriving (Show)++-- |+-- Results of online compilation+--+data JITResult = JITResult+  {+    jitTime     :: !Float,              -- ^ milliseconds spent compiling PTX+    jitInfoLog  :: !ByteString,         -- ^ information about PTX assembly+    jitModule   :: !Module              -- ^ the compiled module+  }+  deriving (Show)+++-- |+-- Online compilation target architecture+--+{# enum CUjit_target as JITTarget+    { underscoreToCase }+    with prefix="CU_TARGET" deriving (Eq, Show) #}++-- |+-- Online compilation fallback strategy+--+{# enum CUjit_fallback as JITFallback+    { underscoreToCase+    , CU_PREFER_PTX as PreferPTX }+    with prefix="CU" deriving (Eq, Show) #}++-- |+-- Device code formats that can be used for online linking+--+#if CUDA_VERSION < 5050+data JITInputType+#else+{# enum CUjitInputType as JITInputType+    { underscoreToCase+    , CU_JIT_INPUT_PTX as PTX }+    with prefix="CU_JIT_INPUT" deriving (Eq, Show) #}+#endif++{# enum CUjit_option as JITOptionInternal+    { }+    with prefix="CU" deriving (Eq, Show) #}+++--------------------------------------------------------------------------------+-- Module management+--------------------------------------------------------------------------------++-- |+-- Load the contents of the specified file (either a ptx or cubin file) to+-- create a new module, and load that module into the current context.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g366093bd269dafd0af21f1c7d18115d3>+--+{-# INLINEABLE loadFile #-}+loadFile :: FilePath -> IO Module+loadFile !ptx = resultIfOk =<< cuModuleLoad ptx++{-# INLINE cuModuleLoad #-}+{# fun unsafe cuModuleLoad+  { alloca-      `Module'   peekMod*+  , withCString* `FilePath'          } -> `Status' cToEnum #}+++-- |+-- Load the contents of the given image into a new module, and load that module+-- into the current context. The image is (typically) the contents of a cubin or+-- PTX file.+--+-- Note that the 'ByteString' will be copied into a temporary staging area so+-- that it can be passed to C.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g04ce266ce03720f479eab76136b90c0b>+--+{-# INLINEABLE loadData #-}+loadData :: ByteString -> IO Module+loadData !img =+  B.useAsCString img (\p -> loadDataFromPtr (castPtr p))++-- |+-- As 'loadData', but read the image data from the given pointer. The image is a+-- NULL-terminated sequence of bytes.+--+{-# INLINEABLE loadDataFromPtr #-}+loadDataFromPtr :: Ptr Word8 -> IO Module+loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img++{-# INLINE cuModuleLoadData #-}+{# fun unsafe cuModuleLoadData+  { alloca- `Module'    peekMod*+  , castPtr `Ptr Word8'          } -> ` Status' cToEnum #}+++-- |+-- Load the contents of the given image into a module with online compiler+-- options, and load the module into the current context. The image is+-- (typically) the contents of a cubin or PTX file. The actual attributes of the+-- compiled kernel can be probed using 'requires'.+--+-- Note that the 'ByteString' will be copied into a temporary staging area so+-- that it can be passed to C.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9e8047e9dbf725f0cd7cafd18bfd4d12>+--+{-# INLINEABLE loadDataEx #-}+loadDataEx :: ByteString -> [JITOption] -> IO JITResult+loadDataEx !img !options =+  B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)++-- |+-- As 'loadDataEx', but read the image data from the given pointer. The image is+-- a NULL-terminated sequence of bytes.+--+{-# INLINEABLE loadDataFromPtrEx #-}+loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult+loadDataFromPtrEx !img !options = do+  let logSize = 2048++  fp_ilog <- B.mallocByteString logSize++  allocaArray logSize    $ \p_elog -> do+  withForeignPtr fp_ilog $ \p_ilog -> do++  let (opt,val) = unzip $+        [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below+        , (JIT_INFO_LOG_BUFFER_SIZE_BYTES,  logSize)+        , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize)+        , (JIT_INFO_LOG_BUFFER,  unsafeCoerce (p_ilog :: CString))+        , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString))+        ]+        +++        map jitOptionUnpack options++  withArrayLen (map cFromEnum opt)    $ \i p_opts -> do+  withArray    (map unsafeCoerce val) $ \  p_vals -> do++  (s,mdl) <- cuModuleLoadDataEx img i p_opts p_vals++  case s of+    Success -> do+      time    <- peek (castPtr p_vals)+      bytes   <- c_strnlen p_ilog logSize+      let infoLog | bytes == 0 = B.empty+                  | otherwise  = B.fromForeignPtr (castForeignPtr fp_ilog) 0 bytes+      return  $! JITResult time infoLog mdl++    _       -> do+      errLog  <- peekCString p_elog+      cudaError (unlines [describe s, errLog])+++{-# INLINE cuModuleLoadDataEx #-}+{# fun unsafe cuModuleLoadDataEx+  { alloca- `Module'       peekMod*+  , castPtr `Ptr Word8'+  ,         `Int'+  , id      `Ptr CInt'+  , id      `Ptr (Ptr ())'          } -> `Status' cToEnum #}+++-- |+-- Unload a module from the current context.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g8ea3d716524369de3763104ced4ea57b>+--+{-# INLINEABLE unload #-}+unload :: Module -> IO ()+unload !m = nothingIfOk =<< cuModuleUnload m++{-# INLINE cuModuleUnload #-}+{# fun unsafe cuModuleUnload+  { useModule `Module' } -> `Status' cToEnum #}+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++{-# INLINE peekMod #-}+peekMod :: Ptr {# type CUmodule #} -> IO Module+peekMod = liftM Module . peek+++{-# INLINE jitOptionUnpack #-}+jitOptionUnpack :: JITOption -> (JITOptionInternal, Int)+jitOptionUnpack (MaxRegisters x)      = (JIT_MAX_REGISTERS,       x)+jitOptionUnpack (ThreadsPerBlock x)   = (JIT_THREADS_PER_BLOCK,   x)+jitOptionUnpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL,  x)+jitOptionUnpack (Target x)            = (JIT_TARGET,              fromEnum (jitTargetOfCompute x))+jitOptionUnpack (FallbackStrategy x)  = (JIT_FALLBACK_STRATEGY,   fromEnum x)+#if CUDA_VERSION >= 5050+jitOptionUnpack GenerateDebugInfo     = (JIT_GENERATE_DEBUG_INFO, fromEnum True)+jitOptionUnpack GenerateLineInfo      = (JIT_GENERATE_LINE_INFO,  fromEnum True)+jitOptionUnpack Verbose               = (JIT_LOG_VERBOSE,         fromEnum True)+#else+jitOptionUnpack GenerateDebugInfo     = requireSDK 'GenerateDebugInfo 5.5+jitOptionUnpack GenerateLineInfo      = requireSDK 'GenerateLineInfo 5.5+jitOptionUnpack Verbose               = requireSDK 'Verbose 5.5+#endif+++{-# INLINE jitTargetOfCompute #-}+jitTargetOfCompute :: Compute -> JITTarget+jitTargetOfCompute (Compute 1 0) = Compute10+jitTargetOfCompute (Compute 1 1) = Compute11+jitTargetOfCompute (Compute 1 2) = Compute12+jitTargetOfCompute (Compute 1 3) = Compute13+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)+
+ src/Foreign/CUDA/Driver/Module/Link.chs view
@@ -0,0 +1,224 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Module.Link+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Module linking for low-level driver interface+--+-- Since CUDA-5.5+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Module.Link (++  -- ** JIT module linking+  LinkState, JITOption(..), JITInputType(..),++  create, destroy, complete,+  addFile,+  addData, addDataFromPtr,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Driver.Module.Base+import Foreign.CUDA.Internal.C2HS++-- System+import Control.Monad                                    ( liftM )+import Foreign+import Foreign.C+import Unsafe.Coerce++import Data.ByteString.Char8                            ( ByteString )+import qualified Data.ByteString.Char8                  as B+++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- |+-- A pending JIT linker state+--+#if CUDA_VERSION < 5050+data LinkState+#else+newtype LinkState = LinkState { useLinkState :: {# type CUlinkState #} }+  deriving (Show)+#endif+++--------------------------------------------------------------------------------+-- JIT linking+--------------------------------------------------------------------------------++-- |+-- Create a pending JIT linker invocation. The returned 'LinkState' should+-- be 'destroy'ed once no longer needed. The device code machine size will+-- match the calling application.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g86ca4052a2fab369cb943523908aa80d>+--+{-# INLINEABLE create #-}+create :: [JITOption] -> IO LinkState+#if CUDA_VERSION < 5050+create _        = requireSDK 'create 5.5+#else+create !options =+  let (opt,val) = unzip $ map jitOptionUnpack options+  in+  withArray (map cFromEnum opt)    $ \p_opts ->+  withArray (map unsafeCoerce val) $ \p_vals ->+    resultIfOk =<< cuLinkCreate (length opt) p_opts p_vals++{-# INLINE cuLinkCreate #-}+{# fun unsafe cuLinkCreate+  {         `Int'+  , id      `Ptr CInt'+  , id      `Ptr (Ptr ())'+  , alloca- `LinkState'    peekLS* } -> `Status' cToEnum #}+  where+    peekLS = liftM LinkState . peek+#endif+++-- |+-- Destroy the state of a JIT linker invocation.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g01b7ae2a34047b05716969af245ce2d9>+--+{-# INLINEABLE destroy #-}+destroy :: LinkState -> IO ()+#if CUDA_VERSION < 5050+destroy _  = requireSDK 'destroy 5.5+#else+destroy !s = nothingIfOk =<< cuLinkDestroy s++{-# INLINE cuLinkDestroy #-}+{# fun unsafe cuLinkDestroy+  { useLinkState `LinkState' } -> `Status' cToEnum #}+#endif+++-- |+-- Complete a pending linker invocation and load the current module. The+-- link state will be destroyed.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g818fcd84a4150a997c0bba76fef4e716>+--+{-# INLINEABLE complete #-}+complete :: LinkState -> IO Module+#if CUDA_VERSION < 5050+complete _   = requireSDK 'complete 5.5+#else+complete !ls = do+  cubin <- resultIfOk =<< cuLinkComplete ls nullPtr+  mdl   <- loadDataFromPtr (castPtr cubin)+  destroy ls+  return mdl++{-# INLINE cuLinkComplete #-}+{# fun unsafe cuLinkComplete+  { useLinkState `LinkState'+  , alloca-      `Ptr ()'    peek*+  , castPtr      `Ptr Int'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Add an input file to a pending linker invocation.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g1224c0fd48d4a683f3ce19997f200a8c>+--+{-# INLINEABLE addFile #-}+addFile :: LinkState -> FilePath -> JITInputType -> [JITOption] -> IO ()+#if CUDA_VERSION < 5050+addFile _ _ _ _ = requireSDK 'addFile 5.5+#else+addFile !ls !fp !t !options =+  let (opt,val) = unzip $ map jitOptionUnpack options+  in+  withArrayLen (map cFromEnum opt)    $ \i p_opts ->+  withArray    (map unsafeCoerce val) $ \  p_vals ->+    nothingIfOk =<< cuLinkAddFile ls t fp i p_opts p_vals++{-# INLINE cuLinkAddFile #-}+{# fun unsafe cuLinkAddFile+  { useLinkState `LinkState'+  , cFromEnum    `JITInputType'+  , withCString* `FilePath'+  ,              `Int'+  , id           `Ptr CInt'+  , id           `Ptr (Ptr ())'+  }+  -> `Status' cToEnum #}+#endif+++-- |+-- Add an input to a pending linker invocation.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g3ebcd2ccb772ba9c120937a2d2831b77>+--+{-# INLINEABLE addData #-}+addData :: LinkState -> ByteString -> JITInputType -> [JITOption] -> IO ()+#if CUDA_VERSION < 5050+addData _ _ _ = requireSDK 'addData 5.5+#else+addData !ls !img !k !options =+  B.useAsCStringLen img (\(p, n) -> addDataFromPtr ls n (castPtr p) k options)+#endif++-- |+-- As 'addData', but read the specified number of bytes of image data from+-- the given pointer.+--+{-# INLINEABLE addDataFromPtr #-}+addDataFromPtr :: LinkState -> Int -> Ptr Word8 -> JITInputType -> [JITOption] -> IO ()+#if CUDA_VERSION < 5050+addDataFromPtr _ _ _ _ = requireSDK 'addDataFromPtr 5.5+#else+addDataFromPtr !ls !n !img !t !options =+  let (opt,val) = unzip $ map jitOptionUnpack options+  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++{-# INLINE cuLinkAddData #-}+{# fun unsafe cuLinkAddData+  { useLinkState `LinkState'+  , cFromEnum    `JITInputType'+  , castPtr      `Ptr Word8'+  ,              `Int'+  ,              `String'+  ,              `Int'+  , id           `Ptr CInt'+  , id           `Ptr (Ptr ())'+  }+  -> `Status' cToEnum #}+#endif+
+ src/Foreign/CUDA/Driver/Module/Query.chs view
@@ -0,0 +1,108 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Module.Query+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Querying module attributes for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Module.Query (++  -- ** Querying module inhabitants+  getFun, getPtr, getTex,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Error+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++-- System+import Foreign+import Foreign.C+import Control.Exception                                ( throwIO )+import Control.Monad                                    ( liftM )+++--------------------------------------------------------------------------------+-- Querying module attributes+--------------------------------------------------------------------------------++-- |+-- Returns a function handle.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1ga52be009b0d4045811b30c965e1cb2cf>+--+{-# INLINEABLE getFun #-}+getFun :: Module -> String -> 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+++-- |+-- Return a global pointer, and size of the global (in bytes).+--+-- <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 !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 #}+++--------------------------------------------------------------------------------+-- Internal+--------------------------------------------------------------------------------++{-# INLINE resultIfFound #-}+resultIfFound :: String -> String -> (Status, a) -> IO a+resultIfFound kind name (!status,!result) =+  case status of+       Success  -> return result+       NotFound -> cudaError (kind ++ ' ' : describe status ++ ": " ++ name)+       _        -> throwIO (ExitCode status)+
+ src/Foreign/CUDA/Driver/Profiler.chs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Profiler+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Profiler control for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Profiler (++  OutputMode(..),+  initialise,+  start, stop,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- friends+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- system+import Foreign+import Foreign.C+++-- | Profiler output mode+--+{# enum CUoutput_mode as OutputMode+    { underscoreToCase+    , CU_OUT_CSV as CSV }+    with prefix="CU_OUT" deriving (Eq, Show) #}+++-- | Initialise the CUDA profiler.+--+-- The configuration file is used to specify profiling options and profiling+-- counters. Refer to the "Compute Command Line Profiler User Guide" for+-- supported profiler options and counters.+--+-- Note that the CUDA profiler can not be initialised with this function if+-- another profiling tool is already active.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER>+--+{-# INLINEABLE initialise #-}+initialise+    :: FilePath     -- ^ configuration file that itemises which counters and/or options to profile+    -> FilePath     -- ^ output file where profiling results will be stored+    -> OutputMode+    -> IO ()+initialise config output mode+  = nothingIfOk =<< cuProfilerInitialize config output mode++{-# INLINE cuProfilerInitialize #-}+{# fun unsafe cuProfilerInitialize+  {           `String'+  ,           `String'+  , cFromEnum `OutputMode'+  }+  -> `Status' cToEnum #}+++-- | Begin profiling collection by the active profiling tool for the current+-- context. If profiling is already enabled, then this has no effect.+--+-- 'start' and 'stop' can be used to programatically control profiling+-- granularity, by allowing profiling to be done only on selected pieces of+-- code.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g8a5314de2292c2efac83ac7fcfa9190e>+--+{-# INLINEABLE start #-}+start :: IO ()+start = nothingIfOk =<< cuProfilerStart++{-# INLINE cuProfilerStart #-}+{# fun unsafe cuProfilerStart+  { } -> `Status' cToEnum #}+++-- | Stop profiling collection by the active profiling tool for the current+-- context, and force all pending profiler events to be written to the output+-- file. If profiling is already inactive, this has no effect.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g4d8edef6174fd90165e6ac838f320a5f>+--+{-# INLINEABLE stop #-}+stop :: IO ()+stop = nothingIfOk =<< cuProfilerStop++{-# INLINE cuProfilerStop #-}+{# fun unsafe cuProfilerStop+  { } -> `Status' cToEnum #}+
+ src/Foreign/CUDA/Driver/Stream.chs view
@@ -0,0 +1,167 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Stream+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Stream management for low-level driver interface+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Stream (++  -- * Stream Management+  Stream(..), StreamFlag,+  create, createWithPriority, destroy, finished, block, getPriority,++  defaultStream,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Types+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+import Control.Monad                                    ( liftM )+import Control.Exception                                ( throwIO )+++--------------------------------------------------------------------------------+-- Stream management+--------------------------------------------------------------------------------++-- |+-- Create a new stream.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1ga581f0c5833e21ded8b5a56594e243f4>+--+{-# INLINEABLE create #-}+create :: [StreamFlag] -> IO Stream+create !flags = resultIfOk =<< cuStreamCreate flags++{-# INLINE cuStreamCreate #-}+{# fun unsafe cuStreamCreate+  { alloca-         `Stream'       peekStream*+  , combineBitMasks `[StreamFlag]'             } -> `Status' cToEnum #}+  where+    peekStream = liftM Stream . peek+++-- |+-- Create a stream with the given priority. Work submitted to+-- a higher-priority stream may preempt work already executing in a lower+-- priority stream.+--+-- The convention is that lower numbers represent higher priorities. The+-- default priority is zero. The range of meaningful numeric priorities can+-- be queried using 'Foreign.CUDA.Driver.Context.Config.getStreamPriorityRange'.+-- If the specified priority is outside the supported numerical range, it+-- will automatically be clamped to the highest or lowest number in the+-- range.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g95c1a8c7c3dacb13091692dd9c7f7471>+--+{-# INLINEABLE createWithPriority #-}+createWithPriority :: StreamPriority -> [StreamFlag] -> IO Stream+#if CUDA_VERSION < 5050+createWithPriority _ _              = requireSDK 'createWithPriority 5.5+#else+createWithPriority !priority !flags = resultIfOk =<< cuStreamCreateWithPriority flags priority++{-# INLINE cuStreamCreateWithPriority #-}+{# fun unsafe cuStreamCreateWithPriority+  { alloca-         `Stream'         peekStream*+  , combineBitMasks `[StreamFlag]'+  , cIntConv        `StreamPriority'+  }+  -> `Status' cToEnum #}+  where+    peekStream = liftM Stream . peek+#endif+++-- |+-- Destroy a stream. If the device is still doing work in the stream when+-- 'destroy' is called, the function returns immediately and the resources+-- associated with the stream will be released automatically once the+-- device has completed all work.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g244c8833de4596bcd31a06cdf21ee758>+--+{-# INLINEABLE destroy #-}+destroy :: Stream -> IO ()+destroy !st = nothingIfOk =<< cuStreamDestroy st++{-# INLINE cuStreamDestroy #-}+{# fun unsafe cuStreamDestroy+  { useStream `Stream' } -> `Status' cToEnum #}+++-- |+-- Check if all operations in the stream have completed.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g1b0d24bbe97fa68e4bc511fb6adfeb0b>+--+{-# INLINEABLE finished #-}+finished :: Stream -> IO Bool+finished !st =+  cuStreamQuery st >>= \rv ->+  case rv of+    Success  -> return True+    NotReady -> return False+    _        -> throwIO (ExitCode rv)++{-# INLINE cuStreamQuery #-}+{# fun unsafe cuStreamQuery+  { useStream `Stream' } -> `Status' cToEnum #}+++-- |+-- Wait until the device has completed all operations in the Stream.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g15e49dd91ec15991eb7c0a741beb7dad>+--+{-# INLINEABLE block #-}+block :: Stream -> IO ()+block !st = nothingIfOk =<< cuStreamSynchronize st++{-# INLINE cuStreamSynchronize #-}+{# fun cuStreamSynchronize+  { useStream `Stream' } -> `Status' cToEnum #}+++-- |+-- Query the priority of a stream.+--+-- Requires CUDA-5.5.+--+-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g5bd5cb26915a2ecf1921807339488484>+--+{-# INLINEABLE getPriority #-}+getPriority :: Stream -> IO StreamPriority+#if CUDA_VERSION < 5050+getPriority _   = requireSDK 'getPriority 5.5+#else+getPriority !st = resultIfOk =<< cuStreamGetPriority st++{-# INLINE cuStreamGetPriority #-}+{# fun unsafe cuStreamGetPriority+  { useStream `Stream'+  , alloca-   `StreamPriority' peekIntConv*+  }+  -> `Status' cToEnum #}+#endif+
+ src/Foreign/CUDA/Driver/Texture.chs view
@@ -0,0 +1,308 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS_HADDOCK prune #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Texture+-- Copyright : [2009..2014] 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/Utils.chs view
@@ -0,0 +1,40 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Utils+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Utility functions+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Driver.Utils (++  driverVersion,++) where++#include "cbits/stubs.h"+{# context lib="cuda" #}++-- Friends+import Foreign.CUDA.Driver.Error+import Foreign.CUDA.Internal.C2HS++-- System+import Foreign+import Foreign.C+++-- |+-- Return the version number of the installed CUDA driver.+--+{-# INLINEABLE driverVersion #-}+driverVersion :: IO Int+driverVersion =  resultIfOk =<< cuDriverGetVersion++{-# INLINE cuDriverGetVersion #-}+{# fun unsafe cuDriverGetVersion+  { alloca- `Int' peekIntConv* } -> `Status' cToEnum #}+
+ src/Foreign/CUDA/Internal/C2HS.hs view
@@ -0,0 +1,230 @@+--  C->Haskell Compiler: Marshalling library+--+--  Copyright (c) [1999...2005] Manuel M T Chakravarty+--+--  Redistribution and use in source and binary forms, with or without+--  modification, are permitted provided that the following conditions are met:+--+--  1. Redistributions of source code must retain the above copyright notice,+--     this list of conditions and the following disclaimer.+--  2. Redistributions in binary form must reproduce the above copyright+--     notice, this list of conditions and the following disclaimer in the+--     documentation and/or other materials provided with the distribution.+--  3. The name of the author may not be used to endorse or promote products+--     derived from this software without specific prior written permission.+--+--  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+--  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+--  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+--  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+--  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED+--  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+--  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+--  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+--  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+--  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--+--- Description ---------------------------------------------------------------+--+--  Language: Haskell 98+--+--  This module provides the marshaling routines for Haskell files produced by+--  C->Haskell for binding to C library interfaces.  It exports all of the+--  low-level FFI (language-independent plus the C-specific parts) together+--  with the C->HS-specific higher-level marshalling routines.+--++module Foreign.CUDA.Internal.C2HS (++  -- * Composite marshalling functions+  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,+  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,+  peekArrayWith,++  -- * Conditional results using 'Maybe'+  nothingIf, nothingIfNull,++  -- * Bit masks+  combineBitMasks, containsBitMask, extractBitMasks,++  -- * Conversion between C and Haskell types+  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum+) where+++import Foreign+import Foreign.C+import Control.Monad                                    ( liftM )+++-- Composite marshalling functions+-- -------------------------------++-- Strings with explicit length+--+withCStringLenIntConv :: String -> (CStringLen -> IO a) -> IO a+withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)++peekCStringLenIntConv :: CStringLen -> IO String+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)++-- Marshalling of numerals+--++withIntConv :: (Storable b, Integral a, Integral b) => a -> (Ptr b -> IO c) -> IO c+withIntConv = with . cIntConv++withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c+withFloatConv = with . cFloatConv++peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b+peekIntConv = liftM cIntConv . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b+peekFloatConv = liftM cFloatConv . peek++-- Passing Booleans by reference+--++withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b+withBool = with . fromBool++peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool+peekBool = liftM toBool . peek+++-- Read and marshal array elements+--++peekArrayWith :: Storable a => (a -> b) -> Int -> Ptr a -> IO [b]+peekArrayWith f n p = map f `fmap` peekArray n p+++-- Passing enums by reference+--++withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c+withEnum = with . cFromEnum++peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a+peekEnum = liftM cToEnum . peek+++{-+-- Storing of 'Maybe' values+-- -------------------------++instance Storable a => Storable (Maybe a) where+  sizeOf    _ = sizeOf    (undefined :: Ptr ())+  alignment _ = alignment (undefined :: Ptr ())++  peek p = do+             ptr <- peek (castPtr p)+             if ptr == nullPtr+               then return Nothing+               else liftM Just $ peek ptr++  poke p v = do+               ptr <- case v of+                        Nothing -> return nullPtr+                        Just v' -> new v'+               poke (castPtr p) ptr+-}+++-- Conditional results using 'Maybe'+-- ---------------------------------++-- Wrap the result into a 'Maybe' type.+--+-- * the predicate determines when the result is considered to be non-existing,+--   ie, it is represented by `Nothing'+--+-- * the second argument allows to map a result wrapped into `Just' to some+--   other domain+--+nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b+nothingIf p f x = if p x then Nothing else Just $ f x++-- |Instance for special casing null pointers.+--+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b+nothingIfNull = nothingIf (== nullPtr)+++-- Support for bit masks+-- ---------------------++-- Given a list of enumeration values that represent bit masks, combine these+-- masks using bitwise disjunction.+--+combineBitMasks :: (Enum a, Num b, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++-- Tests whether the given bit mask is contained in the given bit pattern+-- (i.e., all bits set in the mask are also set in the pattern).+--+containsBitMask :: (Num a, Bits a, Enum b) => a -> b -> Bool+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm+                            in+                            bm' .&. bits == bm'++-- |Given a bit pattern, yield all bit masks that it contains.+--+-- * This does *not* attempt to compute a minimal set of bit masks that when+--   combined yield the bit pattern, instead all contained bit masks are+--   produced.+--+extractBitMasks :: (Num a, Bits a, Enum b, Bounded b) => a -> [b]+extractBitMasks bits =+  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]+++-- Conversion routines+-- -------------------++-- |Integral conversion+--+{-# INLINE [1] cIntConv #-}+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv  = fromIntegral++-- |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+ #-}++-- |Obtain C value from Haskell 'Bool'.+--+{-# INLINE [1] cFromBool #-}+cFromBool :: Num a => Bool -> a+cFromBool  = fromBool++-- |Obtain Haskell 'Bool' from C value.+--+{-# INLINE [1] cToBool #-}+cToBool :: (Eq a, Num a) => a -> Bool+cToBool  = toBool++-- |Convert a C enumeration to Haskell.+--+{-# INLINE [1] cToEnum #-}+cToEnum :: (Integral i, Enum e) => i -> e+cToEnum  = toEnum . cIntConv++-- |Convert a Haskell enumeration to C.+--+{-# INLINE [1] cFromEnum #-}+cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum  = cIntConv . fromEnum+
+ src/Foreign/CUDA/Ptr.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE BangPatterns #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Ptr+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Data pointers on the host and device. These can be shared freely between the+-- CUDA runtime and Driver APIs.+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Ptr (++  -- * Device pointers+  DevicePtr(..),+  withDevicePtr,+  devPtrToWordPtr,+  wordPtrToDevPtr,+  nullDevPtr,+  castDevPtr,+  plusDevPtr,+  alignDevPtr,+  minusDevPtr,+  advanceDevPtr,++  -- * Host pointers+  HostPtr(..),+  withHostPtr,+  nullHostPtr,+  castHostPtr,+  plusHostPtr,+  alignHostPtr,+  minusHostPtr,+  advanceHostPtr,++) where++-- friends+import Foreign.CUDA.Types++-- system+import Foreign.Ptr+import Foreign.Storable+++--------------------------------------------------------------------------------+-- Device Pointer+--------------------------------------------------------------------------------++-- |+-- 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.+--+{-# INLINEABLE withDevicePtr #-}+withDevicePtr :: DevicePtr a -> (Ptr a -> IO b) -> IO b+withDevicePtr !p !f = f (useDevicePtr p)++-- |+-- Return a unique handle associated with the given device pointer+--+{-# INLINEABLE devPtrToWordPtr #-}+devPtrToWordPtr :: DevicePtr a -> WordPtr+devPtrToWordPtr = ptrToWordPtr . useDevicePtr++-- |+-- Return a device pointer from the given handle+--+{-# INLINEABLE wordPtrToDevPtr #-}+wordPtrToDevPtr :: WordPtr -> DevicePtr a+wordPtrToDevPtr = DevicePtr . wordPtrToPtr++-- |+-- The constant 'nullDevPtr' contains the distinguished memory location that is+-- not associated with a valid memory location+--+{-# INLINEABLE nullDevPtr #-}+nullDevPtr :: DevicePtr a+nullDevPtr =  DevicePtr nullPtr++-- |+-- Cast a device pointer from one type to another+--+{-# INLINEABLE castDevPtr #-}+castDevPtr :: DevicePtr a -> DevicePtr b+castDevPtr (DevicePtr !p) = DevicePtr (castPtr p)++-- |+-- Advance the pointer address by the given offset in bytes.+--+{-# INLINEABLE plusDevPtr #-}+plusDevPtr :: DevicePtr a -> Int -> DevicePtr a+plusDevPtr (DevicePtr !p) !d = DevicePtr (p `plusPtr` d)++-- |+-- Given an alignment constraint, align the device pointer to the next highest+-- address satisfying the constraint+--+{-# INLINEABLE alignDevPtr #-}+alignDevPtr :: DevicePtr a -> Int -> DevicePtr a+alignDevPtr (DevicePtr !p) !i = DevicePtr (p `alignPtr` i)++-- |+-- Compute the difference between the second and first argument. This fulfils+-- the relation+--+-- > p2 == p1 `plusDevPtr` (p2 `minusDevPtr` p1)+--+{-# INLINEABLE minusDevPtr #-}+minusDevPtr :: DevicePtr a -> DevicePtr a -> Int+minusDevPtr (DevicePtr !a) (DevicePtr !b) = a `minusPtr` b++-- |+-- Advance a pointer into a device array by the given number of elements+--+{-# INLINEABLE advanceDevPtr #-}+advanceDevPtr :: Storable a => DevicePtr a -> Int -> DevicePtr a+advanceDevPtr = doAdvance undefined+  where+    doAdvance :: Storable a' => a' -> DevicePtr a' -> Int -> DevicePtr a'+    doAdvance x !p !i = p `plusDevPtr` (i * sizeOf x)+++--------------------------------------------------------------------------------+-- Host Pointer+--------------------------------------------------------------------------------++-- |+-- Apply an IO action to the memory reference living inside the host pointer+-- object. All uses of the pointer should be inside the 'withHostPtr' bracket.+--+{-# INLINEABLE withHostPtr #-}+withHostPtr :: HostPtr a -> (Ptr a -> IO b) -> IO b+withHostPtr !p !f = f (useHostPtr p)+++-- |+-- The constant 'nullHostPtr' contains the distinguished memory location that is+-- not associated with a valid memory location+--+{-# INLINEABLE nullHostPtr #-}+nullHostPtr :: HostPtr a+nullHostPtr =  HostPtr nullPtr++-- |+-- Cast a host pointer from one type to another+--+{-# INLINEABLE castHostPtr #-}+castHostPtr :: HostPtr a -> HostPtr b+castHostPtr (HostPtr !p) = HostPtr (castPtr p)++-- |+-- Advance the pointer address by the given offset in bytes+--+{-# INLINEABLE plusHostPtr #-}+plusHostPtr :: HostPtr a -> Int -> HostPtr a+plusHostPtr (HostPtr !p) !d = HostPtr (p `plusPtr` d)++-- |+-- Given an alignment constraint, align the host pointer to the next highest+-- address satisfying the constraint+--+{-# INLINEABLE alignHostPtr #-}+alignHostPtr :: HostPtr a -> Int -> HostPtr a+alignHostPtr (HostPtr !p) !i = HostPtr (p `alignPtr` i)++-- |+-- Compute the difference between the second and first argument+--+{-# INLINEABLE minusHostPtr #-}+minusHostPtr :: HostPtr a -> HostPtr a -> Int+minusHostPtr (HostPtr !a) (HostPtr !b) = a `minusPtr` b++-- |+-- Advance a pointer into a host array by a given number of elements+--+{-# INLINEABLE advanceHostPtr #-}+advanceHostPtr :: Storable a => HostPtr a -> Int -> HostPtr a+advanceHostPtr = doAdvance undefined+  where+    doAdvance :: Storable a' => a' -> HostPtr a' -> Int -> HostPtr a'+    doAdvance x !p !i = p `plusHostPtr` (i * sizeOf x)+
+ src/Foreign/CUDA/Runtime.hs view
@@ -0,0 +1,28 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,464 @@+{-# 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..2014] 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 view
@@ -0,0 +1,119 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE DeriveDataTypeable       #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Error+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,148 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Driver.Event+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,276 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GADTs                    #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Exec+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,648 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell          #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Marshal+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,115 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Stream+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,203 @@+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Texture+-- Copyright : [2009..2014] 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 view
@@ -0,0 +1,53 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Runtime.Utils+-- Copyright : [2009..2014] Trevor L. McDonell+-- License   : BSD+--+-- Utility functions+--+--------------------------------------------------------------------------------++module Foreign.CUDA.Runtime.Utils (++  runtimeVersion,+  driverVersion,++) 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 #}+
+ src/Foreign/CUDA/Types.chs view
@@ -0,0 +1,155 @@+{-# LANGUAGE BangPatterns   #-}+{-# LANGUAGE CPP            #-}+{-# LANGUAGE EmptyDataDecls #-}+#ifdef USE_EMPTY_CASE+{-# LANGUAGE EmptyCase      #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module    : Foreign.CUDA.Types+-- Copyright : [2009..2014] 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(..), StreamPriority, StreamFlag,+  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 }+    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++-- |+-- Possible option flags for stream initialisation. Dummy instance until the API+-- exports actual option values.+--+data StreamFlag+instance Enum StreamFlag where+#ifdef USE_EMPTY_CASE+  toEnum   x = case x of {}+  fromEnum x = case x of {}+#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 view
@@ -0,0 +1,18 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Text.Show.Describe+-- Copyright : [2016] 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+