accelerate-cuda (empty) → 0.12.0.0
raw patch · 35 files changed
+10956/−0 lines, 35 filesdep +Win32dep +acceleratedep +arraysetup-changed
Dependencies added: Win32, accelerate, array, base, binary, blaze-builder, bytestring, containers, cryptohash, cuda, directory, fclabels, filepath, hashable, hashtables, language-c-quote, mainland-pretty, mtl, pretty, process, srcloc, symbol, transformers, unix, unordered-containers
Files
- Data/Array/Accelerate/CUDA.hs +226/−0
- Data/Array/Accelerate/CUDA/AST.hs +115/−0
- Data/Array/Accelerate/CUDA/Analysis/Device.hs +53/−0
- Data/Array/Accelerate/CUDA/Analysis/Launch.hs +167/−0
- Data/Array/Accelerate/CUDA/Array/Data.hs +315/−0
- Data/Array/Accelerate/CUDA/Array/Prim.hs +373/−0
- Data/Array/Accelerate/CUDA/Array/Sugar.hs +44/−0
- Data/Array/Accelerate/CUDA/Array/Table.hs +196/−0
- Data/Array/Accelerate/CUDA/CodeGen.hs +643/−0
- Data/Array/Accelerate/CUDA/CodeGen/Base.hs +199/−0
- Data/Array/Accelerate/CUDA/CodeGen/IndexSpace.hs +394/−0
- Data/Array/Accelerate/CUDA/CodeGen/Mapping.hs +122/−0
- Data/Array/Accelerate/CUDA/CodeGen/Monad.hs +88/−0
- Data/Array/Accelerate/CUDA/CodeGen/PrefixSum.hs +289/−0
- Data/Array/Accelerate/CUDA/CodeGen/Reduction.hs +542/−0
- Data/Array/Accelerate/CUDA/CodeGen/Stencil.hs +223/−0
- Data/Array/Accelerate/CUDA/CodeGen/Type.hs +212/−0
- Data/Array/Accelerate/CUDA/Compile.hs +448/−0
- Data/Array/Accelerate/CUDA/Debug.hs +138/−0
- Data/Array/Accelerate/CUDA/Execute.hs +937/−0
- Data/Array/Accelerate/CUDA/FullList.hs +80/−0
- Data/Array/Accelerate/CUDA/State.hs +207/−0
- Data/Array/Accelerate/Internal/Check.hs +110/−0
- LICENSE +23/−0
- Setup.hs +4/−0
- accelerate-cuda.cabal +164/−0
- configure +3410/−0
- cubits/accelerate_cuda_extras.h +22/−0
- cubits/accelerate_cuda_function.h +209/−0
- cubits/accelerate_cuda_shape.h +338/−0
- cubits/accelerate_cuda_shape.h.in +338/−0
- cubits/accelerate_cuda_stencil.h +93/−0
- cubits/accelerate_cuda_texture.h +133/−0
- cubits/accelerate_cuda_util.h +70/−0
- include/accelerate.h +31/−0
+ Data/Array/Accelerate/CUDA.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.CUDA+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module implements the CUDA backend for the embedded array language+-- Accelerate. Expressions are on-line translated into CUDA code, compiled, and+-- executed in parallel on the GPU.+--+-- The accelerate-cuda library is hosted at <https://github.com/tmcdonell/accelerate-cuda>.+-- Comments, bug reports, and patches are always welcome.+--++module Data.Array.Accelerate.CUDA (++ Arrays,++ -- * Synchronous execution+ run, run1, stream, runIn, run1In, streamIn,++ -- * Asynchronous execution+ Async, wait, poll, cancel,+ runAsync, run1Async, runAsyncIn, run1AsyncIn++) where++-- standard library+import Prelude hiding ( catch )+import Control.Exception+import Control.Applicative+import Control.Concurrent+import System.IO.Unsafe+import Foreign.CUDA.Driver ( Context )+import Foreign.CUDA.Driver.Error++-- friends+import Data.Array.Accelerate.Smart ( Acc, convertAcc, convertAccFun1 )+import Data.Array.Accelerate.Array.Sugar ( Arrays(..), ArraysR(..) )+import Data.Array.Accelerate.CUDA.Array.Data+import Data.Array.Accelerate.CUDA.State+import Data.Array.Accelerate.CUDA.Compile+import Data.Array.Accelerate.CUDA.Execute++#include "accelerate.h"+++-- Accelerate: CUDA+-- ----------------++-- | Compile and run a complete embedded array program using the CUDA backend.+-- This will select the fastest device available on which to execute+-- computations, based on compute capability and estimated maximum GFLOPS.+--+run :: Arrays a => Acc a -> a+run a+ = unsafePerformIO+ $ withMVar defaultContext $ \ctx -> evaluate (runIn ctx a)++-- | As 'run', but allow the computation to continue running in a thread and+-- return immediately without waiting for the result. The status of the+-- computation can be queried using 'wait', 'poll', and 'cancel'.+--+-- Note that a CUDA Context can only be active no one host thread at a time. If+-- you want to execute multiple computations in parallel, use 'runAsyncIn'.+--+runAsync :: Arrays a => Acc a -> Async a+runAsync a+ = unsafePerformIO+ $ withMVar defaultContext $ \ctx -> evaluate (runAsyncIn ctx a)++-- | As 'run', but execute using the specified device context rather than using+-- the default, automatically selected device.+--+-- Contexts passed to this function may all refer to the same device, or to+-- separate devices of differing compute capabilities.+--+-- Note that each thread has a stack of current contexts, and calling+-- 'Foreign.CUDA.Driver.Context.create' pushes the new context on top of the+-- stack and makes it current with the calling thread. You should call+-- 'Foreign.CUDA.Driver.Context.pop' to make the context floating before passing+-- it to 'runIn', which will make it current for the duration of evaluating the+-- expression. See the CUDA C Programming Guide (G.1) for more information.+--+runIn :: Arrays a => Context -> Acc a -> a+runIn ctx a+ = unsafePerformIO+ $ evaluate (runAsyncIn ctx a) >>= wait+++-- | As 'runIn', but execute asynchronously. Be sure not to destroy the context,+-- or attempt to attach it to a different host thread, before all outstanding+-- operations have completed.+--+runAsyncIn :: Arrays a => Context -> Acc a -> Async a+runAsyncIn ctx a = unsafePerformIO $ async execute+ where+ acc = convertAcc a+ execute = evalCUDA ctx (compileAcc acc >>= executeAcc >>= collect)+ `catch`+ \e -> INTERNAL_ERROR(error) "unhandled" (show (e :: CUDAException))+++-- | Prepare and execute an embedded array program of one argument.+--+-- This function can be used to improve performance in cases where the array+-- program is constant between invocations, because it allows us to bypass all+-- front-end conversion stages and move directly to the execution phase. If you+-- have a computation applied repeatedly to different input data, use this.+--+-- See the Crystal demo, part of the 'accelerate-examples' package, for an+-- example.+--+run1 :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> b+run1 f+ = unsafePerformIO+ $ withMVar defaultContext $ \ctx -> evaluate (run1In ctx f)+++-- | As 'run1', but the computation is executed asynchronously.+--+run1Async :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> Async b+run1Async f+ = unsafePerformIO+ $ withMVar defaultContext $ \ctx -> evaluate (run1AsyncIn ctx f)++-- | As 'run1', but execute in the specified context.+--+run1In :: (Arrays a, Arrays b) => Context -> (Acc a -> Acc b) -> a -> b+run1In ctx f = let go = run1AsyncIn ctx f+ in \a -> unsafePerformIO $ wait (go a)++-- | As 'run1In', but execute asynchronously.+--+run1AsyncIn :: (Arrays a, Arrays b) => Context -> (Acc a -> Acc b) -> a -> Async b+run1AsyncIn ctx f = \a -> unsafePerformIO $ async (execute a)+ where+ acc = convertAccFun1 f+ !afun = unsafePerformIO $ evalCUDA ctx (compileAfun1 acc)+ execute a = evalCUDA ctx (executeAfun1 afun a >>= collect)+ `catch`+ \e -> INTERNAL_ERROR(error) "unhandled" (show (e :: CUDAException))++-- TLM: We need to be very careful with run1* variants, to ensure that the+-- returned closure shortcuts directly to the execution phase.+++-- | Stream a lazily read list of input arrays through the given program,+-- collecting results as we go.+--+stream :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> [a] -> [b]+stream f arrs+ = unsafePerformIO+ $ withMVar defaultContext $ \ctx -> evaluate (streamIn ctx f arrs)++-- | As 'stream', but execute in the specified context.+--+streamIn :: (Arrays a, Arrays b) => Context -> (Acc a -> Acc b) -> [a] -> [b]+streamIn ctx f arrs+ = let go = run1In ctx f+ in map go arrs+++-- Copy arrays from device to host.+--+collect :: forall arrs. Arrays arrs => arrs -> CIO arrs+collect arrs = toArr <$> collectR (arrays (undefined :: arrs)) (fromArr arrs)+ where+ collectR :: ArraysR a -> a -> CIO a+ collectR ArraysRunit () = return ()+ collectR ArraysRarray arr = peekArray arr >> return arr+ collectR (ArraysRpair r1 r2) (arrs1, arrs2) = (,) <$> collectR r1 arrs1+ <*> collectR r2 arrs2+++-- Running asynchronously+-- ----------------------++-- We need to execute the main thread asynchronously to give finalisers a chance+-- to run. Make sure to catch exceptions to avoid "blocked indefinitely on MVar"+-- errors.+--+data Async a = Async !ThreadId !(MVar (Either SomeException a))++-- Fork an action to execute asynchronously.+--+-- TLM:+-- CUDA contexts are specific to the processor on which they were created. It+-- may be necessary to take this into account when forking accelerate+-- computations (forkOn rather than forkIO), either by always requiring a+-- specific CPU, and/or having the driver API store the processor ordinal when+-- creating contexts.+--+async :: IO a -> IO (Async a)+async action = do+ var <- newEmptyMVar+ tid <- forkIO $ (putMVar var . Right =<< action)+ `catch`+ \e -> putMVar var (Left e)+ return (Async tid var)++-- | Block the calling thread until the computation completes, then return the+-- result.+--+wait :: Async a -> IO a+wait (Async _ var) = either throwIO return =<< readMVar var++-- | Test whether the asynchronous computation has already completed. If so,+-- return the result, else 'Nothing'.+--+poll :: Async a -> IO (Maybe a)+poll (Async _ var) =+ maybe (return Nothing) (either throwIO (return . Just)) =<< tryTakeMVar var++-- | Cancel a running asynchronous computation.+--+cancel :: Async a -> IO ()+cancel (Async tid _) = throwTo tid ThreadKilled+ -- TLM: catch and ignore exceptions?+ -- silently do nothing if the thread has already finished?+
+ Data/Array/Accelerate/CUDA/AST.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE GADTs, FlexibleInstances, TypeSynonymInstances #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.AST+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.AST (++ module Data.Array.Accelerate.AST,+ AccKernel(..), AccBindings(..), ArrayVar(..), ExecAcc, ExecAfun, ExecOpenAcc(..),+ retag++) where++-- friends+import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Pretty+import Data.Array.Accelerate.Array.Sugar ( Array, Shape, Elt )+import qualified Data.Array.Accelerate.CUDA.FullList as FL+import qualified Foreign.CUDA.Driver as CUDA+import qualified Foreign.CUDA.Analysis as CUDA++-- system+import Text.PrettyPrint+import Data.Hashable+import Data.Monoid ( Monoid(..) )+import qualified Data.HashSet as Set+++-- A non-empty list of binary objects will be used to execute a kernel. We keep+-- auxiliary information together with the compiled module, such as entry point+-- and execution information.+--+data AccKernel a = Kernel String CUDA.Module CUDA.Fun CUDA.Occupancy (Int -> (Int,Int,Int))++-- The kernel lists are monomorphic, so sometimes we need to change the phantom+-- type of the object code.+--+retag :: AccKernel a -> AccKernel b+retag (Kernel x m f o l) = Kernel x m f o l+++-- Kernel execution is asynchronous, barriers allow (cross-stream)+-- synchronisation to determine when the operation has completed+--+-- data AccBarrier = AB !Stream !Event++-- Array computations that were embedded within scalar expressions, and will be+-- required to execute the kernel; i.e. bound to texture references or similar.+--+newtype AccBindings aenv = AccBindings ( Set.HashSet (ArrayVar aenv) )++instance Monoid (AccBindings aenv) where+ mempty = AccBindings ( Set.empty )+ AccBindings x `mappend` AccBindings y = AccBindings ( Set.union x y )++data ArrayVar aenv where+ ArrayVar :: (Shape sh, Elt e)+ => Idx aenv (Array sh e)+ -> ArrayVar aenv++instance Eq (ArrayVar aenv) where+ ArrayVar ix1 == ArrayVar ix2 = idxToInt ix1 == idxToInt ix2++instance Hashable (ArrayVar aenv) where+ hash (ArrayVar ix) = hash (idxToInt ix)+++-- Interleave compilation & execution state annotations into an open array+-- computation AST+--+data ExecOpenAcc aenv a where+ ExecAcc :: FL.FullList () (AccKernel a) -- executable binary objects+ -> AccBindings aenv -- auxiliary arrays from the environment the kernel needs access to+ -> PreOpenAcc ExecOpenAcc aenv a -- the actual computation+ -> ExecOpenAcc aenv a -- the recursive knot++-- An annotated AST suitable for execution in the CUDA environment+--+type ExecAcc a = ExecOpenAcc () a+type ExecAfun a = PreAfun ExecOpenAcc a++instance Show (ExecOpenAcc aenv a) where+ show = render . prettyExecAcc 0 noParens++instance Show (ExecAfun a) where+ show = render . prettyExecAfun 0+++-- Display the annotated AST+--+prettyExecAfun :: Int -> ExecAfun a -> Doc+prettyExecAfun alvl pfun = prettyPreAfun prettyExecAcc alvl pfun++prettyExecAcc :: PrettyAcc ExecOpenAcc+prettyExecAcc alvl wrap (ExecAcc _ (AccBindings fv) pacc) =+ let base = prettyPreAcc prettyExecAcc alvl wrap pacc+ ann = braces (freevars (Set.toList fv))+ freevars = (text "fv=" <>) . brackets . hcat . punctuate comma+ . map (\(ArrayVar ix) -> char 'a' <> int (idxToInt ix))+ in case pacc of+ Avar _ -> base+ Alet _ _ -> base+ Apply _ _ -> base+ Acond _ _ _ -> base+ Atuple _ -> base+ Aprj _ _ -> base+ _ -> ann <+> base+
+ Data/Array/Accelerate/CUDA/Analysis/Device.hs view
@@ -0,0 +1,53 @@+-- |+-- Module : Data.Array.Accelerate.CUDA.Analysis.Device+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Analysis.Device+ where++import Data.Ord+import Data.List+import Data.Function+import Foreign.CUDA.Driver.Device+import qualified Foreign.CUDA.Driver as CUDA+++-- Select the best of the available CUDA capable devices. This prefers devices+-- with higher compute capability, followed by maximum throughput. This does not+-- take into account any other factors, such as whether the device is currently+-- in use by another process.+--+-- Ignore the possibility of emulation-mode devices, as this has been deprecated+-- as of CUDA v3.0 (compute-capability == 9999.9999)+--+selectBestDevice :: IO (Device, DeviceProperties)+selectBestDevice = do+ dev <- mapM CUDA.device . enumFromTo 0 . subtract 1 =<< CUDA.count+ prop <- mapM CUDA.props dev+ return . head . sortBy (flip cmp `on` snd) $ zip dev prop+ where+ compute = computeCapability+ flops d = multiProcessorCount d * coresPerMultiProcessor d * clockRate d+ cmp x y+ | compute x == compute y = comparing flops x y+ | otherwise = comparing compute x y+++-- Number of CUDA cores per streaming multiprocessor for a given architecture+-- revision. This is the number of SIMD arithmetic units per multiprocessor,+-- executing in lockstep in half-warp groupings (16 ALUs).+--+coresPerMultiProcessor :: DeviceProperties -> Int+coresPerMultiProcessor prp+ | computeCapability prp < 2 = 8+ | computeCapability prp < 2.1 = 32+ | otherwise = 48++
+ Data/Array/Accelerate/CUDA/Analysis/Launch.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE CPP, GADTs #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Analysis.Launch+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Analysis.Launch (++ launchConfig, determineOccupancy++) where++-- friends+import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Analysis.Type+import Data.Array.Accelerate.Analysis.Shape++-- library+import qualified Foreign.CUDA.Analysis as CUDA+import qualified Foreign.CUDA.Driver as CUDA++#include "accelerate.h"+++-- |+-- Determine kernel launch parameters for the given array computation (as well+-- as compiled function module). This consists of the thread block size, number+-- of blocks, and dynamically allocated shared memory (bytes), respectively.+--+-- For most operations, this selects the minimum block size that gives maximum+-- occupancy, and the grid size limited to the maximum number of physically+-- resident blocks. Hence, kernels may need to process multiple elements per+-- thread. Scan operations select the largest block size of maximum occupancy.+--+launchConfig+ :: OpenAcc aenv a+ -> CUDA.DeviceProperties+ -> CUDA.Occupancy -- kernel occupancy information+ -> Int -- number of elements to configure for+ -> (Int, Int, Int)+launchConfig (OpenAcc acc) dev occ = \n ->+ let cta = CUDA.activeThreads occ `div` CUDA.activeThreadBlocks occ+ maxGrid = CUDA.multiProcessorCount dev * CUDA.activeThreadBlocks occ+ smem = sharedMem dev acc cta+ in+ (cta, maxGrid `min` gridSize dev acc n cta, smem)+++-- |+-- Determine maximal occupancy statistics for the given kernel / device+-- combination.+--+determineOccupancy+ :: OpenAcc aenv a+ -> CUDA.DeviceProperties+ -> CUDA.Fun -- corresponding __global__ entry function+ -> Int -- maximum number of threads per block+ -> IO CUDA.Occupancy+determineOccupancy (OpenAcc acc) dev fn maxBlock = do+ registers <- CUDA.requires fn CUDA.NumRegs+ static_smem <- CUDA.requires fn CUDA.SharedSizeBytes -- static memory only+ return . snd $ blockSize dev acc maxBlock registers (\threads -> static_smem + dynamic_smem threads)+ where+ dynamic_smem = sharedMem dev acc+++-- |+-- Determine an optimal thread block size for a given array computation. Fold+-- requires blocks with a power-of-two number of threads. Scans select the+-- largest size thread block possible, because if only one thread block is+-- needed we can calculate the scan in a single pass, rather than three.+--+blockSize+ :: CUDA.DeviceProperties+ -> PreOpenAcc OpenAcc aenv a+ -> Int -- maximum number of threads per block+ -> Int -- number of registers used+ -> (Int -> Int) -- shared memory as a function of thread block size (bytes)+ -> (Int, CUDA.Occupancy)+blockSize dev acc lim regs smem =+ CUDA.optimalBlockSizeBy dev (filter (<= lim) . strategy) (const regs) smem+ where+ strategy = case acc of+ Fold _ _ _ -> CUDA.decPow2+ Fold1 _ _ -> CUDA.decPow2+ Scanl _ _ _ -> CUDA.incWarp+ Scanl' _ _ _ -> CUDA.incWarp+ Scanl1 _ _ -> CUDA.incWarp+ Scanr _ _ _ -> CUDA.incWarp+ Scanr' _ _ _ -> CUDA.incWarp+ Scanr1 _ _ -> CUDA.incWarp+ _ -> CUDA.decWarp+++-- |+-- Determine the number of blocks of the given size necessary to process the+-- given array expression. This should understand things like #elements per+-- thread for the various kernels.+--+-- The 'size' parameter is typically the number of elements in the array, except+-- for the following instances:+--+-- * foldSeg: the number of segments; require one warp per segment+--+-- * fold: for multidimensional reductions, this is the size of the shape tail+-- for 1D reductions this is the total number of elements+--+gridSize :: CUDA.DeviceProperties -> PreOpenAcc OpenAcc aenv a -> Int -> Int -> Int+gridSize p acc@(FoldSeg _ _ _ _) size cta = split acc (size * CUDA.warpSize p) cta+gridSize p acc@(Fold1Seg _ _ _) size cta = split acc (size * CUDA.warpSize p) cta+gridSize _ acc@(Fold _ _ _) size cta = if preAccDim accDim acc == 0 then split acc size cta else size+gridSize _ acc@(Fold1 _ _) size cta = if preAccDim accDim acc == 0 then split acc size cta else size+gridSize _ acc size cta = split acc size cta++split :: PreOpenAcc OpenAcc aenv a -> Int -> Int -> Int+split acc size cta = (size `between` eltsPerThread acc) `between` cta+ where+ between arr n = 1 `max` ((n + arr - 1) `div` n)+ eltsPerThread _ = 1+++-- |+-- Analyse the given array expression, returning an estimate of dynamic shared+-- memory usage as a function of thread block size. This can be used by the+-- occupancy calculator to optimise kernel launch shape.+--+sharedMem :: CUDA.DeviceProperties -> PreOpenAcc OpenAcc aenv a -> Int -> Int+-- non-computation forms+sharedMem _ (Alet _ _) _ = INTERNAL_ERROR(error) "sharedMem" "Let"+sharedMem _ (Avar _) _ = INTERNAL_ERROR(error) "sharedMem" "Avar"+sharedMem _ (Apply _ _) _ = INTERNAL_ERROR(error) "sharedMem" "Apply"+sharedMem _ (Acond _ _ _) _ = INTERNAL_ERROR(error) "sharedMem" "Acond"+sharedMem _ (Atuple _) _ = INTERNAL_ERROR(error) "sharedMem" "Atuple"+sharedMem _ (Aprj _ _) _ = INTERNAL_ERROR(error) "sharedMem" "Aprj"+sharedMem _ (Use _) _ = INTERNAL_ERROR(error) "sharedMem" "Use"+sharedMem _ (Unit _) _ = INTERNAL_ERROR(error) "sharedMem" "Unit"+sharedMem _ (Reshape _ _) _ = INTERNAL_ERROR(error) "sharedMem" "Reshape"++-- skeleton nodes+sharedMem _ (Generate _ _) _ = 0+sharedMem _ (Replicate _ _ _) _ = 0+sharedMem _ (Index _ _ _) _ = 0+sharedMem _ (Map _ _) _ = 0+sharedMem _ (ZipWith _ _ _) _ = 0+sharedMem _ (Permute _ _ _ _) _ = 0+sharedMem _ (Backpermute _ _ _) _ = 0+sharedMem _ (Stencil _ _ _) _ = 0+sharedMem _ (Stencil2 _ _ _ _ _) _ = 0+sharedMem _ (Fold _ _ a) blockDim = sizeOf (accType a) * blockDim+sharedMem _ (Fold1 _ a) blockDim = sizeOf (accType a) * blockDim+sharedMem _ (Scanl _ x _) blockDim = sizeOf (expType x) * blockDim+sharedMem _ (Scanr _ x _) blockDim = sizeOf (expType x) * blockDim+sharedMem _ (Scanl' _ x _) blockDim = sizeOf (expType x) * blockDim+sharedMem _ (Scanr' _ x _) blockDim = sizeOf (expType x) * blockDim+sharedMem _ (Scanl1 _ a) blockDim = sizeOf (accType a) * blockDim+sharedMem _ (Scanr1 _ a) blockDim = sizeOf (accType a) * blockDim+sharedMem p (FoldSeg _ _ a _) blockDim =+ (blockDim `div` CUDA.warpSize p) * 8 + blockDim * sizeOf (accType a)+sharedMem p (Fold1Seg _ a _) blockDim =+ (blockDim `div` CUDA.warpSize p) * 8 + blockDim * sizeOf (accType a)+
+ Data/Array/Accelerate/CUDA/Array/Data.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE CPP, GADTs, TypeFamilies, ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Array.Data+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Array.Data (++ -- * Array operations and representations+ mallocArray, indexArray, copyArray,+ useArray, useArrayAsync,+ peekArray, peekArrayAsync,+ pokeArray, pokeArrayAsync,+ marshalArrayData, marshalTextureData, marshalDevicePtrs,+ devicePtrsOfArrayData, advancePtrsOfArrayData,++ -- * Garbage collection+ cleanupArrayData++) where++-- libraries+import Prelude hiding (fst, snd)+import Data.Label.PureM+import Control.Applicative+import Control.Monad.Trans++-- friends+import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.Array.Sugar (Array(..), Shape, Elt, fromElt, toElt)+import Data.Array.Accelerate.Array.Representation (size, index)+import Data.Array.Accelerate.CUDA.State+import Data.Array.Accelerate.CUDA.Array.Table+import qualified Data.Array.Accelerate.CUDA.Array.Prim as Prim+import qualified Foreign.CUDA.Driver as CUDA+import qualified Foreign.CUDA.Driver.Stream as CUDA+import qualified Foreign.CUDA.Driver.Texture as CUDA++#include "accelerate.h"+++-- Array Operations+-- ----------------++-- Garbage collection+--+cleanupArrayData :: CIO ()+cleanupArrayData = liftIO . reclaim =<< gets memoryTable++-- Array tuple extraction+--+fst :: ArrayData (a,b) -> ArrayData a+fst = fstArrayData++snd :: ArrayData (a,b) -> ArrayData b+snd = sndArrayData++-- CPP hackery to generate the cases where we dispatch to the worker function handling+-- elementary types.+--+#define mkPrimDispatch(dispatcher,worker) \+; dispatcher ArrayEltRint = worker \+; dispatcher ArrayEltRint8 = worker \+; dispatcher ArrayEltRint16 = worker \+; dispatcher ArrayEltRint32 = worker \+; dispatcher ArrayEltRint64 = worker \+; dispatcher ArrayEltRword = worker \+; dispatcher ArrayEltRword8 = worker \+; dispatcher ArrayEltRword16 = worker \+; dispatcher ArrayEltRword32 = worker \+; dispatcher ArrayEltRword64 = worker \+; dispatcher ArrayEltRfloat = worker \+; dispatcher ArrayEltRdouble = worker \+; dispatcher ArrayEltRbool = error "mkPrimDispatcher: ArrayEltRbool" \+; dispatcher ArrayEltRchar = error "mkPrimDispatcher: ArrayEltRchar" \+; dispatcher _ = error "mkPrimDispatcher: not primitive"+++-- |Allocate a new device array to accompany the given host-side array.+--+mallocArray :: (Shape dim, Elt e) => Array dim e -> CIO ()+mallocArray (Array sh adata) = doMalloc =<< gets memoryTable+ where+ doMalloc mt = liftIO $ mallocR arrayElt adata+ where+ mallocR :: ArrayEltR e -> ArrayData e -> IO ()+ mallocR ArrayEltRunit _ = return ()+ mallocR (ArrayEltRpair aeR1 aeR2) ad = mallocR aeR1 (fst ad) >> mallocR aeR2 (snd ad)+ mallocR aer ad = mallocPrim aer mt ad (size sh)+ --+ mallocPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO ()+ mkPrimDispatch(mallocPrim,Prim.mallocArray)+++-- |Upload an existing array to the device+--+useArray :: (Shape dim, Elt e) => Array dim e -> CIO ()+useArray (Array sh adata) = doUse =<< gets memoryTable+ where+ doUse mt = liftIO $ useR arrayElt adata+ where+ useR :: ArrayEltR e -> ArrayData e -> IO ()+ useR ArrayEltRunit _ = return ()+ useR (ArrayEltRpair aeR1 aeR2) ad = useR aeR1 (fst ad) >> useR aeR2 (snd ad)+ useR aer ad = usePrim aer mt ad (size sh)+ --+ usePrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO ()+ mkPrimDispatch(usePrim,Prim.useArray)++useArrayAsync :: (Shape dim, Elt e) => Array dim e -> Maybe CUDA.Stream -> CIO ()+useArrayAsync (Array sh adata) ms = doUse =<< gets memoryTable+ where+ doUse mt = liftIO $ useR arrayElt adata+ where+ useR :: ArrayEltR e -> ArrayData e -> IO ()+ useR ArrayEltRunit _ = return ()+ useR (ArrayEltRpair aeR1 aeR2) ad = useR aeR1 (fst ad) >> useR aeR2 (snd ad)+ useR aer ad = usePrim aer mt ad (size sh) ms+ --+ usePrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> Maybe CUDA.Stream -> IO ()+ mkPrimDispatch(usePrim,Prim.useArrayAsync)+++-- |Read a single element from an array at the given row-major index. This is a+-- synchronous operation.+--+indexArray :: (Shape dim, Elt e) => Array dim e -> dim -> CIO e+indexArray (Array sh adata) ix = doIndex =<< gets memoryTable+ where+ i = index sh (fromElt ix)+ doIndex mt = toElt <$> (liftIO $ indexR arrayElt adata)+ where+ indexR :: ArrayEltR e -> ArrayData e -> IO e+ indexR ArrayEltRunit _ = return ()+ indexR (ArrayEltRpair aeR1 aeR2) ad = (,) <$> indexR aeR1 (fst ad)+ <*> indexR aeR2 (snd ad)+ indexR aer ad = indexPrim aer mt ad i+ --+ indexPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO e+ mkPrimDispatch(indexPrim,Prim.indexArray)+++-- |Copy data between two device arrays. The operation is asynchronous with+-- respect to the host, but will never overlap kernel execution.+--+copyArray :: (Shape dim, Elt e) => Array dim e -> Array dim e -> CIO ()+copyArray (Array sh1 adata1) (Array sh2 adata2)+ = BOUNDS_CHECK(check) "copyArray" "shape mismatch" (sh1 == sh2)+ $ doCopy =<< gets memoryTable+ where+ doCopy mt = liftIO $ copyR arrayElt adata1 adata2+ where+ copyR :: ArrayEltR e -> ArrayData e -> ArrayData e -> IO ()+ copyR ArrayEltRunit _ _ = return ()+ copyR (ArrayEltRpair aeR1 aeR2) ad1 ad2 = copyR aeR1 (fst ad1) (fst ad2) >>+ copyR aeR2 (snd ad1) (snd ad2)+ copyR aer ad1 ad2 = copyPrim aer mt ad1 ad2 (size sh1)+ --+ copyPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> ArrayData e -> Int -> IO ()+ mkPrimDispatch(copyPrim,Prim.copyArray)+++-- Copy data from the device into the associated Accelerate host-side array+--+peekArray :: (Shape dim, Elt e) => Array dim e -> CIO ()+peekArray (Array sh adata) = doPeek =<< gets memoryTable+ where+ doPeek mt = liftIO $ peekR arrayElt adata+ where+ peekR :: ArrayEltR e -> ArrayData e -> IO ()+ peekR ArrayEltRunit _ = return ()+ peekR (ArrayEltRpair aeR1 aeR2) ad = peekR aeR1 (fst ad) >> peekR aeR2 (snd ad)+ peekR aer ad = peekPrim aer mt ad (size sh)+ --+ peekPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO ()+ mkPrimDispatch(peekPrim,Prim.peekArray)++peekArrayAsync :: (Shape dim, Elt e) => Array dim e -> Maybe CUDA.Stream -> CIO ()+peekArrayAsync (Array sh adata) ms = doPeek =<< gets memoryTable+ where+ doPeek mt = liftIO $ peekR arrayElt adata+ where+ peekR :: ArrayEltR e -> ArrayData e -> IO ()+ peekR ArrayEltRunit _ = return ()+ peekR (ArrayEltRpair aeR1 aeR2) ad = peekR aeR1 (fst ad) >> peekR aeR2 (snd ad)+ peekR aer ad = peekPrim aer mt ad (size sh) ms+ --+ peekPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> Maybe CUDA.Stream -> IO ()+ mkPrimDispatch(peekPrim,Prim.peekArrayAsync)+++-- Copy data from an Accelerate array into the associated device array+--+pokeArray :: (Shape dim, Elt e) => Array dim e -> CIO ()+pokeArray (Array sh adata) = doPoke =<< gets memoryTable+ where+ doPoke mt = liftIO $ pokeR arrayElt adata+ where+ pokeR :: ArrayEltR e -> ArrayData e -> IO ()+ pokeR ArrayEltRunit _ = return ()+ pokeR (ArrayEltRpair aeR1 aeR2) ad = pokeR aeR1 (fst ad) >> pokeR aeR2 (snd ad)+ pokeR aer ad = pokePrim aer mt ad (size sh)+ --+ pokePrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO ()+ mkPrimDispatch(pokePrim,Prim.pokeArray)++pokeArrayAsync :: (Shape dim, Elt e) => Array dim e -> Maybe CUDA.Stream -> CIO ()+pokeArrayAsync (Array sh adata) ms = doPoke =<< gets memoryTable+ where+ doPoke mt = liftIO $ pokeR arrayElt adata+ where+ pokeR :: ArrayEltR e -> ArrayData e -> IO ()+ pokeR ArrayEltRunit _ = return ()+ pokeR (ArrayEltRpair aeR1 aeR2) ad = pokeR aeR1 (fst ad) >> pokeR aeR2 (snd ad)+ pokeR aer ad = pokePrim aer mt ad (size sh) ms+ --+ pokePrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> Maybe CUDA.Stream -> IO ()+ mkPrimDispatch(pokePrim,Prim.pokeArrayAsync)+++-- |Wrap device pointers into arguments that can be passed to a kernel+-- invocation+--+marshalDevicePtrs :: ArrayElt e => ArrayData e -> Prim.DevicePtrs e -> [CUDA.FunParam]+marshalDevicePtrs adata = marshalR arrayElt adata+ where+ marshalR :: ArrayEltR e -> ArrayData e -> Prim.DevicePtrs e -> [CUDA.FunParam]+ marshalR ArrayEltRunit _ _ = []+ marshalR (ArrayEltRpair aeR1 aeR2) ad (p1,p2) = marshalR aeR1 (fst ad) p1 +++ marshalR aeR2 (snd ad) p2+ marshalR aer ad ptr = [marshalPrim aer ad ptr]+ --+ marshalPrim :: ArrayEltR e -> ArrayData e -> Prim.DevicePtrs e -> CUDA.FunParam+ mkPrimDispatch(marshalPrim,Prim.marshalDevicePtrs)+++-- |Wrap the device pointers corresponding to a host-side array into arguments+-- that can be passed to a kernel upon invocation.+--+marshalArrayData :: ArrayElt e => ArrayData e -> CIO [CUDA.FunParam]+marshalArrayData adata = doMarshal =<< gets memoryTable+ where+ doMarshal mt = liftIO $ marshalR arrayElt adata+ where+ marshalR :: ArrayEltR e -> ArrayData e -> IO [CUDA.FunParam]+ marshalR ArrayEltRunit _ = return []+ marshalR (ArrayEltRpair aeR1 aeR2) ad = (++) <$> marshalR aeR1 (fst ad)+ <*> marshalR aeR2 (snd ad)+ marshalR aer ad = return <$> marshalPrim aer mt ad+ --+ marshalPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> IO CUDA.FunParam+ mkPrimDispatch(marshalPrim,Prim.marshalArrayData)+++-- |Bind the device memory arrays to the given texture reference(s), setting+-- appropriate type. The arrays are bound, and the list of textures thereby+-- consumed, in projection index order --- i.e. right-to-left+--+marshalTextureData :: ArrayElt e => ArrayData e -> Int -> [CUDA.Texture] -> CIO ()+marshalTextureData adata n texs = doMarshal =<< gets memoryTable+ where+ doMarshal mt = liftIO $ marshalR arrayElt adata texs >> return ()+ where+ marshalR :: ArrayEltR e -> ArrayData e -> [CUDA.Texture] -> IO Int+ marshalR ArrayEltRunit _ _ = return 0+ marshalR (ArrayEltRpair aeR1 aeR2) ad t+ = do r <- marshalR aeR2 (snd ad) t+ l <- marshalR aeR1 (fst ad) (drop r t)+ return (l + r)+ marshalR aer ad t+ = do marshalPrim aer mt ad n (head t)+ return 1+ --+ marshalPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> CUDA.Texture -> IO ()+ mkPrimDispatch(marshalPrim,Prim.marshalTextureData)+++-- |Raw device pointers associated with a host-side array+--+devicePtrsOfArrayData :: ArrayElt e => ArrayData e -> CIO (Prim.DevicePtrs e)+devicePtrsOfArrayData adata = ptrs =<< gets memoryTable+ where+ ptrs mt = liftIO $ ptrsR arrayElt adata+ where+ ptrsR :: ArrayEltR e -> ArrayData e -> IO (Prim.DevicePtrs e)+ ptrsR ArrayEltRunit _ = return ()+ ptrsR (ArrayEltRpair aeR1 aeR2) ad = (,) <$> ptrsR aeR1 (fst ad)+ <*> ptrsR aeR2 (snd ad)+ ptrsR aer ad = ptrsPrim aer mt ad+ --+ ptrsPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> IO (Prim.DevicePtrs e)+ mkPrimDispatch(ptrsPrim,Prim.devicePtrsOfArrayData)+++-- |Advance a set of device pointers by the given number of elements each+--+advancePtrsOfArrayData :: ArrayElt e => ArrayData e -> Int -> Prim.DevicePtrs e -> Prim.DevicePtrs e+advancePtrsOfArrayData adata n = advanceR arrayElt adata+ where+ advanceR :: ArrayEltR e -> ArrayData e -> Prim.DevicePtrs e -> Prim.DevicePtrs e+ advanceR ArrayEltRunit _ _ = ()+ advanceR (ArrayEltRpair aeR1 aeR2) ad (p1,p2) = (advanceR aeR1 (fst ad) p1+ ,advanceR aeR2 (snd ad) p2)+ advanceR aer ad ptr = advancePrim aer ad ptr+ --+ advancePrim :: ArrayEltR e -> ArrayData e -> Prim.DevicePtrs e -> Prim.DevicePtrs e+ mkPrimDispatch(advancePrim,Prim.advancePtrsOfArrayData n)++
+ Data/Array/Accelerate/CUDA/Array/Prim.hs view
@@ -0,0 +1,373 @@+{-# LANGUAGE BangPatterns, CPP, GADTs, TypeFamilies, ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Array.Prim+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Array.Prim (++ DevicePtrs, HostPtrs,++ mallocArray, useArray, useArrayAsync, indexArray, copyArray, peekArray, peekArrayAsync,+ pokeArray, pokeArrayAsync, marshalDevicePtrs, marshalArrayData, marshalTextureData,+ devicePtrsOfArrayData, advancePtrsOfArrayData++) where++-- libraries+import Prelude hiding (catch, lookup)+import Data.Int+import Data.Word+import Data.Maybe+import Data.Functor+import Data.Typeable+import Control.Monad+import Control.Exception+import System.Mem.StableName+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc+import Foreign.CUDA.Driver.Error+import qualified Foreign.CUDA.Driver as CUDA+import qualified Foreign.CUDA.Driver.Stream as CUDA+import qualified Foreign.CUDA.Driver.Texture as CUDA++-- friends+import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.CUDA.Array.Table+import qualified Data.Array.Accelerate.CUDA.Debug as D++#include "accelerate.h"+++-- Device array representation+-- ---------------------------++type family DevicePtrs e :: *+type family HostPtrs e :: *++type instance DevicePtrs () = ()+type instance HostPtrs () = ()++#define primArrayElt(ty) \+type instance DevicePtrs ty = CUDA.DevicePtr ty ; \+type instance HostPtrs ty = CUDA.HostPtr ty ; \++primArrayElt(Int)+primArrayElt(Int8)+primArrayElt(Int16)+primArrayElt(Int32)+primArrayElt(Int64)++primArrayElt(Word)+primArrayElt(Word8)+primArrayElt(Word16)+primArrayElt(Word32)+primArrayElt(Word64)++-- FIXME:+-- CShort+-- CUShort+-- CInt+-- CUInt+-- CLong+-- CULong+-- CLLong+-- CULLong++primArrayElt(Float)+primArrayElt(Double)++-- FIXME:+-- CFloat+-- CDouble++-- FIXME:+-- No concrete implementation in Data.Array.Accelerate.Array.Data+--+type instance HostPtrs Bool = ()+type instance DevicePtrs Bool = ()++type instance HostPtrs Char = ()+type instance DevicePtrs Char = ()++-- FIXME:+-- CChar+-- CSChar+-- CUChar++type instance DevicePtrs (a,b) = (DevicePtrs a, DevicePtrs b)+type instance HostPtrs (a,b) = (HostPtrs a, HostPtrs b)++++-- Texture References+-- ------------------++-- This representation must match the code generator's understanding of how to+-- utilise the texture cache.+--+class TextureData a where+ format :: a -> (CUDA.Format, Int)++instance TextureData Int8 where format _ = (CUDA.Int8, 1)+instance TextureData Int16 where format _ = (CUDA.Int16, 1)+instance TextureData Int32 where format _ = (CUDA.Int32, 1)+instance TextureData Int64 where format _ = (CUDA.Int32, 2)+instance TextureData Word8 where format _ = (CUDA.Word8, 1)+instance TextureData Word16 where format _ = (CUDA.Word16, 1)+instance TextureData Word32 where format _ = (CUDA.Word32, 1)+instance TextureData Word64 where format _ = (CUDA.Word32, 2)+instance TextureData Float where format _ = (CUDA.Float, 1)+instance TextureData Double where format _ = (CUDA.Int32, 2)++instance TextureData Int where+ format _ = case sizeOf (undefined :: Int) of+ 4 -> (CUDA.Int32, 1)+ 8 -> (CUDA.Int32, 2)+ _ -> error "we can never get here"++instance TextureData Word where+ format _ = case sizeOf (undefined :: Word) of+ 4 -> (CUDA.Word32, 1)+ 8 -> (CUDA.Word32, 2)+ _ -> error "we can never get here"++++-- Primitive array operations+-- --------------------------++-- Allocate a device-side array associated with the given host array. If the+-- allocation fails due to a lack of memory, run the garbage collector to+-- release any inaccessible arrays and try again.+--+mallocArray+ :: forall e a. (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr a, Typeable e, Typeable a, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> IO ()+mallocArray !mt !ad !n0 = do+ let !n = 1 `max` n0+ exists <- isJust <$> (lookup mt ad :: IO (Maybe (CUDA.DevicePtr a)))+ unless exists $ do+ message $ "mallocArray: " ++ showBytes (n * sizeOf (undefined::a))+ ptr <- CUDA.mallocArray n `catch` \(e :: CUDAException) ->+ case e of+ ExitCode OutOfMemory -> reclaim mt >> CUDA.mallocArray n+ _ -> throwIO e+ insert mt ad (ptr :: CUDA.DevicePtr a)+++-- A combination of 'mallocArray' and 'pokeArray' to allocate space on the+-- device and upload an existing array. This is specialised because if the host+-- array is shared on the heap, we do not need to do anything.+--+useArray+ :: forall e a. (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable e, Typeable a, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> IO ()+useArray !mt !ad !n0 =+ let src = ptrsOfArrayData ad+ !n = 1 `max` n0+ in do+ exists <- isJust <$> (lookup mt ad :: IO (Maybe (CUDA.DevicePtr a)))+ unless exists $ do+ message $ "useArray/malloc: " ++ showBytes (n * sizeOf (undefined::a))+ dst <- CUDA.mallocArray n `catch` \(e :: CUDAException) ->+ case e of+ ExitCode OutOfMemory -> reclaim mt >> CUDA.mallocArray n+ _ -> throwIO e+ CUDA.pokeArray n src dst+ insert mt ad dst+++useArrayAsync+ :: forall e a. (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable e, Typeable a, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> Maybe CUDA.Stream+ -> IO ()+useArrayAsync !mt !ad !n0 !ms =+ let src = CUDA.HostPtr (ptrsOfArrayData ad)+ !n = 1 `max` n0+ in do+ exists <- isJust <$> (lookup mt ad :: IO (Maybe (CUDA.DevicePtr a)))+ unless exists $ do+ message $ "useArrayAsync/malloc: " ++ showBytes (n * sizeOf (undefined::a))+ dst <- CUDA.mallocArray n `catch` \(e :: CUDAException) ->+ case e of+ ExitCode OutOfMemory -> reclaim mt >> CUDA.mallocArray n+ _ -> throwIO e+ CUDA.pokeArrayAsync n src dst ms+ insert mt ad dst+++-- Read a single element from an array at the given row-major index+--+indexArray+ :: (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr b, Typeable e, Typeable b, Storable b)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> IO b+indexArray !mt !ad !i =+ alloca $ \dst ->+ devicePtrsOfArrayData mt ad >>= \src -> do+ CUDA.peekArray 1 (src `CUDA.advanceDevPtr` i) dst+ peek dst+++-- Copy data between two device arrays. The operation is asynchronous with+-- respect to the host, but will never overlap kernel execution.+--+copyArray+ :: (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr b, Typeable a, Typeable b, Typeable e, Storable b)+ => MemoryTable+ -> ArrayData e -- source array+ -> ArrayData e -- destination array+ -> Int -- number of array elements+ -> IO ()+copyArray !mt !from !to !n = do+ src <- devicePtrsOfArrayData mt from+ dst <- devicePtrsOfArrayData mt to+ CUDA.copyArrayAsync n src dst+++-- Copy data from the device into the associated Accelerate host-side array+--+peekArray+ :: (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable a, Typeable e, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> IO ()+peekArray !mt !ad !n =+ devicePtrsOfArrayData mt ad >>= \src ->+ CUDA.peekArray n src (ptrsOfArrayData ad)++peekArrayAsync+ :: (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable a, Typeable e, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> Maybe CUDA.Stream+ -> IO ()+peekArrayAsync !mt !ad !n !st =+ devicePtrsOfArrayData mt ad >>= \src ->+ CUDA.peekArrayAsync n src (CUDA.HostPtr $ ptrsOfArrayData ad) st+++-- Copy data from an Accelerate array into the associated device array+--+pokeArray+ :: (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable a, Typeable e, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> IO ()+pokeArray !mt !ad !n =+ devicePtrsOfArrayData mt ad >>= \dst ->+ CUDA.pokeArray n (ptrsOfArrayData ad) dst++pokeArrayAsync+ :: (ArrayElt e, ArrayPtrs e ~ Ptr a, DevicePtrs e ~ CUDA.DevicePtr a, Typeable a, Typeable e, Storable a)+ => MemoryTable+ -> ArrayData e+ -> Int+ -> Maybe CUDA.Stream+ -> IO ()+pokeArrayAsync !mt !ad !n !st =+ devicePtrsOfArrayData mt ad >>= \dst ->+ CUDA.pokeArrayAsync n (CUDA.HostPtr $ ptrsOfArrayData ad) dst st+++-- Marshal device pointers to arguments that can be passed to kernel invocation+--+marshalDevicePtrs+ :: (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr b)+ => ArrayData e+ -> DevicePtrs e+ -> CUDA.FunParam+marshalDevicePtrs !_ !ptr = CUDA.VArg ptr+++-- Wrap a device pointer corresponding corresponding to a host-side array into+-- arguments that can be passed to a kernel upon invocation+--+marshalArrayData+ :: (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr b, Typeable b, Typeable e)+ => MemoryTable+ -> ArrayData e+ -> IO CUDA.FunParam+marshalArrayData !mt !ad = marshalDevicePtrs ad <$> devicePtrsOfArrayData mt ad+++-- Bind device memory to the given texture reference, setting appropriate type+--+marshalTextureData+ :: forall a e. (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr a, Typeable a, Typeable e, Storable a, TextureData a)+ => MemoryTable+ -> ArrayData e -- host array+ -> Int -- number of elements+ -> CUDA.Texture -- texture reference to bind array to+ -> IO ()+marshalTextureData !mt !ad !n !tex =+ let (fmt, c) = format (undefined :: a)+ in devicePtrsOfArrayData mt ad >>= \ptr -> do+ CUDA.setFormat tex fmt c+ CUDA.bind tex ptr (fromIntegral $ n * sizeOf (undefined :: a))+++-- Lookup the device memory associated with our host array+--+devicePtrsOfArrayData+ :: (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr b, Typeable e, Typeable b)+ => MemoryTable+ -> ArrayData e+ -> IO (DevicePtrs e)+devicePtrsOfArrayData !mt !ad = do+ mv <- lookup mt ad+ case mv of+ Just v -> return v+ Nothing -> do+ sn <- makeStableName ad+ INTERNAL_ERROR(error) "devicePtrsOfArrayData" $ "lost device memory #" ++ show (hashStableName sn)+++-- Advance device pointers by a given number of elements+--+advancePtrsOfArrayData+ :: (ArrayElt e, DevicePtrs e ~ CUDA.DevicePtr b, Storable b)+ => Int+ -> ArrayData e+ -> DevicePtrs e+ -> DevicePtrs e+advancePtrsOfArrayData !n !_ !ptr = CUDA.advanceDevPtr ptr n+++-- Debug+-- -----++{-# INLINE showBytes #-}+showBytes :: Int -> String+showBytes x = D.showFFloatSIBase (Just 0) 1024 (fromIntegral x :: Double) "B"++{-# INLINE trace #-}+trace :: String -> IO a -> IO a+trace msg next = D.message D.dump_gc ("gc: " ++ msg) >> next++{-# INLINE message #-}+message :: String -> IO ()+message s = s `trace` return ()+
+ Data/Array/Accelerate/CUDA/Array/Sugar.hs view
@@ -0,0 +1,44 @@+-- |+-- Module : Data.Array.Accelerate.CUDA.Array.Sugar+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Array.Sugar (++ module Data.Array.Accelerate.Array.Sugar,+ newArray, allocateArray, useArray++) where++import Data.Array.Accelerate.CUDA.State+import Data.Array.Accelerate.CUDA.Array.Data+import Data.Array.Accelerate.Array.Sugar hiding (newArray, allocateArray)+import qualified Data.Array.Accelerate.Array.Sugar as Sugar+++-- Create an array from its representation function, uploading the result to the+-- device+--+newArray :: (Shape sh, Elt e) => sh -> (sh -> e) -> CIO (Array sh e)+newArray sh f =+ let arr = Sugar.newArray sh f+ in do+ useArray arr+ return arr+++-- Allocate a new, uninitialised Accelerate array on host and device+--+allocateArray :: (Shape dim, Elt e) => dim -> CIO (Array dim e)+allocateArray sh =+ let arr = Sugar.allocateArray sh+ in do+ mallocArray arr+ return arr+
+ Data/Array/Accelerate/CUDA/Array/Table.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE BangPatterns, CPP, GADTs, PatternGuards #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Array.Table+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Array.Table (++ -- Tables for host/device memory associations+ MemoryTable, new, lookup, insert, reclaim++) where++import Prelude hiding ( lookup )+import Data.IORef ( IORef, newIORef, readIORef, mkWeakIORef )+import Data.Maybe ( isJust )+import Data.Hashable ( Hashable(..) )+import Data.Typeable ( Typeable, gcast )+import Control.Monad ( unless )+import Control.Exception ( bracket_ )+import Control.Applicative ( (<$>), (<*>) )+import System.Mem ( performGC )+import System.Mem.Weak ( Weak, mkWeak, deRefWeak, finalize )+import System.Mem.StableName ( StableName, makeStableName, hashStableName )+import Foreign.Ptr ( ptrToIntPtr )+import Foreign.CUDA.Ptr ( DevicePtr )++import qualified Foreign.CUDA.Driver as CUDA+import qualified Data.HashTable.IO as HT++import Data.Array.Accelerate.Array.Data ( ArrayData )+import qualified Data.Array.Accelerate.CUDA.Debug as D ( message, dump_gc )++#include "accelerate.h"+++-- We use an MVar to the hash table, so that several threads may safely access+-- it concurrently. This includes the finalisation threads that remove entries+-- from the table.+--+-- It is important that we can garbage collect old entries from the table when+-- the key is no longer reachable in the heap. Hence the value part of each+-- table entry is a (Weak val), where the stable name 'key' is the key for the+-- memo table, and the 'val' is the value of this table entry. When the key+-- becomes unreachable, a finaliser will fire and remove this entry from the+-- hash buckets, and further attempts to dereference the weak pointer will+-- return Nothing. References from 'val' to the key are ignored (see the+-- semantics of weak pointers in the documentation).+--+type HashTable key val = HT.BasicHashTable key val+type MT = IORef ( HashTable HostArray DeviceArray )+data MemoryTable = MemoryTable {-# UNPACK #-} !MT+ {-# UNPACK #-} !(Weak MT)+++data HostArray where+ HostArray :: Typeable e+ => {-# UNPACK #-} !CUDA.Context+ -> {-# UNPACK #-} !(StableName (ArrayData e))+ -> HostArray++data DeviceArray where+ DeviceArray :: Typeable e+ => {-# UNPACK #-} !(Weak (DevicePtr e))+ -> DeviceArray++instance Eq HostArray where+ HostArray _ a1 == HostArray _ a2+ = maybe False (== a2) (gcast a1)++instance Hashable HostArray where+ hash (HostArray (CUDA.Context p) sn) =+ fromIntegral (ptrToIntPtr p) `hashWithSalt` sn++instance Show HostArray where+ show (HostArray _ sn) = "Array #" ++ show (hashStableName sn)+++-- Referencing arrays+-- ------------------++-- Create a new hash table from host to device arrays. When the structure is+-- collected it will finalise all entries in the table.+--+new :: IO MemoryTable+new = do+ tbl <- HT.new+ ref <- newIORef tbl+ weak <- mkWeakIORef ref (table_finalizer tbl)+ return $! MemoryTable ref weak+++-- Look for the device memory corresponding to a given host-side array.+--+lookup :: (Typeable a, Typeable b) => MemoryTable -> ArrayData a -> IO (Maybe (DevicePtr b))+lookup (MemoryTable ref _) !arr = do+ sa <- makeStableArray arr+ mw <- withIORef ref (`HT.lookup` sa)+ case mw of+ Nothing -> trace ("lookup/not found: " ++ show sa) $ return Nothing+ Just (DeviceArray w) -> do+ mv <- deRefWeak w+ case mv of+ Just v | Just p <- gcast v -> trace ("lookup/found: " ++ show sa) $ return (Just p)+ | otherwise -> INTERNAL_ERROR(error) "lookup" $ "type mismatch"+ Nothing ->+ makeStableArray arr >>= \x -> INTERNAL_ERROR(error) "lookup" $ "dead weak pair: " ++ show x+++-- Record an association between a host-side array and a new device memory area.+-- The device memory will be freed when the host array is garbage collected.+--+insert :: (Typeable a, Typeable b) => MemoryTable -> ArrayData a -> DevicePtr b -> IO ()+insert (MemoryTable ref weak_ref) !arr !ptr = do+ key <- makeStableArray arr+ dev <- DeviceArray `fmap` mkWeak arr ptr (Just $ finalizer weak_ref key ptr)+ tbl <- readIORef ref+ message $ "insert: " ++ show key+ HT.insert tbl key dev+++-- Removing entries+-- ----------------++-- Initiate garbage collection and finalise any arrays that have been marked as+-- unreachable.+--+reclaim :: MemoryTable -> IO ()+reclaim (MemoryTable _ weak_ref) = do+ trace "reclaim" performGC+ mr <- deRefWeak weak_ref+ case mr of+ Nothing -> return ()+ Just ref -> withIORef ref $ \tbl ->+ flip HT.mapM_ tbl $ \(_,DeviceArray w) -> do+ alive <- isJust `fmap` deRefWeak w+ unless alive $ finalize w+++-- Because a finaliser might run at any time, we must reinstate the context in+-- which the array was allocated before attempting to release it.+--+-- Note also that finaliser threads will silently terminate if an exception is+-- raised. If the context, and thereby all allocated memory, was destroyed+-- externally before the thread had a chance to run, all we need do is update+-- the hash tables --- but we must do this first before failing to use a dead+-- context.+--+finalizer :: Weak MT -> HostArray -> DevicePtr b -> IO ()+finalizer !weak_ref !key@(HostArray ctx _) !ptr = do+ mr <- deRefWeak weak_ref+ case mr of+ Nothing -> trace ("finalise/dead table: " ++ show key) $ return ()+ Just ref -> trace ("finalise: " ++ show key) $ withIORef ref (`HT.delete` key)+ --+ bracket_+ (CUDA.push ctx)+ (CUDA.pop)+ (CUDA.free ptr)+++table_finalizer :: HashTable HostArray DeviceArray -> IO ()+table_finalizer !tbl+ = trace "table finaliser"+ $ HT.mapM_ (\(_,DeviceArray w) -> finalize w) tbl+++-- Miscellaneous+-- -------------++{-# INLINE makeStableArray #-}+makeStableArray :: Typeable a => ArrayData a -> IO HostArray+makeStableArray !arr = HostArray <$> CUDA.get <*> makeStableName arr++{-# INLINE withIORef #-}+withIORef :: IORef a -> (a -> IO b) -> IO b+withIORef ref f = readIORef ref >>= f+++-- Debug+-- -----++{-# INLINE trace #-}+trace :: String -> IO a -> IO a+trace msg next = D.message D.dump_gc ("gc: " ++ msg) >> next++{-# INLINE message #-}+message :: String -> IO ()+message s = s `trace` return ()+
+ Data/Array/Accelerate/CUDA/CodeGen.hs view
@@ -0,0 +1,643 @@+{-# LANGUAGE CPP, GADTs, PatternGuards, ScopedTypeVariables, QuasiQuotes #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen (++ CUTranslSkel, codegenAcc++) where++-- libraries+import Prelude hiding ( exp )+import Data.Loc+import Data.Char+import Control.Monad+import Control.Applicative hiding ( Const )+import Text.PrettyPrint.Mainland+import Language.C.Syntax ( Const(..) )+import Language.C.Quote.CUDA+import qualified Data.HashSet as Set+import qualified Language.C as C+import qualified Foreign.CUDA.Analysis as CUDA++-- friends+import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Pretty ()+import Data.Array.Accelerate.Analysis.Shape+import Data.Array.Accelerate.Array.Representation+import qualified Data.Array.Accelerate.Array.Sugar as Sugar+import qualified Data.Array.Accelerate.Analysis.Type as Sugar++import Data.Array.Accelerate.CUDA.AST hiding ( Val(..), prj )+import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type+import Data.Array.Accelerate.CUDA.CodeGen.Monad+import Data.Array.Accelerate.CUDA.CodeGen.Mapping+import Data.Array.Accelerate.CUDA.CodeGen.IndexSpace+import Data.Array.Accelerate.CUDA.CodeGen.PrefixSum+import Data.Array.Accelerate.CUDA.CodeGen.Reduction+import Data.Array.Accelerate.CUDA.CodeGen.Stencil++#include "accelerate.h"+++data Val env where+ Empty :: Val ()+ Push :: Val env -> [C.Exp] -> Val (env, s)++prj :: Idx env t -> Val env -> [C.Exp]+prj ZeroIdx (Push _ v) = v+prj (SuccIdx ix) (Push val _) = prj ix val+prj _ _ = INTERNAL_ERROR(error) "prj" "inconsistent valuation"+++-- Array expressions+-- -----------------++-- | Instantiate an array computation with a set of concrete function and type+-- definitions to fix the parameters of an algorithmic skeleton. The generated+-- code can then be pretty-printed to file, and compiled to object code+-- executable on the device.+--+-- The code generator needs to include binding points for array references from+-- scalar code. We require that the only array form allowed within expressions+-- are array variables.+--+-- TODO: include a measure of how much shared memory a kernel requires.+--+codegenAcc :: forall aenv a.+ CUDA.DeviceProperties+ -> OpenAcc aenv a+ -> AccBindings aenv+ -> CUTranslSkel+codegenAcc dev acc (AccBindings vars) = CUTranslSkel entry (extras : fvars code)+ where+ fvars rest = Set.foldr (\v vs -> liftAcc acc v ++ vs) rest vars+ extras = [cedecl| $esc:("#include <accelerate_cuda_extras.h>") |]+ CUTranslSkel entry code = codegen acc++ codegen :: OpenAcc aenv a -> CUTranslSkel+ codegen (OpenAcc pacc) = case pacc of+ --+ -- Non-computation forms+ --+ Alet _ _ -> internalError+ Avar _ -> internalError+ Apply _ _ -> internalError+ Acond _ _ _ -> internalError+ Atuple _ -> internalError+ Aprj _ _ -> internalError+ Use _ -> internalError+ Unit _ -> internalError+ Reshape _ _ -> internalError++ --+ -- Skeleton nodes+ --+ Generate _ f -> mkGenerate (accDim acc) (codegenFun f)++ Replicate sl _ a -> mkReplicate dimSl dimOut (extend sl) (undefined :: a)+ where+ dimSl = accDim a+ dimOut = accDim acc+ --+ extend :: SliceIndex slix sl co dim -> CUExp dim+ extend = CUExp [] . reverse . extend' 0++ extend' :: Int -> SliceIndex slix sl co dim -> [C.Exp]+ extend' _ (SliceNil) = []+ extend' n (SliceAll sliceIdx) = mkPrj dimOut "dim" n : extend' (n+1) sliceIdx+ extend' n (SliceFixed sliceIdx) = extend' (n+1) sliceIdx++ Index sl a slix -> mkSlice dimSl dimCo dimIn0 (restrict sl) (undefined :: a)+ where+ dimCo = length (expType slix)+ dimSl = accDim acc+ dimIn0 = accDim a+ --+ restrict :: SliceIndex slix sl co dim -> CUExp slix+ restrict = CUExp [] . reverse . restrict' (0,0)++ restrict' :: (Int,Int) -> SliceIndex slix sl co dim -> [C.Exp]+ restrict' _ (SliceNil) = []+ restrict' (m,n) (SliceAll sliceIdx) = mkPrj dimSl "sl" n : restrict' (m,n+1) sliceIdx+ restrict' (m,n) (SliceFixed sliceIdx) = mkPrj dimCo "co" m : restrict' (m+1,n) sliceIdx++ Map f _ -> mkMap (codegenFun f)+ ZipWith f _ _ -> mkZipWith (accDim acc) (codegenFun f)++ Fold f e _ ->+ if accDim acc == 0+ then mkFoldAll dev (codegenFun f) (Just (codegenExp e))+ else mkFold dev (codegenFun f) (Just (codegenExp e))++ Fold1 f _ ->+ if accDim acc == 0+ then mkFoldAll dev (codegenFun f) Nothing+ else mkFold dev (codegenFun f) Nothing++ FoldSeg f e _ s -> mkFoldSeg dev (accDim acc) (segmentsType s) (codegenFun f) (Just (codegenExp e))+ Fold1Seg f _ s -> mkFoldSeg dev (accDim acc) (segmentsType s) (codegenFun f) Nothing++ Scanl f e _ -> mkScanl dev (codegenFun f) (Just (codegenExp e))+ Scanl' f e _ -> mkScanl dev (codegenFun f) (Just (codegenExp e))+ Scanl1 f _ -> mkScanl dev (codegenFun f) Nothing++ Scanr f e _ -> mkScanr dev (codegenFun f) (Just (codegenExp e))+ Scanr' f e _ -> mkScanr dev (codegenFun f) (Just (codegenExp e))+ Scanr1 f _ -> mkScanr dev (codegenFun f) Nothing++ Permute f _ ix a -> mkPermute dev (accDim acc) (accDim a) (codegenFun f) (codegenFun ix)+ Backpermute _ f a -> mkBackpermute (accDim acc) (accDim a) (codegenFun f) (undefined :: a)++ Stencil f b0 a0 -> mkStencil (accDim acc) (codegenFun f) (codegenBoundary a0 b0) (undefined :: a)+ Stencil2 f b1 a1 b0 a0+ -> mkStencil2 (accDim acc) (codegenFun f) (codegenBoundary a1 b1) (codegenBoundary a0 b0) (undefined :: a)++ --+ -- caffeine and misery+ --+ internalError =+ let msg = unlines ["unsupported array primitive", pretty 100 (nest 2 doc)]+ pac = show acc+ doc | length pac <= 250 = text pac+ | otherwise = text (take 250 pac) <+> text "... {truncated}"+ in+ INTERNAL_ERROR(error) "codegenAcc" msg++ -- Generate binding points (texture references and shapes) for arrays lifted+ -- from scalar expressions+ --+ liftAcc :: OpenAcc aenv a -> ArrayVar aenv -> [C.Definition]+ liftAcc _ (ArrayVar idx) =+ let avar = OpenAcc (Avar idx)+ idx' = show $ idxToInt idx+ sh = cshape ("sh" ++ idx') (accDim avar)+ ty = accTypeTex avar+ arr n = "arr" ++ idx' ++ "_a" ++ show (n::Int)+ in+ sh : zipWith (\t n -> cglobal t (arr n)) (reverse ty) [0..]++ -- Shapes are still represented as C structs, so we need to generate field+ -- indexing code for shapes+ --+ mkPrj :: Int -> String -> Int -> C.Exp+ mkPrj ndim var c+ | ndim <= 1 = cvar var+ | otherwise = [cexp| $exp:(cvar var) . $id:('a':show c) |]+++ -- code generation for stencil boundary conditions+ --+ codegenBoundary :: forall dim e. Sugar.Elt e+ => OpenAcc aenv (Sugar.Array dim e) {- dummy -}+ -> Boundary (Sugar.EltRepr e)+ -> Boundary (CUExp e)+ codegenBoundary _ Clamp = Clamp+ codegenBoundary _ Mirror = Mirror+ codegenBoundary _ Wrap = Wrap+ codegenBoundary _ (Constant c)+ = Constant . CUExp []+ $ codegenConst (Sugar.eltType (undefined::e)) c++++-- Scalar Expressions+-- ------------------++-- Function abstraction+--+-- Although Accelerate includes lambda abstractions, it does not include a+-- general application form. That is, lambda abstractions of scalar expressions+-- are only introduced as arguments to collective operations, so lambdas are+-- always outermost, and can always be translated into plain C functions.+--+codegenFun :: Fun aenv t -> CUFun t+codegenFun fun = runCGM $ codegenOpenFun (arity fun) fun Empty+ where+ arity :: OpenFun env aenv t -> Int+ arity (Body _) = -1+ arity (Lam f) = 1 + arity f++codegenOpenFun :: Int -> OpenFun env aenv t -> Val env -> CGM (CUFun t)+codegenOpenFun _lvl (Body e) env = do+ e' <- codegenOpenExp e env+ env' <- environment+ zipWithM_ addVar (expType e) e'+ return $ CUBody (CUExp env' e')++codegenOpenFun lvl (Lam (f :: OpenFun (env,a) aenv b)) env = do+ let ty = eltType (undefined::a)+ n = length ty+ vars = map (\i -> cvar ('x':shows lvl "_a" ++ show i)) [n-1,n-2..0]+ weaken+ f' <- codegenOpenFun (lvl-1) f (env `Push` vars)+ vars' <- subscripts lvl+ return $ CULam vars' f'+++-- Embedded scalar computations+--+codegenExp :: Exp aenv t -> CUExp t+codegenExp exp = runCGM $ do+ e' <- codegenOpenExp exp Empty+ env' <- environment+ return $ CUExp env' e'+++codegenOpenExp :: forall env aenv t. OpenExp env aenv t -> Val env -> CGM [C.Exp]+codegenOpenExp exp env =+ case exp of+ -- local binders and variable indices+ --+ -- NOTE: recording which variables are used is important, because the CUDA+ -- compiler will not eliminate variables that are initialised but never+ -- used. If this is a scalar type mark it as used immediately, otherwise+ -- wait until tuple projection picks out an individual element.+ --+ Let a b -> do+ a' <- codegenOpenExp a env+ vars <- zipWithM bindVars (expType a) a'+ codegenOpenExp b (env `Push` vars)+ where+ -- FIXME: if we are let-binding an input argument (read from global+ -- array) mark that as used and return the variable name directly,+ -- otherwise create a fresh binding point.+ --+ bindVars t x = do+ p <- addVar t x+ if p then return x+ else bind t x++ Var ix+ | [t] <- ty, [v] <- var -> addVar t v >> return var+ | otherwise -> return var+ where+ var = prj ix env+ ty = eltType (undefined :: t)++ -- Constant values+ --+ PrimConst c -> return [codegenPrimConst c]+ Const c -> return (codegenConst (Sugar.eltType (undefined::t)) c)++ -- Primitive scalar operations+ --+ PrimApp f arg -> do+ x <- codegenOpenExp arg env+ return [codegenPrim f x]++ -- Tuples+ --+ Tuple t -> codegenTup t env+ Prj idx e -> do+ e' <- codegenOpenExp e env+ case subset (zip e' elt) of+ [(x,t)] -> addVar t x >> return [x]+ xts -> return $ fst (unzip xts)+ where+ elt = expType e+ subset = reverse+ . take (length (expType exp))+ . drop (prjToInt idx (Sugar.expType e))+ . reverse++ -- Conditional expression+ --+ Cond p t e -> do+ t' <- codegenOpenExp t env+ e' <- codegenOpenExp e env+ p' <- codegenOpenExp p env >>= \ps ->+ case ps of+ [x] -> bind [cty| typename bool |] x+ _ -> INTERNAL_ERROR(error) "codegenOpenExp" "expected conditional predicate"+ --+ return $ zipWith (\a b -> [cexp| $exp:p' ? $exp:a : $exp:b|]) t' e'++ -- Array indices and shapes+ --+ IndexNil -> return []+ IndexAny -> return []+ IndexCons sh sz -> do+ sh' <- codegenOpenExp sh env+ sz' <- codegenOpenExp sz env+ return (sh' ++ sz')++ IndexHead ix -> do+ ix' <- last <$> codegenOpenExp ix env+ _ <- addVar (last (expType ix)) ix'+ return [ix']++ IndexTail ix -> do+ ix' <- codegenOpenExp ix env+ return (init ix')++ -- Array shape and element indexing+ --+ ShapeSize sh -> do+ sh' <- codegenOpenExp sh env+ return [ ccall "size" [ccall "shape" sh'] ]++ Shape arr+ | OpenAcc (Avar a) <- arr ->+ let ndim = accDim arr+ sh = cvar ("sh" ++ show (idxToInt a))+ in return $ if ndim <= 1+ then [sh]+ else map (\c -> [cexp| $exp:sh . $id:('a':show c) |] ) [ndim-1, ndim-2 .. 0]++ | otherwise -> INTERNAL_ERROR(error) "codegenOpenExp" "expected array variable"++ IndexScalar arr ix+ | OpenAcc (Avar a) <- arr ->+ let avar = show (idxToInt a)+ sh = cvar ("sh" ++ avar)+ array x = cvar ("arr" ++ avar ++ "_a" ++ show x)+ elt = accTypeTex arr+ n = length elt+ in do+ ix' <- codegenOpenExp ix env+ v <- bind [cty| int |] (ccall "toIndex" [sh, ccall "shape" ix'])+ return $ zipWith (\t x -> indexArray t (array x) v) elt [n-1, n-2 .. 0]++ | otherwise -> INTERNAL_ERROR(error) "codegenOpenExp" "expected array variable"+++-- Tuples are defined as snoc-lists, so generate code right-to-left+--+codegenTup :: Tuple (OpenExp env aenv) t -> Val env -> CGM [C.Exp]+codegenTup tup env = case tup of+ NilTup -> return []+ SnocTup t e -> (++) <$> codegenTup t env <*> codegenOpenExp e env+++-- Convert a tuple index into the corresponding integer. Since the internal+-- representation is flat, be sure to walk over all sub components when indexing+-- past nested tuples.+--+prjToInt :: TupleIdx t e -> TupleType a -> Int+prjToInt ZeroTupIdx _ = 0+prjToInt (SuccTupIdx i) (b `PairTuple` a) = sizeTupleType a + prjToInt i b+prjToInt _ _ =+ INTERNAL_ERROR(error) "prjToInt" "inconsistent valuation"++sizeTupleType :: TupleType a -> Int+sizeTupleType UnitTuple = 0+sizeTupleType (SingleTuple _) = 1+sizeTupleType (PairTuple a b) = sizeTupleType a + sizeTupleType b+++-- Recording which variables of a computation are actually used is important,+-- particularly for stencils and arrays of tuples, because the CUDA compiler+-- will not eliminate variables that are initialised but never used.+--+-- FIXME: This dubious hack is used to inspect the expression and mark as used+-- if it refers to an array input.+--+addVar :: C.Type -> C.Exp -> CGM Bool+addVar ty exp = case show exp of+ ('x':v:'_':'a':n) | [(v',[])] <- reads [v], [(n',[])] <- reads n+ -> use v' n' ty exp >> return True+ _ -> return False+++-- Scalar Primitives+-- -----------------++codegenPrimConst :: PrimConst a -> C.Exp+codegenPrimConst (PrimMinBound ty) = codegenMinBound ty+codegenPrimConst (PrimMaxBound ty) = codegenMaxBound ty+codegenPrimConst (PrimPi ty) = codegenPi ty+++codegenPrim :: PrimFun p -> [C.Exp] -> C.Exp+codegenPrim (PrimAdd _) [a,b] = [cexp|$exp:a + $exp:b|]+codegenPrim (PrimSub _) [a,b] = [cexp|$exp:a - $exp:b|]+codegenPrim (PrimMul _) [a,b] = [cexp|$exp:a * $exp:b|]+codegenPrim (PrimNeg _) [a] = [cexp| - $exp:a|]+codegenPrim (PrimAbs ty) [a] = codegenAbs ty a+codegenPrim (PrimSig ty) [a] = codegenSig ty a+codegenPrim (PrimQuot _) [a,b] = [cexp|$exp:a / $exp:b|]+codegenPrim (PrimRem _) [a,b] = [cexp|$exp:a % $exp:b|]+codegenPrim (PrimIDiv _) [a,b] = ccall "idiv" [a,b]+codegenPrim (PrimMod _) [a,b] = ccall "mod" [a,b]+codegenPrim (PrimBAnd _) [a,b] = [cexp|$exp:a & $exp:b|]+codegenPrim (PrimBOr _) [a,b] = [cexp|$exp:a | $exp:b|]+codegenPrim (PrimBXor _) [a,b] = [cexp|$exp:a ^ $exp:b|]+codegenPrim (PrimBNot _) [a] = [cexp|~ $exp:a|]+codegenPrim (PrimBShiftL _) [a,b] = [cexp|$exp:a << $exp:b|]+codegenPrim (PrimBShiftR _) [a,b] = [cexp|$exp:a >> $exp:b|]+codegenPrim (PrimBRotateL _) [a,b] = ccall "rotateL" [a,b]+codegenPrim (PrimBRotateR _) [a,b] = ccall "rotateR" [a,b]+codegenPrim (PrimFDiv _) [a,b] = [cexp|$exp:a / $exp:b|]+codegenPrim (PrimRecip ty) [a] = codegenRecip ty a+codegenPrim (PrimSin ty) [a] = ccall (FloatingNumType ty `postfix` "sin") [a]+codegenPrim (PrimCos ty) [a] = ccall (FloatingNumType ty `postfix` "cos") [a]+codegenPrim (PrimTan ty) [a] = ccall (FloatingNumType ty `postfix` "tan") [a]+codegenPrim (PrimAsin ty) [a] = ccall (FloatingNumType ty `postfix` "asin") [a]+codegenPrim (PrimAcos ty) [a] = ccall (FloatingNumType ty `postfix` "acos") [a]+codegenPrim (PrimAtan ty) [a] = ccall (FloatingNumType ty `postfix` "atan") [a]+codegenPrim (PrimAsinh ty) [a] = ccall (FloatingNumType ty `postfix` "asinh") [a]+codegenPrim (PrimAcosh ty) [a] = ccall (FloatingNumType ty `postfix` "acosh") [a]+codegenPrim (PrimAtanh ty) [a] = ccall (FloatingNumType ty `postfix` "atanh") [a]+codegenPrim (PrimExpFloating ty) [a] = ccall (FloatingNumType ty `postfix` "exp") [a]+codegenPrim (PrimSqrt ty) [a] = ccall (FloatingNumType ty `postfix` "sqrt") [a]+codegenPrim (PrimLog ty) [a] = ccall (FloatingNumType ty `postfix` "log") [a]+codegenPrim (PrimFPow ty) [a,b] = ccall (FloatingNumType ty `postfix` "pow") [a,b]+codegenPrim (PrimLogBase ty) [a,b] = codegenLogBase ty a b+codegenPrim (PrimTruncate ta tb) [a] = codegenTruncate ta tb a+codegenPrim (PrimRound ta tb) [a] = codegenRound ta tb a+codegenPrim (PrimFloor ta tb) [a] = codegenFloor ta tb a+codegenPrim (PrimCeiling ta tb) [a] = codegenCeiling ta tb a+codegenPrim (PrimAtan2 ty) [a,b] = ccall (FloatingNumType ty `postfix` "atan2") [a,b]+codegenPrim (PrimLt _) [a,b] = [cexp|$exp:a < $exp:b|]+codegenPrim (PrimGt _) [a,b] = [cexp|$exp:a > $exp:b|]+codegenPrim (PrimLtEq _) [a,b] = [cexp|$exp:a <= $exp:b|]+codegenPrim (PrimGtEq _) [a,b] = [cexp|$exp:a >= $exp:b|]+codegenPrim (PrimEq _) [a,b] = [cexp|$exp:a == $exp:b|]+codegenPrim (PrimNEq _) [a,b] = [cexp|$exp:a != $exp:b|]+codegenPrim (PrimMax ty) [a,b] = codegenMax ty a b+codegenPrim (PrimMin ty) [a,b] = codegenMin ty a b+codegenPrim PrimLAnd [a,b] = [cexp|$exp:a && $exp:b|]+codegenPrim PrimLOr [a,b] = [cexp|$exp:a || $exp:b|]+codegenPrim PrimLNot [a] = [cexp| ! $exp:a|]+codegenPrim PrimOrd [a] = codegenOrd a+codegenPrim PrimChr [a] = codegenChr a+codegenPrim PrimBoolToInt [a] = codegenBoolToInt a+codegenPrim (PrimFromIntegral ta tb) [a] = codegenFromIntegral ta tb a++-- If the argument lists are not the correct length+codegenPrim _ _ =+ INTERNAL_ERROR(error) "codegenPrim" "inconsistent valuation"++-- Implementation of scalar primitives+--+codegenConst :: TupleType a -> a -> [C.Exp]+codegenConst UnitTuple _ = []+codegenConst (SingleTuple ty) c = [codegenScalar ty c]+codegenConst (PairTuple ty1 ty0) (cs,c) = codegenConst ty1 cs ++ codegenConst ty0 c+++-- Scalar constants+--+codegenScalar :: ScalarType a -> a -> C.Exp+codegenScalar (NumScalarType ty) = codegenNumScalar ty+codegenScalar (NonNumScalarType ty) = codegenNonNumScalar ty++codegenNumScalar :: NumType a -> a -> C.Exp+codegenNumScalar (IntegralNumType ty) = codegenIntegralScalar ty+codegenNumScalar (FloatingNumType ty) = codegenFloatingScalar ty++codegenIntegralScalar :: IntegralType a -> a -> C.Exp+codegenIntegralScalar ty x | IntegralDict <- integralDict ty = [cexp| ( $ty:(codegenIntegralType ty) ) $exp:(cintegral x) |]++codegenFloatingScalar :: FloatingType a -> a -> C.Exp+codegenFloatingScalar (TypeFloat _) x = C.Const (FloatConst (shows x "f") (toRational x) noSrcLoc) noSrcLoc+codegenFloatingScalar (TypeCFloat _) x = C.Const (FloatConst (shows x "f") (toRational x) noSrcLoc) noSrcLoc+codegenFloatingScalar (TypeDouble _) x = C.Const (DoubleConst (show x) (toRational x) noSrcLoc) noSrcLoc+codegenFloatingScalar (TypeCDouble _) x = C.Const (DoubleConst (show x) (toRational x) noSrcLoc) noSrcLoc++codegenNonNumScalar :: NonNumType a -> a -> C.Exp+codegenNonNumScalar (TypeBool _) x = cbool x+codegenNonNumScalar (TypeChar _) x = [cexp|$char:x|]+codegenNonNumScalar (TypeCChar _) x = [cexp|$char:(chr (fromIntegral x))|]+codegenNonNumScalar (TypeCUChar _) x = [cexp|$char:(chr (fromIntegral x))|]+codegenNonNumScalar (TypeCSChar _) x = [cexp|$char:(chr (fromIntegral x))|]+++-- Constant methods of floating+--+codegenPi :: FloatingType a -> C.Exp+codegenPi ty | FloatingDict <- floatingDict ty = codegenFloatingScalar ty pi+++-- Constant methods of bounded+--+codegenMinBound :: BoundedType a -> C.Exp+codegenMinBound (IntegralBoundedType ty) | IntegralDict <- integralDict ty = codegenIntegralScalar ty minBound+codegenMinBound (NonNumBoundedType ty) | NonNumDict <- nonNumDict ty = codegenNonNumScalar ty minBound+++codegenMaxBound :: BoundedType a -> C.Exp+codegenMaxBound (IntegralBoundedType ty) | IntegralDict <- integralDict ty = codegenIntegralScalar ty maxBound+codegenMaxBound (NonNumBoundedType ty) | NonNumDict <- nonNumDict ty = codegenNonNumScalar ty maxBound+++-- Methods from Num, Floating, Fractional and RealFrac+--+codegenAbs :: NumType a -> C.Exp -> C.Exp+codegenAbs (FloatingNumType ty) x = ccall (FloatingNumType ty `postfix` "fabs") [x]+codegenAbs (IntegralNumType ty) x =+ case ty of+ TypeWord _ -> x+ TypeWord8 _ -> x+ TypeWord16 _ -> x+ TypeWord32 _ -> x+ TypeWord64 _ -> x+ TypeCUShort _ -> x+ TypeCUInt _ -> x+ TypeCULong _ -> x+ TypeCULLong _ -> x+ _ -> ccall "abs" [x]+++codegenSig :: NumType a -> C.Exp -> C.Exp+codegenSig (IntegralNumType ty) = codegenIntegralSig ty+codegenSig (FloatingNumType ty) = codegenFloatingSig ty++codegenIntegralSig :: IntegralType a -> C.Exp -> C.Exp+codegenIntegralSig ty x = [cexp|$exp:x == $exp:zero ? $exp:zero : $exp:(ccall "copysign" [one,x]) |]+ where+ zero | IntegralDict <- integralDict ty = codegenIntegralScalar ty 0+ one | IntegralDict <- integralDict ty = codegenIntegralScalar ty 1++codegenFloatingSig :: FloatingType a -> C.Exp -> C.Exp+codegenFloatingSig ty x = [cexp|$exp:x == $exp:zero ? $exp:zero : $exp:(ccall (FloatingNumType ty `postfix` "copysign") [one,x]) |]+ where+ zero | FloatingDict <- floatingDict ty = codegenFloatingScalar ty 0+ one | FloatingDict <- floatingDict ty = codegenFloatingScalar ty 1+++codegenRecip :: FloatingType a -> C.Exp -> C.Exp+codegenRecip ty x | FloatingDict <- floatingDict ty = [cexp|$exp:(codegenFloatingScalar ty 1) / $exp:x|]+++codegenLogBase :: FloatingType a -> C.Exp -> C.Exp -> C.Exp+codegenLogBase ty x y = let a = ccall (FloatingNumType ty `postfix` "log") [x]+ b = ccall (FloatingNumType ty `postfix` "log") [y]+ in+ [cexp|$exp:b / $exp:a|]+++codegenMin :: ScalarType a -> C.Exp -> C.Exp -> C.Exp+codegenMin (NumScalarType ty@(IntegralNumType _)) a b = ccall (ty `postfix` "min") [a,b]+codegenMin (NumScalarType ty@(FloatingNumType _)) a b = ccall (ty `postfix` "fmin") [a,b]+codegenMin (NonNumScalarType _) a b =+ let ty = scalarType :: ScalarType Int32+ in codegenMin ty (ccast ty a) (ccast ty b)+++codegenMax :: ScalarType a -> C.Exp -> C.Exp -> C.Exp+codegenMax (NumScalarType ty@(IntegralNumType _)) a b = ccall (ty `postfix` "max") [a,b]+codegenMax (NumScalarType ty@(FloatingNumType _)) a b = ccall (ty `postfix` "fmax") [a,b]+codegenMax (NonNumScalarType _) a b =+ let ty = scalarType :: ScalarType Int32+ in codegenMax ty (ccast ty a) (ccast ty b)+++-- Type coercions+--+codegenOrd :: C.Exp -> C.Exp+codegenOrd = ccast (scalarType :: ScalarType Int)++codegenChr :: C.Exp -> C.Exp+codegenChr = ccast (scalarType :: ScalarType Char)++codegenBoolToInt :: C.Exp -> C.Exp+codegenBoolToInt = ccast (scalarType :: ScalarType Int)++codegenFromIntegral :: IntegralType a -> NumType b -> C.Exp -> C.Exp+codegenFromIntegral _ ty = ccast (NumScalarType ty)++codegenTruncate :: FloatingType a -> IntegralType b -> C.Exp -> C.Exp+codegenTruncate ta tb x+ = ccast (NumScalarType (IntegralNumType tb))+ $ ccall (FloatingNumType ta `postfix` "trunc") [x]++codegenRound :: FloatingType a -> IntegralType b -> C.Exp -> C.Exp+codegenRound ta tb x+ = ccast (NumScalarType (IntegralNumType tb))+ $ ccall (FloatingNumType ta `postfix` "round") [x]++codegenFloor :: FloatingType a -> IntegralType b -> C.Exp -> C.Exp+codegenFloor ta tb x+ = ccast (NumScalarType (IntegralNumType tb))+ $ ccall (FloatingNumType ta `postfix` "floor") [x]++codegenCeiling :: FloatingType a -> IntegralType b -> C.Exp -> C.Exp+codegenCeiling ta tb x+ = ccast (NumScalarType (IntegralNumType tb))+ $ ccall (FloatingNumType ta `postfix` "ceil") [x]+++-- Auxiliary Functions+-- -------------------++ccast :: ScalarType a -> C.Exp -> C.Exp+ccast ty x = [cexp|($ty:(codegenScalarType ty)) $exp:x|]++postfix :: NumType a -> String -> String+postfix (FloatingNumType (TypeFloat _)) = (++ "f")+postfix (FloatingNumType (TypeCFloat _)) = (++ "f")+postfix _ = id+
+ Data/Array/Accelerate/CUDA/CodeGen/Base.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.Base+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.Base (++ -- Types+ CUTranslSkel(..), CUFun(..), CUExp(..),++ -- Declaration generation+ typename, cptr, cvar, ccall, cchar, cintegral, cbool, cdim, cglobal, cshape,+ setters, getters, shared, indexArray,++ -- Mutable operations+ (.=.), locals++) where++import Data.Loc+import Data.Char+import Data.List+import Language.C.Syntax+import Language.C.Quote.CUDA+import Text.PrettyPrint.Mainland ( Pretty(..) )++import Data.Array.Accelerate.Array.Sugar ( Elt )+++-- Compilation units+-- -----------------++-- A CUDA compilation unit, together with the name of the main __global__ entry+-- function.+--+data CUTranslSkel = CUTranslSkel String [Definition]++instance Show CUTranslSkel where+ show (CUTranslSkel entry _) = entry++instance Pretty CUTranslSkel where+ ppr (CUTranslSkel _ code) = ppr code+++-- Scalar functions and expressions, including the environment of local+-- let-bindings and array data elements.+--+data CUFun a where+ CUBody :: CUExp a -> CUFun a+ CULam :: Elt a => [(Int, Type, Exp)] -> CUFun t -> CUFun (a -> t)++data CUExp e where+ CUExp :: [InitGroup] -> [Exp] -> CUExp e+++-- Expression and Declaration generation+-- -------------------------------------++cvar :: String -> Exp+cvar x = [cexp|$id:x|]++ccall :: String -> [Exp] -> Exp+ccall fn args = [cexp|$id:fn ($args:args)|]++typename :: String -> Type+typename name = Type (DeclSpec [] [] (Tnamed (Id name noSrcLoc) noSrcLoc) noSrcLoc) (DeclRoot noSrcLoc) noSrcLoc++cchar :: Char -> Exp+cchar c = [cexp|$char:c|]++cintegral :: (Integral a, Show a) => a -> Exp+cintegral n = [cexp|$int:n|]++cbool :: Bool -> Exp+cbool = cintegral . fromEnum++cdim :: String -> Int -> Definition+cdim name n = [cedecl|typedef typename $id:("DIM" ++ show n) $id:name;|]+++cglobal :: Type -> String -> Definition+cglobal ty name = [cedecl|static $ty:ty $id:name;|]++cshape :: String -> Int -> Definition+cshape name n = [cedecl| static __constant__ typename $id:("DIM" ++ show n) $id:name;|]++indexArray :: Type -> Exp -> Exp -> Exp+indexArray ty arr ix+ | "double" `isSuffixOf` map toLower (show ty) = ccall "indexDArray" [arr, ix]+ | otherwise = ccall "indexArray" [arr, ix]+++-- Generate a list of variable bindings and declarations to read from the input+-- arrays.+--+-- In the case where the input array is an array of tuples, the function+-- parameters naturally include all components, but the scalar declarations+-- include only those indices that are used.+--+getters+ :: Int -- base de Bruijn index+ -> [Type] -- the array element type+ -> [(Int, Type, Exp)] -- the variables used in the scalar expression+ -> ( [Param] -- function parameters for array(s) input+ , [Exp] -- variable names+ , [InitGroup] -- non-const variable declarations+ , String -> [Exp] -- index global array+ , String -> [InitGroup] ) -- const declarations and initialisation from index+getters base arrElt expElt =+ let n = length arrElt+ arr x = "d_in" ++ shows base "_a" ++ show x+ arrParams = zipWith (\t x -> [cparam| const $ty:(cptr t) $id:(arr x) |]) arrElt [n-1, n-2 .. 0]+ expVars = map (\(_,_,v) -> v) expElt+ expDecls = map (\(_,t,v) -> [cdecl| $ty:t $id:(show v) ; |]) expElt+ in+ ( arrParams+ , expVars+ , expDecls+ , \ix -> map (\(i,_,_) -> [cexp| $id:(arr i) [ $id:ix ] |] ) expElt+ , \ix -> map (\(i,t,v) -> [cdecl| const $ty:t $id:(show v) = $id:(arr i) [$id:ix] ; |]) expElt+ )+++-- Generate function parameters and corresponding variable names for the+-- components of the given output array.+--+setters+ :: [Type] -- element type+ -> ( [Param] -- function parameter declarations+ , [Exp] -- variable name+ , String -> [Exp] -> [Stm]) -- store a value to the given index+setters arrElt =+ let n = length arrElt+ arrVars = map (\x -> "d_out_a" ++ show x) [n-1, n-2 .. 0]+ arrParams = zipWith (\t x -> [cparam| $ty:(cptr t) $id:x |]) arrElt arrVars+ set ix a x = [cstm| $id:a [$id:ix] = $exp:x; |]+ in+ ( arrParams+ , map cvar arrVars+ , \ix e -> zipWith (set ix) arrVars e+ )+++-- shared memory declaration. All dynamically allocated __shared__ memory will+-- begin at the same base address. If we call this more than once, or the kernel+-- itself declares some shared memory, the first parameter is a pointer to where+-- the new declarations should start from.+--+shared+ :: Int -- shared memory shadowing which input array+ -> Maybe Exp -- (optional) initialise from this base address+ -> Exp -- how much shared memory per type+ -> [Type] -- element types+ -> ( [InitGroup] -- shared memory declaration+ , String -> [Exp] ) -- index shared memory+shared base = shared' ('s':shows base "_a")++shared' :: String -> Maybe Exp -> Exp -> [Type] -> ([InitGroup], String -> [Exp])+shared' base mprev ix elt =+ ( sdecl (head elt) (head vars) : zipWith3 sdata (tail elt) (tail vars) vars+ , \i -> map (\v -> [cexp| $id:v [ $id:i ] |]) vars )+ where+ vars = let k = length elt in map (\n -> base ++ show n) [k-1,k-2..0]+ sdecl t v+ | Just p <- mprev = [cdecl| volatile $ty:(cptr t) $id:v = ( $ty:(cptr t) ) $exp:p; |]+ | otherwise = [cdecl| extern volatile __shared__ $ty:t $id:v []; |]+ sdata t v p = [cdecl| volatile $ty:(cptr t) $id:v = ( $ty:(cptr t) ) & $id:p [ $exp:ix ]; |]+++-- Turn a plain type into a ptr type+--+cptr :: Type -> Type+cptr t | Type d@(DeclSpec _ _ _ _) r@(DeclRoot _) lb <- t = Type d (Ptr [] r noSrcLoc) lb+ | otherwise = t+++-- Mutable operations+-- ------------------++-- Variable assignment+--+(.=.) :: [Exp] -> [Exp] -> [Stm]+(.=.) = zipWith (\v e -> [cstm| $exp:v = $exp:e; |])++locals :: String -> [Type] -> ([Exp], [InitGroup])+locals base elt = unzip (zipWith local elt names)+ where+ suf = let n = length elt in map show [n-1,n-2..0]+ names = map (\n -> base ++ "_a" ++ n) suf+ local t n = ( cvar n, [cdecl| $ty:t $id:n; |] )+
+ Data/Array/Accelerate/CUDA/CodeGen/IndexSpace.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.IndexSpace+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.IndexSpace (++ -- Array construction+ mkGenerate,++ -- Permutations+ mkPermute, mkBackpermute,++ -- Multidimensional index and replicate+ mkSlice, mkReplicate++) where++import Data.List+import Language.C.Syntax+import Language.C.Quote.CUDA+import Foreign.CUDA.Analysis++import Data.Array.Accelerate.Array.Sugar ( Array, Elt )+import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type+++-- Construct a new array by applying a function to each index. Each thread+-- processes multiple elements, striding the array by the grid size.+--+-- generate :: (Shape ix, Elt e)+-- => Exp ix+-- -> (Exp ix -> Exp a)+-- -> Acc (Array ix a)+--+mkGenerate :: forall sh e. Elt e => Int -> CUFun (sh -> e) -> CUTranslSkel+mkGenerate dimOut (CULam _ (CUBody (CUExp env fn))) =+ CUTranslSkel "generate" [cunit|+ $edecl:(cdim "DimOut" dimOut)++ extern "C"+ __global__ void+ generate+ (+ $params:args,+ const typename DimOut shOut+ )+ {+ const int n = size(shOut);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int ix;++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < n+ ; ix += gridSize)+ {+ $decls:shape+ $decls:env+ $stms:(set "ix" fn)+ }+ }+ |]+ where+ (args, _, set) = setters tyOut+ tyOut = eltType (undefined :: e)+ shape = fromIndex dimOut "DimOut" "shOut" "ix" "x0"+++-- Forward permutation specified by an index mapping that determines for each+-- element in the source array where it should go in the target. The resultant+-- array is initialised with the given defaults and any further values that are+-- permuted into the result array are added to the current value using the given+-- combination function.+--+-- The combination function must be associative. Extents that are mapped to the+-- magic value 'ignore' by the permutation function are dropped.+--+-- permute :: (Shape ix, Shape ix', Elt a)+-- => (Exp a -> Exp a -> Exp a) -- combination function+-- -> Acc (Array ix' a) -- array of default values+-- -> (Exp ix -> Exp ix') -- permutation+-- -> Acc (Array ix a) -- permuted array+-- -> Acc (Array ix' a)+--+mkPermute :: forall a ix ix'.+ DeviceProperties+ -> Int -- dimensionality ix'+ -> Int -- dimensionality ix+ -> CUFun (a -> a -> a)+ -> CUFun (ix -> ix')+ -> CUTranslSkel+mkPermute dev dimOut dimIn0 (CULam useFn (CULam _ (CUBody (CUExp env combine)))) (CULam _ (CUBody (CUExp envIx prj))) =+ CUTranslSkel "permute" [cunit|+ $edecl:(cdim "DimOut" dimOut)+ $edecl:(cdim "DimIn0" dimIn0)++ extern "C"+ __global__ void+ permute+ (+ $params:argOut,+ $params:argIn0,+ const typename DimOut shOut,+ const typename DimIn0 shIn0+ )+ {+ const int shapeSize = size(shIn0);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int ix;++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < shapeSize+ ; ix += gridSize)+ {+ typename DimOut dst;+ $decls:src+ $decls:envIx+ $stms:dst++ if (!ignore(dst))+ {+ const int jx = toIndex(shOut, dst);+ $decls:decl1+ $decls:temps+ $decls:env+ $stms:(x1 .=. getIn0 "ix")+ $stms:write+ }+ }+ }+ |]+ where+ elt = eltType (undefined :: a)+ sizeof = eltSizeOf (undefined :: a)+ (argIn0, _, _, getIn0, _) = getters 0 elt useFn+ (_, x1, decl1, _, _) = getters 1 elt useFn+ (argOut, arrOut, setOut) = setters elt+ (x0, _) = locals "x0" elt+ src = fromIndex dimIn0 "DimIn0" "shIn0" "ix" "x0"+ dst = project dimOut "dst" prj+ sm = computeCapability dev+ unsafe = setOut "jx" combine+ (temps, write) = unzip $ zipWith6 apply unsafe combine elt arrOut x0 sizeof+ --+ -- Apply the combining function between old and new values. If multiple+ -- threads attempt to write to the same location, the hardware+ -- write-combining mechanism will accept one transaction and all other+ -- updates will be lost.+ --+ -- If the hardware supports it, we can use atomicCAS (compare-and-swap) to+ -- work around this. This requires at least compute 1.1 for 32-bit values,+ -- and compute 1.2 for 64-bit values. If hardware support is not available,+ -- write the result as normal and hope for the best.+ --+ -- Each element of a tuple is necessarily written individually, so the tuple+ -- as a whole is not stored atomically.+ --+ apply set f t a z s+ | Just atomicCAS <- reinterpret s+ = let z' = [cexp| $id:('_':show z) |]+ in+ ( [cdecl| $ty:t $id:(show z), $id:(show z') = $exp:a [ $id:("jx") ]; |]+ , [cstm| do { $exp:z = $exp:z';+ $exp:z' = $exp:atomicCAS ( & $exp:a [ $id:("jx") ], $exp:z, $exp:f );+ } while ( $exp:z != $exp:z' ); |]+ )++ | otherwise+ = ( [cdecl| const $ty:t $id:(show z) = $exp:a [ $id:("jx") ]; |]+ , set+ )+ --+ reinterpret :: Int -> Maybe Exp+ reinterpret 4 | sm >= 1.1 = Just [cexp| $id:("atomicCAS32") |]+ reinterpret 8 | sm >= 1.2 = Just [cexp| $id:("atomicCAS64") |]+ reinterpret _ = Nothing+++-- Backwards permutation (gather) of an array according to a permutation+-- function.+--+-- backpermute :: (Shape ix, Shape ix', Elt a)+-- => Exp ix' -- shape of the result array+-- -> (Exp ix' -> Exp ix) -- permutation+-- -> Acc (Array ix a) -- permuted array+-- -> Acc (Array ix' a)+--+mkBackpermute :: forall ix ix' a. Elt a+ => Int -- dimensionality ix'+ -> Int -- dimensionality ix+ -> CUFun (ix' -> ix)+ -> Array ix' a -- dummy to fix type variables+ -> CUTranslSkel+mkBackpermute dimOut dimIn0 (CULam _ (CUBody (CUExp env prj))) _ =+ CUTranslSkel "backpermute" [cunit|+ $edecl:(cdim "DimOut" dimOut)+ $edecl:(cdim "DimIn0" dimIn0)++ extern "C"+ __global__ void+ backpermute+ (+ $params:argOut,+ $params:argIn0,+ const typename DimOut shOut,+ const typename DimIn0 shIn0+ )+ {+ const int shapeSize = size(shOut);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int ix;++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < shapeSize+ ; ix += gridSize)+ {+ typename DimIn0 src;+ $decls:dst+ $decls:env+ $stms:src+ {+ const int jx = toIndex(shIn0, src);+ $decls:(getIn0 "jx")+ $stms:(setOut "ix" (reverse x0))+ }+ }+ }+ |]+ where+ elt = eltType (undefined :: a)+ (argOut, _, setOut) = setters elt+ (argIn0, x0, _, _, getIn0) = getters 0 elt (useAll 0 elt)+ dst = fromIndex dimOut "DimOut" "shOut" "ix" "x0"+ src = project dimIn0 "src" prj+++-- Index an array with a generalised, multidimensional array index. The result+-- is a new array (possibly a singleton) containing all dimensions in their+-- entirety.+--+-- slice :: (Slice slix, Elt e)+-- => Acc (Array (FullShape slix) e)+-- -> Exp slix+-- -> Acc (Array (SliceShape slix) e)+--+mkSlice :: forall sl slix e. Elt e+ => Int -- dimensionality sl+ -> Int -- dimensionality co+ -> Int -- dimensionality sh+ -> CUExp slix+ -> Array sl e -- dummy+ -> CUTranslSkel+mkSlice dimSl dimCo dimIn0 (CUExp [] slix) _ =+ CUTranslSkel "slice" [cunit|+ $edecl:(cdim "Slice" dimSl)+ $edecl:(cdim "CoSlice" dimCo)+ $edecl:(cdim "SliceDim" dimIn0)++ extern "C"+ __global__ void+ slice+ (+ $params:argOut,+ $params:argIn0,+ const typename Slice slice,+ const typename CoSlice co,+ const typename SliceDim sliceDim+ )+ {+ int ix;+ const int shapeSize = size(slice);+ const int gridSize = __umul24(blockDim.x, gridDim.x);++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < shapeSize+ ; ix += gridSize)+ {+ typename Slice sl = fromIndex(slice, ix);+ typename SliceDim src;+ $stms:src+ {+ const int jx = toIndex(sliceDim, src);+ $decls:(getIn0 "jx")+ $stms:(setOut "ix" x0)+ }+ }+ }+ |]+ where+ elt = eltType (undefined :: e)+ (argOut, _, setOut) = setters elt+ (argIn0, x0, _, _, getIn0) = getters 0 elt (useAll 0 elt)+ src = project dimIn0 "src" slix+++-- Replicate an array across one or more dimensions as specified by the+-- generalised array index.+--+-- replicate :: (Slice slix, Elt e)+-- => Exp slix+-- -> Acc (Array (SliceShape slix) e)+-- -> Acc (Array (FullShape slix) e)+--+mkReplicate :: forall sh slix e. Elt e+ => Int -- dimensionality sl+ -> Int -- dimensionality sh+ -> CUExp slix+ -> Array sh e -- dummy+ -> CUTranslSkel+mkReplicate dimSl dimOut (CUExp _ slix) _ =+ CUTranslSkel "replicate" [cunit|+ $edecl:(cdim "Slice" dimSl)+ $edecl:(cdim "SliceDim" dimOut)++ extern "C"+ __global__ void+ replicate+ (+ $params:argOut,+ $params:argIn0,+ const typename Slice slice,+ const typename SliceDim sliceDim+ )+ {+ int ix;+ const int shapeSize = size(sliceDim);+ const int gridSize = __umul24(blockDim.x, gridDim.x);++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < shapeSize+ ; ix += gridSize)+ {+ typename SliceDim dim = fromIndex(sliceDim, ix);+ typename Slice src;+ $stms:src+ {+ const int jx = toIndex(slice, src);+ $decls:(getIn0 "jx")+ $stms:(setOut "ix" x0)+ }+ }+ }+ |]+ where+ elt = eltType (undefined :: e)+ (argOut, _, setOut) = setters elt+ (argIn0, x0, _, _, getIn0) = getters 0 elt (useAll 0 elt)+ src = project dimSl "src" slix++++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- destruct shapes into separate components, since the code generator no+-- longer treats tuples as structs+--+fromIndex :: Int -> String -> String -> String -> String -> [InitGroup]+fromIndex n dim sh ix base+ | n == 1 = [[cdecl| const int $id:(base ++ "_a0") = $id:ix; |]]+ | otherwise = sh0 : map (unsh . show) [0 .. n-1]+ where+ sh0 = [cdecl| const typename $id:dim $id:base = fromIndex( $id:sh , $id:ix ); |]+ unsh c = [cdecl| const int $id:(base ++ "_a" ++ c) = $id:base . $id:('a':c); |]+++-- apply expressions to the components of a shape+--+project :: Int -> String -> [Exp] -> [Stm]+project n sh idx+ | [e] <- idx = [[cstm| $id:sh = $exp:e; |]]+ | otherwise = zipWith (\i c -> [cstm| $id:sh . $id:('a':show c) = $exp:i; |]) idx [n-1,n-2..0]+++-- tell the getters function that we will use all the scalar components+--+useAll :: Int -> [Type] -> [(Int, Type, Exp)]+useAll base elt =+ let n = length elt+ x i = 'x' : shows base "_a" ++ show i+ in+ zipWith (\i t -> (i,t, cvar (x i))) [n-1, n-2 .. 0] elt+
+ Data/Array/Accelerate/CUDA/CodeGen/Mapping.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.Mapping+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.Mapping (++ mkMap, mkZipWith++) where++import Language.C.Quote.CUDA+import Data.Array.Accelerate.Array.Sugar ( Elt )+import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type+++-- Apply the given unary function to each element of an array. Each thread+-- processes multiple elements, striding the array by the grid size.+--+-- map :: (Shape sh, Elt a, Elt b)+-- => (Exp a -> Exp b)+-- -> Acc (Array sh a)+-- -> Acc (Array sh b)+--+mkMap :: forall a b. Elt b => CUFun (a -> b) -> CUTranslSkel+mkMap (CULam use0 (CUBody (CUExp env fn))) =+ CUTranslSkel "map" [cunit|+ extern "C"+ __global__ void+ map+ (+ $params:argOut,+ $params:argIn0,+ const typename Ix num_elements+ )+ {+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int ix;++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < num_elements+ ; ix += gridSize)+ {+ $decls:(getIn0 "ix")+ $decls:env+ $stms:(setOut "ix" fn)+ }+ }+ |]+ where+ tyIn0 = eltType (undefined :: a)+ tyOut = eltType (undefined :: b)+ (argIn0, _, _, _, getIn0) = getters 0 tyIn0 use0+ (argOut, _, setOut) = setters tyOut+++-- Apply the given binary function element-wise to the two arrays. The extent of+-- the resulting array is the intersection of the extents of the two source+-- arrays. Each thread processes multiple elements, striding the array by the+-- grid size.+--+-- zipWith :: (Shape ix, Elt a, Elt b, Elt c)+-- => (Exp a -> Exp b -> Exp c)+-- -> Acc (Array ix a)+-- -> Acc (Array ix b)+-- -> Acc (Array ix c)+--+mkZipWith :: forall a b c. Elt c => Int -> CUFun (a -> b -> c) -> CUTranslSkel+mkZipWith dim (CULam use1 (CULam use0 (CUBody (CUExp env fn)))) =+ CUTranslSkel "zipWith" [cunit|+ $edecl:(cdim "DimOut" dim)+ $edecl:(cdim "DimIn0" dim)+ $edecl:(cdim "DimIn1" dim)++ extern "C"+ __global__ void+ zipWith+ (+ $params:argOut,+ $params:argIn1,+ $params:argIn0,+ const typename DimOut shOut,+ const typename DimIn1 shIn1,+ const typename DimIn0 shIn0+ )+ {+ const int shapeSize = size(shOut);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int ix;++ for ( ix = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; ix < shapeSize+ ; ix += gridSize)+ {+ const int ix1 = toIndex(shIn1, fromIndex(shOut, ix));+ const int ix0 = toIndex(shIn0, fromIndex(shOut, ix));+ $decls:(getIn0 "ix0")+ $decls:(getIn1 "ix1")+ $decls:env+ $stms:(setOut "ix" fn)+ }+ }+ |]+ where+ tyIn1 = eltType (undefined :: a)+ tyIn0 = eltType (undefined :: b)+ tyOut = eltType (undefined :: c)+ (argIn1, _, _, _, getIn1) = getters 1 tyIn1 use1+ (argIn0, _, _, _, getIn0) = getters 0 tyIn0 use0+ (argOut, _, setOut) = setters tyOut+
+ Data/Array/Accelerate/CUDA/CodeGen/Monad.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE BangPatterns, TemplateHaskell, QuasiQuotes #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.Monad+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.Monad (++ runCGM, CGM,+ bind, use, weaken, environment, subscripts++) where++import Data.Label ( mkLabels )+import Data.Label.PureM+import Control.Applicative+import Control.Monad.State ( State, evalState )+import Language.C+import Language.C.Quote.CUDA++import Data.IntMap ( IntMap )+import Data.Sequence ( Seq, (|>) )+import qualified Data.IntMap as IM+import qualified Data.Sequence as S+++type CGM = State Gamma+data Gamma = Gamma+ {+ _unique :: {-# UNPACK #-} !Int,+ _variables :: !(Seq (IntMap (Type, Exp))),+ _bindings :: ![InitGroup]+ }+ deriving Show++$(mkLabels [''Gamma])+++runCGM :: CGM a -> a+runCGM = flip evalState (Gamma 0 S.empty [])+++-- Add space for another variable+--+weaken :: CGM ()+weaken = modify variables (|> IM.empty)++-- Add an expression of given type to the environment and return the (new,+-- unique) binding name that can be used in place of the thing just bound.+--+bind :: Type -> Exp -> CGM Exp+bind t e = do+ name <- fresh+ modify bindings ( [cdecl| const $ty:t $id:name = $exp:e;|] : )+ return [cexp|$id:name|]++-- Return the environment (list of initialisation declarations). Since we+-- introduce new bindings to the front of the list, need to reverse so they+-- appear in usage order.+--+environment :: CGM [InitGroup]+environment = reverse `fmap` gets bindings++-- Generate a fresh variable name+--+fresh :: CGM String+fresh = do+ n <- gets unique <* modify unique (+1)+ return $ 'v':show n++-- Mark a variable at a given base and tuple index as being used.+--+use :: Int -> Int -> Type -> Exp -> CGM ()+use base prj ty var = modify variables (S.adjust (IM.insert prj (ty,var)) base)++-- Return the tuple components of a given variable that are actually used+--+subscripts :: Int -> CGM [(Int, Type, Exp)]+subscripts base = map swizzle . IM.toList . flip S.index base <$> gets variables+ where+ swizzle (i, (t,e)) = (i,t,e)+
+ Data/Array/Accelerate/CUDA/CodeGen/PrefixSum.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.PrefixSum+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.PrefixSum (++ -- skeletons+ mkScanl, mkScanr,++ -- closets+ scanBlock++) where++import Language.C.Syntax+import Language.C.Quote.CUDA+import Foreign.CUDA.Analysis+import Data.Maybe++import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type+++data Direction = L | R+ deriving Eq++instance Show Direction where+ show L = "l"+ show R = "r"+++mkScanl, mkScanr :: DeviceProperties -> CUFun (a -> a -> a) -> Maybe (CUExp a) -> CUTranslSkel+mkScanl = mkScan L+mkScanr = mkScan R+++-- [OVERVIEW]+--+-- Data.List-style exclusive scan, with the additional restriction that the+-- first argument needs to be an /associative/ function to enable efficient+-- parallel implementation. The initial value may be arbitrary.+--+-- scanl :: Elt a+-- => (Exp a -> Exp a -> Exp a)+-- -> Exp a+-- -> Acc (Vector a)+-- -> Acc (Vector a)+--+-- > scanl (+) 10 (use xs)+-- > where+-- > xs = fromList (Z:.10) (cycle [1])+-- >+-- > ==> Array (Z:.11) [10,11,12,13,14,15,16,17,18,19,20]+--+-- Data.List-style inclusive scan without an initial value+--+-- scanl1 :: Elt a+-- => (Exp a -> Exp a -> Exp a)+-- -> Acc (Vector a)+-- -> Acc (Vector a)+--+-- > scanl1 (+) (use xs)+-- > where+-- > xs = fromList (Z:.10) (cycle [1])+-- >+-- > ==> Array (Z:.10) [1,2,3,4,5,6,7,8,9,10]+--+-- Variant of 'scanl' where the final result is returned separately.+--+-- scanl' :: Elt a+-- => (Exp a -> Exp a -> Exp a)+-- -> Exp a+-- -> Acc (Vector a)+-- -> (Acc (Vector a), Acc (Scalar a))+--+-- Denotationally, we have:+--+-- > scanl' f z xs = (init res, last res)+-- > where+-- > res = scanl f z xs+--+--+-- [IMPLEMENTATION]+--+-- This code handles all the above cases, in both left and right-handed+-- variants. This is the _downsweep_ phase to a multi-block scan procedure.+-- We require a work distribution such that there is a _single_ thread block for+-- each interval. For multi-block scans, we have an array of interval sums that+-- are used to determine the carry-in value from the previous interval. Note+-- that 'argBlk' will not be accessed by a single-block scan, so may be null.+--+-- We require some pointer manipulation from the calling code in order to+-- support all types of scans:+--+-- * scanl : argSum should point to the last position of argOut+-- * scanr : argSum should be the start of argOut, argOut should be incremented by one+-- * scanl1, scanr1 : no change (argSum is required, even though it will not be used Haskell-side)+-- * scanl', scanr' : no change+--+mkScan :: forall a.+ Direction+ -> DeviceProperties+ -> CUFun (a -> a -> a)+ -> Maybe (CUExp a)+ -> CUTranslSkel+mkScan dir dev (CULam _ (CULam use0 (CUBody (CUExp env combine)))) mseed =+ CUTranslSkel name [cunit|+ extern "C"+ __global__ void+ $id:name+ (+ $params:argOut,+ $params:argSum,+ $params:argIn0,+ $params:argBlk,+ typename Ix interval_size,+ const typename Ix num_elements+ )+ {+ $decls:smem+ $decls:decl0+ $decls:decl1+ $decls:decl2++ /*+ * Read in previous result partial sum. We store the carry value in x0+ * and read new values from the input array into x1, since 'scanBlock'+ * will store its results into x1 on completion.+ */+ int carry_in = 0;++ if ( threadIdx.x == 0 ) {+ $stm:(initialise mseed)+ }++ const int start = blockIdx.x * interval_size;+ const int end = min(start + interval_size, num_elements);+ interval_size = end - start;++ for (int i = threadIdx.x; i < interval_size; i += blockDim.x)+ {+ const int j = $id:(if left then "start + i" else "end - i - 1");+ $stms:(x1 .=. getIn0 "j")++ if ( $exp:carry_in ) {+ $decls:env+ $stms:(x0 .=. x2)+ $stms:(x1 .=. combine)+ }++ /*+ * Store our input into shared memory and cooperatively scan+ */+ $stms:(sdata "threadIdx.x" .=. x1)+ __syncthreads();++ $stms:(scanBlock dev elt Nothing (cvar "blockDim.x") sdata env combine)++ if ( $exp:(cbool exclusive) ) {+ if ( threadIdx.x == 0 ) {+ $stms:(x1 .=. x2)+ } else {+ $stms:(x1 .=. sdata "threadIdx.x - 1")+ }+ }+ $stms:(setOut "j" x1)++ /*+ * Carry the final result from this block through x0. If this is the+ * last section of the interval, this is the value to write out as+ * the final (reduction) result.+ */+ if ( threadIdx.x == 0 ) {+ const int last = min(interval_size - i, blockDim.x) - 1;+ $stms:(x2 .=. sdata "last")+ }+ $id:( if not exclusive then "carry_in = 1" else [] ) ;+ }++ /*+ * for exclusive scans, set the overall scan result and reapply the+ * initial element at the boundaries of each interval+ */+ if ( $exp:(cbool exclusive) && threadIdx.x == 0 && blockIdx.x == $id:lastBlock ) {+ $stms:(setSum .=. x2)+ }+ }+ |]+ where+ name = "scan" ++ show dir ++ maybe "1" (const "") mseed+ elt = eltType (undefined :: a)+ (argIn0, x0, decl0, getIn0, _) = getters 0 elt use0+ (argOut, _, setOut) = setters elt+ setSum = totalSum "0"+ (argSum, totalSum) = arrays "d_sum" elt+ (argBlk, blkSum) = arrays "d_blk" elt+ (x1, decl1) = locals "x1" elt+ (x2, decl2) = locals "x2" elt+ (smem, sdata) = shared 0 Nothing [cexp| blockDim.x |] elt+ --+ carry_in+ | exclusive = [cexp| threadIdx.x == 0 |]+ | otherwise = [cexp| threadIdx.x == 0 && carry_in |]+ exclusive = isJust mseed+ left = dir == L+ firstBlock = if left then "0" else "gridDim.x - 1"+ lastBlock = if not left then "0" else "gridDim.x - 1"+ --+ initialise Nothing = [cstm|+ if ( blockIdx.x != $id:firstBlock ) {+ $stms:(x2 .=. blkSum (if left then "blockIdx.x - 1" else "blockIdx.x + 1"))+ carry_in = 1;+ }+ |]+ initialise (Just (CUExp env' seed)) = [cstm|+ if ( gridDim.x > 1 ) {+ $stms:(x2 .=. blkSum "blockIdx.x")+ } else {+ $decls:env'+ $stms:(x2 .=. seed)+ }+ |]+++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- Introduce some new array arguments and a way to index them+--+arrays :: String -> [Type] -> ([Param], String -> [Exp])+arrays base elt =+ ( zipWith (\t a -> [cparam| $ty:(cptr t) $id:a |]) elt arrs+ , \ix -> map (\a -> [cexp| $id:a [$id:ix] |]) arrs+ )+ where+ n = length elt+ arrs = map (\x -> base ++ "_a" ++ show x) [n-1, n-2 .. 0]+++-- Scan a block of results in shared memory. We hijack the standard local+-- variables (x0 and x1) for the combination function. This thread must have+-- already stored its initial value into shared memory. The final result for+-- this thread will be stored in x1 as well as the appropriate place in shared+-- memory.+--+scanBlock :: DeviceProperties+ -> [Type] -- element type+ -> Maybe Exp -- partially-full block bounds check?+ -> Exp -- CTA size+ -> (String -> [Exp]) -- index shared memory area+ -> [InitGroup] -- local environment for the..+ -> [Exp] -- ..binary function+ -> [Stm]+scanBlock dev elt mlim cta sdata env combine = map (scan . pow2) [0 .. maxThreads]+ where+ maxThreads = floor (logBase 2 (fromIntegral $ maxThreadsPerBlock dev :: Double)) :: Int+ (x0, _) = locals "x0" elt+ (x1, _) = locals "x1" elt+ pow2 x = (2::Int) ^ x+ scan n =+ let inrange = maybe [cexp| threadIdx.x >= $int:n|]+ (\m -> [cexp| threadIdx.x >= $int:n && threadIdx.x < $exp:m |]) mlim+ ix = "threadIdx.x - " ++ show n+ in+ [cstm|+ if ( $exp:cta > $int:n ) {+ if ( $exp:inrange ) {+ $stms:(x0 .=. sdata ix)+ $decls:env+ $stms:(x1 .=. combine)+ }+ __syncthreads();+ $stms:(sdata "threadIdx.x" .=. x1)+ __syncthreads();+ }+ |]++
+ Data/Array/Accelerate/CUDA/CodeGen/Reduction.hs view
@@ -0,0 +1,542 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.Reduction+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.Reduction (++ -- skeletons+ mkFold, mkFoldAll, mkFoldSeg,++ -- closets+ reduceWarp, reduceBlock++) where++import Language.C.Syntax+import Language.C.Quote.CUDA+import Foreign.CUDA.Analysis++import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type+++-- Reduction of an array of arbitrary rank to a single scalar value. The first+-- argument needs to be an associative function to enable an efficient parallel+-- implementation+--+-- foldAll :: (Shape sh, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Exp a+-- -> Acc (Array sh a)+-- -> Acc (Scalar a)+--+-- fold1All :: (Shape sh, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Acc (Array sh a)+-- -> Acc (Scalar a)+--+-- Each thread computes multiple elements sequentially. This reduces the overall+-- cost of the algorithm while keeping the work complexity O(n) and the step+-- complexity O(log n). c.f. Brent's Theorem optimisation.+--+mkFoldAll :: forall a.+ DeviceProperties+ -> CUFun (a -> a -> a)+ -> Maybe (CUExp a) -> CUTranslSkel+mkFoldAll dev (CULam _ (CULam use0 (CUBody (CUExp env combine)))) mseed =+ CUTranslSkel name [cunit|+ extern "C"+ __global__ void+ $id:name+ (+ $params:argOut,+ $params:argIn0,+ const typename Ix num_elements+ )+ {+ const int gridSize = blockDim.x * gridDim.x;+ int i = blockIdx.x * blockDim.x + threadIdx.x;+ $decls:smem+ $decls:decl0+ $decls:decl1++ /*+ * Reduce multiple elements per thread. The number is determined by the+ * number of active thread blocks (via gridDim). More blocks will result in+ * a larger `gridSize', and hence fewer elements per thread+ *+ * The loop stride of `gridSize' is used to maintain coalescing.+ */+ if (i < num_elements)+ {+ $stms:(x1 .=. getIn0 "i")++ for (i += gridSize; i < num_elements; i += gridSize)+ {+ $decls:env+ $stms:(x0 .=. getIn0 "i")+ $stms:(x1 .=. combine)+ }+ }++ /*+ * Each thread puts its local sum into shared memory, then threads+ * cooperatively reduce the shared array to a single value.+ */+ $stms:(sdata "threadIdx.x" .=. x1)+ __syncthreads();++ i = min(((int) num_elements) - blockIdx.x * blockDim.x, blockDim.x);+ $stms:(reduceBlock dev elt "i" sdata env combine)++ /*+ * Write the results of this block back to global memory. If we are the last+ * phase of a recursive multi-block reduction, include the seed element.+ */+ if (threadIdx.x == 0)+ {+ $stms:(maybe inclusive_finish exclusive_finish mseed)+ }+ }+ |]+ where+ name = maybe "fold1All" (const "foldAll") mseed+ elt = eltType (undefined :: a)+ (argIn0, x0, decl0, getIn0, _) = getters 0 elt use0+ (argOut, _, setOut) = setters elt+ (x1, decl1) = locals "x1" elt+ (smem, sdata) = shared 0 Nothing [cexp| blockDim.x |] elt+ --+ inclusive_finish = setOut "blockIdx.x" x1+ exclusive_finish (CUExp env' seed) = [[cstm|+ if (num_elements > 0) {+ if (gridDim.x == 1) {+ $decls:env'+ $stms:(x0 .=. seed)+ $stms:(x1 .=. combine)+ }+ $stms:(setOut "blockIdx.x" x1)+ }+ else {+ $decls:env'+ $stms:(setOut "blockIdx.x" seed)+ }+ |]]+++-- Reduction of the innermost dimension of an array of arbitrary rank. The first+-- argument needs to be an associative function to enable an efficient parallel+-- implementation+--+-- fold :: (Shape ix, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Exp a+-- -> Acc (Array (ix :. Int) a)+-- -> Acc (Array ix a)+--+-- fold1 :: (Shape ix, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Acc (Array (ix :. Int) a)+-- -> Acc (Array ix a)+--+mkFold :: forall a.+ DeviceProperties+ -> CUFun (a -> a -> a)+ -> Maybe (CUExp a)+ -> CUTranslSkel+mkFold dev (CULam _ (CULam use0 (CUBody (CUExp env combine)))) mseed =+ CUTranslSkel name [cunit|+ extern "C"+ __global__ void+ $id:name+ (+ $params:argOut,+ $params:argIn0,+ const typename Ix interval_size, // indexHead(shIn0)+ const typename Ix num_intervals, // size(shOut)+ const typename Ix num_elements // size(shIn0)+ )+ {+ $decls:smem+ $decls:decl1+ $decls:decl0+ $decls:env++ /*+ * If the intervals of an exclusive fold are empty, use all threads to+ * map the seed value to the output array and exit.+ */+ $stms:(maybe [] (return . mapseed) mseed)++ /*+ * Threads in a block cooperatively reduce all elements in an interval.+ */+ for (int seg = blockIdx.x; seg < num_intervals; seg += gridDim.x)+ {+ const int start = seg * interval_size;+ const int end = min(start + interval_size, num_elements);+ const int n = min(end - start, blockDim.x);++ /*+ * Kill threads that will not participate in this segment to avoid+ * invalid global reads.+ */+ if (threadIdx.x >= n)+ return;++ /*+ * Ensure aligned access to global memory, and that each thread+ * initialises its local sum+ */+ int i = start - (start & (warpSize - 1));++ if (i == start || interval_size > blockDim.x)+ {+ i += threadIdx.x;++ if (i >= start)+ {+ $stms:(x1 .=. getIn0 "i")+ }++ if (i + blockDim.x < end)+ {+ $decls:(getTmp "i + blockDim.x")++ if (i >= start) {+ $decls:env+ $stms:(x1 .=. combine)+ }+ else {+ $stms:(x1 .=. x0)+ }+ }++ /*+ * Now, iterate collecting a local sum+ */+ for (i += 2 * blockDim.x; i < end; i += blockDim.x)+ {+ $decls:env+ $stms:(x0 .=. getIn0 "i")+ $stms:(x1 .=. combine)+ }+ }+ else+ {+ $stms:(x1 .=. getIn0 "start + threadIdx.x")+ }++ /*+ * Each thread puts its local sum into shared memory, and+ * cooperatively reduces this to a single value.+ */+ $stms:(sdata "threadIdx.x" .=. x1)+ __syncthreads();++ $stms:(reduceBlock dev elt "n" sdata env combine)++ /*+ * Finally, the first thread writes the result for this segment. For+ * exclusive reductions, we also combine with the seed element here.+ */+ if (threadIdx.x == 0)+ {+ $decls:final_decls+ $stms:final_stms+ $stms:(setOut "seg" x1)+ }+ }+ }+ |]+ where+ name = maybe "fold1" (const "fold") mseed+ elt = eltType (undefined :: a)+ (argIn0, x0, decl0, getIn0, getTmp) = getters 0 elt use0+ (argOut, _, setOut) = setters elt+ (x1, decl1) = locals "x1" elt+ (smem, sdata) = shared 0 Nothing [cexp| blockDim.x |] elt+ --+ (final_decls, final_stms) =+ case mseed of+ Nothing -> ([], [])+ Just (CUExp env' seed) -> (env', concat [x0 .=. seed, x1 .=. combine])+ --+ mapseed (CUExp env' seed) = [cstm|+ if (interval_size == 0)+ {+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int seg;++ for ( seg = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; seg < num_intervals+ ; seg += gridSize )+ {+ $decls:env'+ $stms:(setOut "seg" seed)+ }+ return;+ }|]+++-- Segmented reduction along the innermost dimension of an array. Performs one+-- individual reduction per segment of the source array. These reductions+-- proceed in parallel.+--+-- foldSeg :: (Shape ix, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Exp a+-- -> Acc (Array (ix :. Int) a)+-- -> Acc Segments+-- -> Acc (Array (ix :. Int) a)+--+-- fold1Seg :: (Shape ix, Elt a)+-- => (Exp a -> Exp a -> Exp a)+-- -> Acc (Array (ix :. Int) a)+-- -> Acc Segments+-- -> Acc (Array (ix :. Int) a)+--+-- Each segment of the vector is assigned to a warp, which computes the+-- reduction of the i-th section, in parallel. Care is taken to ensure that data+-- array access is aligned to a warp boundary.+--+-- Since an entire 32-thread warp is assigned for each segment, many threads+-- will remain idle when the segments are very small. This code relies on+-- implicit synchronisation among threads in a warp.+--+-- The offset array contains the starting index for each segment in the input+-- array. The i-th warp reduces values in the input array at indices+-- [d_offset[i], d_offset[i+1]).+--+mkFoldSeg :: forall a.+ DeviceProperties+ -> Int+ -> Type -- of the segments array+ -> CUFun (a -> a -> a)+ -> Maybe (CUExp a)+ -> CUTranslSkel+mkFoldSeg dev dim tySeg (CULam _ (CULam use0 (CUBody (CUExp env combine)))) mseed =+ CUTranslSkel name [cunit|+ $edecl:(cdim "DimOut" dim)+ $edecl:(cdim "DimIn0" dim)++ extern "C"+ __global__ void+ $id:name+ (+ $params:argOut,+ $params:argIn0,+ const $ty:(cptr tySeg) d_offset,+ const typename DimOut shOut,+ const typename DimIn0 shIn0+ )+ {+ const int vectors_per_block = blockDim.x / warpSize;+ const int num_vectors = vectors_per_block * gridDim.x;+ const int thread_id = blockDim.x * blockIdx.x + threadIdx.x;+ const int vector_id = thread_id / warpSize;+ const int thread_lane = threadIdx.x & (warpSize - 1);+ const int vector_lane = threadIdx.x / warpSize;++ const int num_segments = indexHead(shOut);+ const int total_segments = size(shOut);++ extern volatile __shared__ int s_ptrs[][2];++ $decls:smem+ $decls:decl1+ $decls:decl0++ for (int seg = vector_id; seg < total_segments; seg += num_vectors)+ {+ const int s = seg % num_segments;+ const int base = (seg / num_segments) * indexHead(shIn0);++ /*+ * Use two threads to fetch the indices of the start and end of this+ * segment. This results in single coalesced global read, instead of two+ * separate transactions.+ */+ if (thread_lane < 2)+ s_ptrs[vector_lane][thread_lane] = (int) d_offset[s + thread_lane];++ const int start = base + s_ptrs[vector_lane][0];+ const int end = base + s_ptrs[vector_lane][1];+ const int num_elements = end - start;++ /*+ * Each thread reads in values of this segment, accumulating a local sum+ */+ if (num_elements > warpSize)+ {+ /*+ * Ensure aligned access to global memory+ */+ int i = start - (start & (warpSize - 1)) + thread_lane;+ if (i >= start)+ {+ $stms:(x1 .=. getIn0 "i")+ }++ /*+ * Subsequent reads to global memory are aligned, but make sure all+ * threads have initialised their local sum.+ */+ if (i + warpSize < end)+ {+ $decls:(getTmp "i + warpSize")++ if (i >= start) {+ $decls:env+ $stms:(x1 .=. combine)+ }+ else {+ $stms:(x1 .=. x0)+ }+ }++ /*+ * Now, iterate along the inner-most dimension collecting a local sum+ */+ for (i += 2 * warpSize; i < end; i += warpSize)+ {+ $decls:env+ $stms:(x0 .=. getIn0 "i")+ $stms:(x1 .=. combine)+ }+ }+ else if (start + thread_lane < end)+ {+ $stms:(x1 .=. getIn0 "start + thread_lane")+ }++ /*+ * Store local sums into shared memory and reduce to a single value+ */+ const int n = min(num_elements, warpSize);+ $stms:(sdata "threadIdx.x" .=. x1)+ $stms:(tail $ reduceWarp dev elt "n" "thread_lane" sdata env combine)++ /*+ * Finally, the first thread writes the result for this segment+ */+ if (thread_lane == 0)+ {+ $stms:(maybe inclusive_finish exclusive_finish mseed)+ }+ }+ }+ |]+ where+ name = maybe "fold1Seg" (const "foldSeg") mseed+ elt = eltType (undefined :: a)+ (argIn0, x0, decl0, getIn0, getTmp) = getters 0 elt use0+ (argOut, _, setOut) = setters elt+ (x1, decl1) = locals "x1" elt+ (smem, sdata) = shared 0 (Just $ [cexp| &s_ptrs[vectors_per_block][2] |]) [cexp| blockDim.x |] elt+ --+ inclusive_finish = setOut "seg" x1+ exclusive_finish (CUExp env' seed) = [cstm|+ if (num_elements > 0) {+ $decls:env'+ $stms:(x0 .=. seed)+ $stms:(x1 .=. combine)+ } else {+ $decls:env'+ $stms:(x1 .=. seed)+ }|] :+ setOut "seg" x1++++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++-- Threads of a warp run in lockstep, so there is no need to synchronise. We+-- hijack the standard local variable sets (x0 and x1) for the combination+-- function. The initial values must already be stored in shared memory. The+-- final result is stored in x1.+--+reduceWarp :: DeviceProperties+ -> [Type]+ -> String -- number of elements+ -> String -- thread identifier: usually the lane or thread id+ -> (String -> [Exp]) -- index shared memory+ -> [InitGroup] -- local binding environment for the..+ -> [Exp] -- ..binary associative combination function+ -> [Stm]+reduceWarp dev elt n tid sdata env combine = map (reduce . pow2) [v,v-1..0]+ where+ v = floor (logBase 2 (fromIntegral $ warpSize dev :: Double)) :: Int+ pow2 x = (2::Int) ^ x+ (x0, _) = locals "x0" elt+ (x1, _) = locals "x1" elt+ --+ reduce i+ | i > 1+ = [cstm| if ( $id:tid + $int:i < $id:n ) {+ $decls:env+ $stms:(x0 .=. sdata ("threadIdx.x + " ++ show i))+ $stms:(x1 .=. combine)+ $stms:(sdata "threadIdx.x" .=. x1)+ }+ |]+ --+ | otherwise+ = [cstm| if ( $id:tid + $int:i < $id:n ) {+ $decls:env+ $stms:(x0 .=. sdata "threadIdx.x + 1")+ $stms:(x1 .=. combine)+ }+ |]+++-- All threads cooperatively reduce this block's data in shared memory. We+-- hijack the standard local variables (x0 and x1) for the combination function.+-- The initial values must already be stored in shared memory.+--+reduceBlock :: DeviceProperties+ -> [Type]+ -> String -- number of elements+ -> (String -> [Exp]) -- index shared memory+ -> [InitGroup] -- local binding environment for the..+ -> [Exp] -- ..binary associative function+ -> [Stm]+reduceBlock dev elt n sdata env combine = map (reduce . pow2) [u-1,u-2..v]+ where+ u = floor (logBase 2 (fromIntegral $ maxThreadsPerBlock dev :: Double)) :: Int+ v = floor (logBase 2 (fromIntegral $ warpSize dev :: Double)) :: Int+ pow2 x = (2::Int) ^ x+ (x0, _) = locals "x0" elt+ (x1, _) = locals "x1" elt+ --+ reduce i+ | i > warpSize dev+ = [cstm| if ( $id:n > $int:i ) {+ if ( threadIdx.x + $int:i < $id:n ) {+ $decls:env+ $stms:(x0 .=. sdata ("threadIdx.x + " ++ show i))+ $stms:(x1 .=. combine)+ $stms:(sdata "threadIdx.x" .=. x1)+ }+ __syncthreads();+ }+ |]+ --+ | otherwise+ = [cstm| if ( threadIdx.x < $int:(warpSize dev) ) {+ $stms:(reduceWarp dev elt n "threadIdx.x" sdata env combine)+ }+ |]+
+ Data/Array/Accelerate/CUDA/CodeGen/Stencil.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -fno-warn-incomplete-patterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen.Mapping+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.CodeGen.Stencil (++ mkStencil, mkStencil2++) where++import Language.C.Syntax+import Language.C.Quote.CUDA++import Data.Array.Accelerate.Type+import Data.Array.Accelerate.AST ( OpenAcc, Fun, Stencil )+import Data.Array.Accelerate.Array.Sugar ( Array, Elt, shapeToList )+import Data.Array.Accelerate.CUDA.CodeGen.Base+import Data.Array.Accelerate.CUDA.CodeGen.Type++import qualified Data.Array.Accelerate.Analysis.Stencil as Stencil+import qualified Data.Array.IArray as IArray+++-- Map a stencil over an array. In contrast to 'map', the domain of a stencil+-- function is an entire /neighbourhood/ of each array element. Neighbourhoods+-- are sub-arrays centred around a focal point. They are not necessarily+-- rectangular, but they are symmetric in each dimension and have an extent of+-- at least three in each dimensions — due to the symmetry requirement, the+-- extent is necessarily odd. The focal point is the array position that is+-- determined by the stencil.+--+-- For those array positions where the neighbourhood extends past the boundaries+-- of the source array, a boundary condition determines the contents of the+-- out-of-bounds neighbourhood positions.+--+-- stencil :: (Shape ix, Elt a, Elt b, Stencil ix a stencil)+-- => (stencil -> Exp b) -- stencil function+-- -> Boundary a -- boundary condition+-- -> Acc (Array ix a) -- source array+-- -> Acc (Array ix b) -- destination array+--+-- To improve performance, the input array(s) are read through the texture+-- cache.+--+mkStencil :: forall sh stencil a b. (Stencil sh a stencil, Elt b)+ => Int+ -> CUFun (stencil -> b)+ -> Boundary (CUExp a)+ -> Array sh b {- dummy -}+ -> CUTranslSkel+mkStencil dim (CULam use0 (CUBody (CUExp env stencil))) boundary _ =+ CUTranslSkel "stencil" [cunit|+ $edecl:(cdim "Shape" dim)+ $edecls:arrIn0++ extern "C"+ __global__ void+ stencil+ (+ $params:argOut,+ const typename Shape shIn0+ )+ {+ const int shapeSize = size(shIn0);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int i;++ for ( i = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; i < shapeSize+ ; i += gridSize )+ {+ const typename Shape ix = fromIndex(shIn0, i);+ $decls:(getIn0 "ix")+ $decls:env+ $stms:(setOut "i" stencil)+ }+ }+ |]+ where+ tyOut = eltType (undefined :: b)+ stencilIn0 = eltTypeTex (undefined :: a)+ (argOut, _, setOut) = setters tyOut+ (arrIn0, getIn0) = stencilAccess 0 dim stencilIn0 use0 boundary offsets+ --+ offsets = map shapeToList p0+ p0 = Stencil.offsets (undefined :: Fun aenv (stencil -> b))+ (undefined :: OpenAcc aenv (Array sh a))+++-- Map a binary stencil of an array. The extent of the resulting array is the+-- intersection of the extents of the two source arrays.+--+-- stencil2 :: (Shape ix, Elt a, Elt b, Elt c,+-- Stencil ix a stencil1,+-- Stencil ix b stencil2)+-- => (stencil1 -> stencil2 -> Exp c) -- binary stencil function+-- -> Boundary a -- boundary condition #1+-- -> Acc (Array ix a) -- source array #1+-- -> Boundary b -- boundary condition #2+-- -> Acc (Array ix b) -- source array #2+-- -> Acc (Array ix c) -- destination array+--+mkStencil2 :: forall sh stencil1 stencil0 a b c.+ (Stencil sh a stencil1, Stencil sh b stencil0, Elt c)+ => Int+ -> CUFun (stencil1 -> stencil0 -> c)+ -> Boundary (CUExp a)+ -> Boundary (CUExp b)+ -> Array sh c {- dummy -}+ -> CUTranslSkel+mkStencil2 dim (CULam use1 (CULam use0 (CUBody (CUExp env stencil)))) boundary1 boundary0 _ =+ CUTranslSkel "stencil2" [cunit|+ $edecl:(cdim "Shape" dim)+ $edecls:arrIn0+ $edecls:arrIn1++ extern "C"+ __global__ void+ stencil2+ (+ $params:argOut,+ const typename Shape shOut,+ const typename Shape shIn1,+ const typename Shape shIn0+ )+ {+ const int shapeSize = size(shOut);+ const int gridSize = __umul24(blockDim.x, gridDim.x);+ int i;++ for ( i = __umul24(blockDim.x, blockIdx.x) + threadIdx.x+ ; i < shapeSize+ ; i += gridSize )+ {+ const typename Shape ix = fromIndex(shOut, i);+ $decls:(getIn0 "ix")+ $decls:(getIn1 "ix")+ $decls:env+ $stms:(setOut "i" stencil)+ }+ }+ |]+ where+ tyOut = eltType (undefined :: c)+ stencilIn0 = eltTypeTex (undefined :: b)+ stencilIn1 = eltTypeTex (undefined :: a)+ (argOut, _, setOut) = setters tyOut+ (arrIn0, getIn0) = stencilAccess 0 dim stencilIn0 use0 boundary0 offsets0+ (arrIn1, getIn1) = stencilAccess 1 dim stencilIn1 use1 boundary1 offsets1+ --+ offsets0 = map shapeToList p0+ offsets1 = map shapeToList p1+ (p1, p0) = Stencil.offsets2 (undefined :: Fun aenv (stencil1 -> stencil0 -> c))+ (undefined :: OpenAcc aenv (Array sh a))+ (undefined :: OpenAcc aenv (Array sh b))+++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++stencilAccess+ :: Int -- array de Bruijn index+ -> Int -- array dimensionality+ -> [Type] -- array type (texture memory)+ -> [(Int, Type, Exp)] -- the variables used in the scalar expression+ -> Boundary (CUExp a) -- how to handle boundary array access+ -> [[Int]] -- all stencil index offsets, top left to bottom right+ -> ( [Definition] -- texture-reference definitions+ , String -> [InitGroup] ) -- array indexing+stencilAccess base dim stencil subs boundary shx =+ ( textures+ , \ix -> concatMap (get ix) subs )+ where+ n = length stencil+ sh = "shIn" ++ show base+ arr x = "stencil" ++ shows base "_a" ++ show (x `mod` n)+ textures = zipWith cglobal stencil (map arr [n-1, n-2 .. 0])+ --+ offsets :: IArray.Array Int [Int]+ offsets = IArray.listArray (0, length shx-1) shx+ --+ get ix (i,t,v) = case boundary of+ Clamp -> bounded "clamp"+ Mirror -> bounded "mirror"+ Wrap -> bounded "wrap"+ Constant (CUExp _ c) -> inRange c+ where+ j = 'j':shows base "_a" ++ show i+ k = 'k':shows base "_a" ++ show i+ --+ bounded f+ = [cdecl| const int $id:j = $exp:ix'; |]+ : [cdecl| const $ty:t $id:(show v) = $exp:(indexArray t (cvar (arr i)) (cvar j)); |]+ : []+ where+ ix' = case offsets IArray.! div i n of+ ks | all (== 0) ks -> [cexp| toIndex( $id:sh, ix ) |]+ | otherwise -> [cexp| toIndex( $id:sh, $exp:(ccall f [cvar sh, cursor ks]) ) |]+ --+ inRange c = case offsets IArray.! div i n of+ ks | all (== 0) ks -> let f = indexArray t (cvar (arr i)) (ccall "toIndex" [cvar sh, cvar "ix"])+ in [[cdecl| const $ty:t $id:(show v) = $exp:f; |]]+ | otherwise -> [cdecl| const typename Shape $id:j = $exp:(cursor ks); |]+ : [cdecl| const typename bool $id:k = inRange( $id:sh, $id:j ); |]+ : [cdecl| const $ty:t $id:(show v) = $id:k ? $exp:(indexArray t (cvar (arr i)) (ccall "toIndex" [cvar sh, cvar j]))+ : $exp:(reverse c !! mod i n); |]+ : []+ --+ cursor [c] = [cexp| $id:ix + $int:c |]+ cursor cs = ccall "shape" $ zipWith (\a c -> [cexp| $id:ix . $id:('a':show a) + $int:c |]) [dim-1,dim-2..0] cs+
+ Data/Array/Accelerate/CUDA/CodeGen/Type.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE QuasiQuotes #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.CodeGen+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Generate types for the reified elements of an array computation+--++module Data.Array.Accelerate.CUDA.CodeGen.Type (++ -- surface types+ accType, accTypeTex, segmentsType, expType,+ eltType, eltTypeTex, eltSizeOf,++ -- primitive bits...+ codegenIntegralType, codegenScalarType++) where++-- friends+import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Type+import Data.Array.Accelerate.CUDA.CodeGen.Base+import qualified Data.Array.Accelerate.Array.Sugar as Sugar+import qualified Data.Array.Accelerate.Analysis.Type as Sugar++-- libraries+import Language.C.Quote.CUDA+import qualified Language.C as C+import qualified Foreign.Storable as F+++#include "accelerate.h"+++-- Surface element types+-- ---------------------++accType :: OpenAcc aenv (Sugar.Array dim e) -> [C.Type]+accType = codegenTupleType . Sugar.accType++expType :: OpenExp aenv env t -> [C.Type]+expType = codegenTupleType . Sugar.expType++segmentsType :: OpenAcc aenv (Sugar.Segments i) -> C.Type+segmentsType seg+ | [s] <- accType seg = s+ | otherwise = INTERNAL_ERROR(error) "accType" "non-scalar segment type"+++--sizeOfAccTypes :: OpenAcc aenv (Sugar.Array dim e) -> [Int]+--sizeOfAccTypes = sizeOf' . Sugar.accType+-- where+-- sizeOf' :: TupleType a -> [Int]+-- sizeOf' UnitTuple = []+-- sizeOf' x@(SingleTuple _) = [Sugar.sizeOf x]+-- sizeOf' (PairTuple a b) = sizeOf' a ++ sizeOf' b++eltType :: Sugar.Elt a => a {- dummy -} -> [C.Type]+eltType = codegenTupleType . Sugar.eltType++eltTypeTex :: Sugar.Elt a => a {- dummy -} -> [C.Type]+eltTypeTex = codegenTupleTex . Sugar.eltType++eltSizeOf :: Sugar.Elt a => a {- dummy -} -> [Int]+eltSizeOf = sizeOf' . Sugar.eltType+ where+ sizeOf' :: TupleType a -> [Int]+ sizeOf' UnitTuple = []+ sizeOf' x@(SingleTuple _) = [Sugar.sizeOf x]+ sizeOf' (PairTuple a b) = sizeOf' a ++ sizeOf' b+++-- Implementation+--+codegenTupleType :: TupleType a -> [C.Type]+codegenTupleType UnitTuple = []+codegenTupleType (SingleTuple ty) = [codegenScalarType ty]+codegenTupleType (PairTuple t1 t0) = codegenTupleType t1 ++ codegenTupleType t0++codegenScalarType :: ScalarType a -> C.Type+codegenScalarType (NumScalarType ty) = codegenNumType ty+codegenScalarType (NonNumScalarType ty) = codegenNonNumType ty++codegenNumType :: NumType a -> C.Type+codegenNumType (IntegralNumType ty) = codegenIntegralType ty+codegenNumType (FloatingNumType ty) = codegenFloatingType ty++codegenIntegralType :: IntegralType a -> C.Type+codegenIntegralType (TypeInt8 _) = typename "int8_t"+codegenIntegralType (TypeInt16 _) = typename "int16_t"+codegenIntegralType (TypeInt32 _) = typename "int32_t"+codegenIntegralType (TypeInt64 _) = typename "int64_t"+codegenIntegralType (TypeWord8 _) = typename "uint8_t"+codegenIntegralType (TypeWord16 _) = typename "uint16_t"+codegenIntegralType (TypeWord32 _) = typename "uint32_t"+codegenIntegralType (TypeWord64 _) = typename "uint64_t"+codegenIntegralType (TypeCShort _) = [cty|short|]+codegenIntegralType (TypeCUShort _) = [cty|unsigned short|]+codegenIntegralType (TypeCInt _) = [cty|int|]+codegenIntegralType (TypeCUInt _) = [cty|unsigned int|]+codegenIntegralType (TypeCLong _) = [cty|long int|]+codegenIntegralType (TypeCULong _) = [cty|unsigned long int|]+codegenIntegralType (TypeCLLong _) = [cty|long long int|]+codegenIntegralType (TypeCULLong _) = [cty|unsigned long long int|]++codegenIntegralType (TypeInt _) =+ case F.sizeOf (undefined::Int) of+ 4 -> typename "int32_t"+ 8 -> typename "int64_t"+ _ -> error "we can never get here"++codegenIntegralType (TypeWord _) =+ case F.sizeOf (undefined::Int) of+ 4 -> typename "uint32_t"+ 8 -> typename "uint64_t"+ _ -> error "we can never get here"+++codegenFloatingType :: FloatingType a -> C.Type+codegenFloatingType (TypeFloat _) = [cty|float|]+codegenFloatingType (TypeCFloat _) = [cty|float|]+codegenFloatingType (TypeDouble _) = [cty|double|]+codegenFloatingType (TypeCDouble _) = [cty|double|]++codegenNonNumType :: NonNumType a -> C.Type+codegenNonNumType (TypeBool _) = error "codegenNonNum :: Bool"+codegenNonNumType (TypeChar _) = error "codegenNonNum :: Char"+codegenNonNumType (TypeCChar _) = [cty|char|]+codegenNonNumType (TypeCSChar _) = [cty|signed char|]+codegenNonNumType (TypeCUChar _) = [cty|unsigned char|]+++-- Texture types+-- -------------++accTypeTex :: OpenAcc aenv (Sugar.Array dim e) -> [C.Type]+accTypeTex = codegenTupleTex . Sugar.accType+++-- Implementation+--+codegenTupleTex :: TupleType a -> [C.Type]+codegenTupleTex UnitTuple = []+codegenTupleTex (SingleTuple t) = [codegenScalarTex t]+codegenTupleTex (PairTuple t1 t0) = codegenTupleTex t1 ++ codegenTupleTex t0++codegenScalarTex :: ScalarType a -> C.Type+codegenScalarTex (NumScalarType ty) = codegenNumTex ty+codegenScalarTex (NonNumScalarType ty) = codegenNonNumTex ty;++codegenNumTex :: NumType a -> C.Type+codegenNumTex (IntegralNumType ty) = codegenIntegralTex ty+codegenNumTex (FloatingNumType ty) = codegenFloatingTex ty++codegenIntegralTex :: IntegralType a -> C.Type+codegenIntegralTex (TypeInt8 _) = typename "TexInt8"+codegenIntegralTex (TypeInt16 _) = typename "TexInt16"+codegenIntegralTex (TypeInt32 _) = typename "TexInt32"+codegenIntegralTex (TypeInt64 _) = typename "TexInt64"+codegenIntegralTex (TypeWord8 _) = typename "TexWord8"+codegenIntegralTex (TypeWord16 _) = typename "TexWord16"+codegenIntegralTex (TypeWord32 _) = typename "TexWord32"+codegenIntegralTex (TypeWord64 _) = typename "TexWord64"+codegenIntegralTex (TypeCShort _) = typename "TexCShort"+codegenIntegralTex (TypeCUShort _) = typename "TexCUShort"+codegenIntegralTex (TypeCInt _) = typename "TexCInt"+codegenIntegralTex (TypeCUInt _) = typename "TexCUInt"+codegenIntegralTex (TypeCLong _) = typename "TexCLong"+codegenIntegralTex (TypeCULong _) = typename "TexCULong"+codegenIntegralTex (TypeCLLong _) = typename "TexCLLong"+codegenIntegralTex (TypeCULLong _) = typename "TexCULLong"++codegenIntegralTex (TypeInt _) =+ case F.sizeOf (undefined::Int) of+ 4 -> typename "TexInt32"+ 8 -> typename "TexInt64"+ _ -> error "we can never get here"++codegenIntegralTex (TypeWord _) =+ case F.sizeOf (undefined::Word) of+ 4 -> typename "TexWord32"+ 8 -> typename "TexWord64"+ _ -> error "we can never get here"+++codegenFloatingTex :: FloatingType a -> C.Type+codegenFloatingTex (TypeFloat _) = typename "TexFloat"+codegenFloatingTex (TypeCFloat _) = typename "TexCFloat"+codegenFloatingTex (TypeDouble _) = typename "TexDouble"+codegenFloatingTex (TypeCDouble _) = typename "TexCDouble"+++-- TLM 2010-06-29:+-- Bool and Char can be implemented once the array types in+-- Data.Array.Accelerate.[CUDA.]Array.Data are made concrete.+--+codegenNonNumTex :: NonNumType a -> C.Type+codegenNonNumTex (TypeBool _) = error "codegenNonNumTex :: Bool"+codegenNonNumTex (TypeChar _) = error "codegenNonNumTex :: Char"+codegenNonNumTex (TypeCChar _) = typename "TexCChar"+codegenNonNumTex (TypeCSChar _) = typename "TexCSChar"+codegenNonNumTex (TypeCUChar _) = typename "TexCUChar"+
+ Data/Array/Accelerate/CUDA/Compile.hs view
@@ -0,0 +1,448 @@+{-# LANGUAGE CPP, GADTs, TupleSections, ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Compile+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Compile (++ -- * generate and compile kernels to realise a computation+ compileAcc, compileAfun1++) where++#include "accelerate.h"++-- friends+import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Tuple++import Data.Array.Accelerate.CUDA.AST+import Data.Array.Accelerate.CUDA.FullList as FL+import Data.Array.Accelerate.CUDA.State+import Data.Array.Accelerate.CUDA.CodeGen+import Data.Array.Accelerate.CUDA.Array.Sugar+import Data.Array.Accelerate.CUDA.Analysis.Launch+import qualified Data.Array.Accelerate.CUDA.Debug as D++-- libraries+import Numeric+import Prelude hiding ( exp, catch )+import Control.Applicative hiding ( Const )+import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Control.Exception+import Control.Monad+import Control.Monad.Trans+import Crypto.Hash.MD5 ( hashlazy )+import Data.Label.PureM+import Data.List+import Data.Maybe+import Data.Monoid+import Foreign.Storable+import System.Directory+import System.Exit ( ExitCode(..) )+import System.FilePath+import System.IO+import System.IO.Unsafe+import System.Process+import Text.PrettyPrint.Mainland ( RDoc(..), ppr, renderCompact )+import Data.ByteString.Internal ( w2c )+import qualified Data.HashSet as Set+import qualified Data.HashTable.IO as HT+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Foreign.CUDA.Driver as CUDA+import qualified Foreign.CUDA.Analysis as CUDA++#ifdef VERSION_unix+import System.Posix.Process+#else+import System.Win32.Process+#endif++import Paths_accelerate_cuda ( getDataDir )+++-- | Initiate code generation, compilation, and data transfer for an array+-- expression. The returned array computation is annotated so to be suitable for+-- execution in the CUDA environment. This includes:+--+-- * list of array variables embedded within scalar expressions+-- * kernel object(s) required to executed the kernel+--+compileAcc :: Acc a -> CIO (ExecAcc a)+compileAcc acc = prepareAcc acc+++compileAfun1 :: Afun (a -> b) -> CIO (ExecAfun (a -> b))+compileAfun1 (Alam (Abody b)) = Alam . Abody <$> prepareAcc b+compileAfun1 _ =+ error "Hope (noun): something that happens to facts when the world refuses to agree"+++prepareAcc :: OpenAcc aenv a -> CIO (ExecOpenAcc aenv a)+prepareAcc rootAcc = traverseAcc rootAcc+ where+ -- Traverse an open array expression in depth-first order+ --+ -- The applicative combinators are used to gloss over that we are passing+ -- around the AST nodes together with a set of free variable indices that+ -- are merged at every step.+ --+ traverseAcc :: forall aenv a. OpenAcc aenv a -> CIO (ExecOpenAcc aenv a)+ traverseAcc acc@(OpenAcc pacc) = do++ let exec :: (AccBindings aenv, PreOpenAcc ExecOpenAcc aenv a) -> CIO (ExecOpenAcc aenv a)+ exec (var, eacc) = do+ kernel <- build acc var+ return $ ExecAcc (FL.singleton () kernel) var eacc++ node :: (AccBindings aenv, PreOpenAcc ExecOpenAcc aenv a) -> CIO (ExecOpenAcc aenv a)+ node (_, eacc) = return $ ExecAcc noKernel mempty eacc++ case pacc of+ --+ -- Environment manipulations+ --+ Avar ix -> node $ pure (Avar ix)++ --+ -- Let bindings+ --+ Alet a b -> node . pure =<< Alet <$> traverseAcc a <*> traverseAcc b+ Apply f a -> node . pure =<< Apply <$> compileAfun1 f <*> traverseAcc a+ Acond p t e -> node =<< liftA3 Acond <$> travE p <*> travA t <*> travA e++ --+ -- Tuples+ --+ Atuple tup -> node =<< liftA Atuple <$> travAtup tup+ Aprj ix tup -> node =<< liftA (Aprj ix) <$> travA tup++ --+ -- Array injection+ --+ Use arrs -> use (arrays (undefined::a)) arrs >> node (pure $ Use arrs)+ where+ use :: ArraysR a' -> a' -> CIO ()+ use ArraysRunit () = return ()+ use ArraysRarray arr = useArray arr+ use (ArraysRpair r1 r2) (a1, a2) = use r1 a1 >> use r2 a2++ --+ -- Computation nodes+ --+ Reshape s a -> node =<< liftA2 Reshape <$> travE s <*> travA a+ Unit e -> node =<< liftA Unit <$> travE e+ Generate e f -> exec =<< liftA2 Generate <$> travE e <*> travF f+ Replicate slix e a -> exec =<< liftA2 (Replicate slix) <$> travE e <*> travA a+ Index slix a e -> exec =<< liftA2 (Index slix) <$> travA a <*> travE e+ Map f a -> exec =<< liftA2 Map <$> travF f <*> travA a+ ZipWith f a b -> exec =<< liftA3 ZipWith <$> travF f <*> travA a <*> travA b+ Fold f z a -> exec =<< liftA3 Fold <$> travF f <*> travE z <*> travA a+ Fold1 f a -> exec =<< liftA2 Fold1 <$> travF f <*> travA a+ FoldSeg f e a s -> exec =<< liftA4 FoldSeg <$> travF f <*> travE e <*> travA a <*> travA (segments s)+ Fold1Seg f a s -> exec =<< liftA3 Fold1Seg <$> travF f <*> travA a <*> travA (segments s)+ Permute f a g b -> exec =<< liftA4 Permute <$> travF f <*> travA a <*> travF g <*> travA b+ Backpermute e f a -> exec =<< liftA3 Backpermute <$> travE e <*> travF f <*> travA a+ Stencil f b a -> exec =<< liftA2 (flip Stencil b) <$> travF f <*> travA a+ Stencil2 f b1 a1 b2 a2 -> exec =<< liftA3 stencil2 <$> travF f <*> travA a1 <*> travA a2+ where stencil2 f' a1' a2' = Stencil2 f' b1 a1' b2 a2'++ -- TODO: write helper functions to clean these up+ Scanl f e a -> do+ ExecAcc (FL _ scan _) var eacc <- exec =<< liftA3 Scanl <$> travF f <*> travE e <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () add $ FL.singleton () scan) var eacc++ Scanl' f e a -> do+ ExecAcc (FL _ scan _) var eacc <- exec =<< liftA3 Scanl' <$> travF f <*> travE e <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () (retag add) $ FL.singleton () scan) var eacc++ Scanl1 f a -> do+ ExecAcc (FL _ scan1 _) var eacc <- exec =<< liftA2 Scanl1 <$> travF f <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () add $ FL.singleton () scan1) var eacc++ Scanr f e a -> do+ ExecAcc (FL _ scan _) var eacc <- exec =<< liftA3 Scanr <$> travF f <*> travE e <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () add $ FL.singleton () scan) var eacc++ Scanr' f e a -> do+ ExecAcc (FL _ scan _) var eacc <- exec =<< liftA3 Scanr' <$> travF f <*> travE e <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () (retag add) $ FL.singleton () scan) var eacc++ Scanr1 f a -> do+ ExecAcc (FL _ scan1 _) var eacc <- exec =<< liftA2 Scanr1 <$> travF f <*> travA a+ add <- build (OpenAcc (Fold1 f mat)) var+ return $ ExecAcc (cons () add $ FL.singleton () scan1) var eacc++ where+ travA :: OpenAcc aenv' a' -> CIO (AccBindings aenv', ExecOpenAcc aenv' a')+ travA a = pure <$> traverseAcc a++ travAtup :: Atuple (OpenAcc aenv') a' -> CIO (AccBindings aenv', Atuple (ExecOpenAcc aenv') a')+ travAtup NilAtup = return (pure NilAtup)+ travAtup (SnocAtup t a) = liftA2 SnocAtup <$> travAtup t <*> travA a++ travF :: OpenFun env aenv t -> CIO (AccBindings aenv, PreOpenFun ExecOpenAcc env aenv t)+ travF (Body b) = liftA Body <$> travE b+ travF (Lam f) = liftA Lam <$> travF f++ segments :: forall i. (Elt i, IsIntegral i)+ => OpenAcc aenv (Segments i) -> OpenAcc aenv (Segments i)+ segments = OpenAcc . Scanl plus (Const (fromElt (0::i)))++ plus :: (Elt i, IsIntegral i) => PreOpenFun OpenAcc () aenv (i -> i -> i)+ plus = Lam (Lam (Body (PrimAdd numType+ `PrimApp`+ Tuple (NilTup `SnocTup` Var (SuccIdx ZeroIdx)+ `SnocTup` Var ZeroIdx))))++ mat :: Elt e => OpenAcc aenv (Array DIM2 e)+ mat = OpenAcc $ Use ((), Array (((),0),0) undefined)++ noKernel :: FullList () (AccKernel a)+ noKernel = FL () (INTERNAL_ERROR(error) "compile" "no kernel module for this node") Nil++ -- Traverse a scalar expression+ --+ travE :: OpenExp env aenv e+ -> CIO (AccBindings aenv, PreOpenExp ExecOpenAcc env aenv e)+ travE exp =+ case exp of+ Var ix -> return $ pure (Var ix)+ Const c -> return $ pure (Const c)+ PrimConst c -> return $ pure (PrimConst c)+ IndexAny -> return $ pure IndexAny+ IndexNil -> return $ pure IndexNil+ --+ Let a b -> liftA2 Let <$> travE a <*> travE b+ IndexCons t h -> liftA2 IndexCons <$> travE t <*> travE h+ IndexHead h -> liftA IndexHead <$> travE h+ IndexTail t -> liftA IndexTail <$> travE t+ Tuple t -> liftA Tuple <$> travT t+ Prj ix e -> liftA (Prj ix) <$> travE e+ Cond p t e -> liftA3 Cond <$> travE p <*> travE t <*> travE e+ PrimApp f e -> liftA (PrimApp f) <$> travE e+ IndexScalar a e -> liftA2 IndexScalar <$> travA a <*> travE e+ Shape a -> liftA Shape <$> travA a+ ShapeSize e -> liftA ShapeSize <$> travE e+ where+ travA :: (Shape sh, Elt e)+ => OpenAcc aenv (Array sh e) -> CIO (AccBindings aenv, ExecOpenAcc aenv (Array sh e))+ travA a = do+ a' <- traverseAcc a+ return $ (bind a', a')++ travT :: Tuple (OpenExp env aenv) t+ -> CIO (AccBindings aenv, Tuple (PreOpenExp ExecOpenAcc env aenv) t)+ travT NilTup = return (pure NilTup)+ travT (SnocTup t e) = liftA2 SnocTup <$> travT t <*> travE e++ bind :: (Shape sh, Elt e) => ExecOpenAcc aenv (Array sh e) -> AccBindings aenv+ bind (ExecAcc _ _ (Avar ix)) = AccBindings ( Set.singleton (ArrayVar ix) )+ bind _ = INTERNAL_ERROR(error) "bind" "expected array variable"+++-- Applicative+-- -----------+--+liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e+liftA4 f a b c d = f <$> a <*> b <*> c <*> d+++-- Compilation+-- -----------++-- Generate, compile, and link code to evaluate an array computation. We use+-- 'unsafePerformIO' here to leverage laziness, so that the 'link' function+-- evaluates and blocks on the external compiler only once the compiled object+-- is truly needed.+--+build :: OpenAcc aenv a -> AccBindings aenv -> CIO (AccKernel a)+build acc fvar = do+ dev <- gets deviceProps+ table <- gets kernelTable+ (entry,key) <- compile table dev acc fvar+ let (mdl,fun,occ) = unsafePerformIO $ do+ m <- link table key+ f <- CUDA.getFun m entry+ l <- CUDA.requires f CUDA.MaxKernelThreadsPerBlock+ o <- determineOccupancy acc dev f l+ D.when D.dump_cc (stats entry f o)+ return (m,f,o)+ --+ return $ Kernel entry mdl fun occ (launchConfig acc dev occ)+ where+ stats name fn occ = do+ regs <- CUDA.requires fn CUDA.NumRegs+ smem <- CUDA.requires fn CUDA.SharedSizeBytes+ cmem <- CUDA.requires fn CUDA.ConstSizeBytes+ lmem <- CUDA.requires fn CUDA.LocalSizeBytes+ let msg1 = "entry function '" ++ name ++ "' used "+ ++ shows regs " registers, " ++ shows smem " bytes smem, "+ ++ shows lmem " bytes lmem, " ++ shows cmem " bytes cmem"+ msg2 = "multiprocessor occupancy " ++ showFFloat (Just 1) (CUDA.occupancy100 occ) "% : "+ ++ shows (CUDA.activeThreads occ) " threads over "+ ++ shows (CUDA.activeWarps occ) " warps in "+ ++ shows (CUDA.activeThreadBlocks occ) " blocks"+ --+ -- make sure kernel/stats are printed together+ --+ message $ intercalate "\n" [msg1, "cc: " ++ msg2]+++-- Link a compiled binary and update the associated kernel entry in the hash+-- table. This may entail waiting for the external compilation process to+-- complete. If successfully, the temporary files are removed.+--+link :: KernelTable -> KernelKey -> IO CUDA.Module+link table key =+ let intErr = INTERNAL_ERROR(error) "link" "missing kernel entry"+ in do+ ctx <- CUDA.get+ (KernelEntry cufile stat) <- fromMaybe intErr `fmap` HT.lookup table key+ case stat of+ Right (KernelObject bin active)+ | Just mdl <- FL.lookup ctx active -> return mdl+ | otherwise -> do+ message "re-linking module for current context"+ mdl <- CUDA.loadData bin+ let obj = KernelObject bin (FL.cons ctx mdl active)+ HT.insert table key (KernelEntry cufile (Right obj))+ return mdl+ --+ Left pid -> do+ -- wait for compiler to finish and load binary object+ --+ message "waiting for nvcc..."+ waitFor pid+ bin <- B.readFile (replaceExtension cufile ".cubin")+ mdl <- CUDA.loadData bin+ let obj = KernelObject bin (FL.singleton ctx mdl)++#ifndef ACCELERATE_CUDA_PERSISTENT_CACHE+ -- remove build products+ --+ removeFile cufile+ removeFile (replaceExtension cufile ".cubin")+ removeDirectory (dropFileName cufile)+ `catch` \(_ :: IOError) -> return () -- directory not empty+#endif++ -- update hash table+ --+ HT.insert table key (KernelEntry cufile (Right obj))+ return mdl+++-- Generate and compile code for a single open array expression+--+compile :: KernelTable+ -> CUDA.DeviceProperties+ -> OpenAcc aenv a+ -> AccBindings aenv+ -> CIO (String, KernelKey)+compile table dev acc fvar = do+ exists <- isJust `fmap` liftIO (HT.lookup table key)+ unless exists $ do+ message $ unlines [ show key, map w2c (L.unpack code) ]+ nvcc <- fromMaybe (error "nvcc: command not found") <$> liftIO (findExecutable "nvcc")+ (file,hdl) <- openOutputFile "dragon.cu" -- rawr!+ flags <- compileFlags file+ (_,_,_,pid) <- liftIO $ do+ L.hPut hdl code `finally` hClose hdl+ createProcess (proc nvcc flags) `onException` removeFile file+ --+ liftIO $ HT.insert table key (KernelEntry file (Left pid))+ --+ return (entry, key)+ where+ cunit = codegenAcc dev acc fvar+ entry = show cunit+ key = (CUDA.computeCapability dev, hashlazy code)+ code = toLazyByteString+ . layout . renderCompact $ ppr cunit+ --+ layout (RText _ s next) = fromString s `mappend` layout next+ layout (RChar c next) = fromChar c `mappend` layout next+ layout (RLine _ next) = fromChar '\n' `mappend` layout next -- no indenting+ layout (RPos _ next) = layout next -- no line markers+ layout REmpty = mempty -- done+++-- Wait for the compilation process to finish+--+waitFor :: ProcessHandle -> IO ()+waitFor pid = do+ status <- waitForProcess pid+ case status of+ ExitSuccess -> return ()+ ExitFailure c -> error $ "nvcc terminated abnormally (" ++ show c ++ ")"+++-- Determine the appropriate command line flags to pass to the compiler process.+-- This is dependent on the host architecture and device capabilities.+--+compileFlags :: FilePath -> CIO [String]+compileFlags cufile = do+ arch <- CUDA.computeCapability `fmap` gets deviceProps+ ddir <- liftIO getDataDir+ return $ filter (not . null) $+ [ "-I", ddir </> "cubits"+ , "--compiler-options", "-fno-strict-aliasing"+ , "-arch=sm_" ++ show (round (arch * 10) :: Int)+ , "-cubin"+ , "-o", cufile `replaceExtension` "cubin"+ , if D.mode D.verbose then "" else "--disable-warnings"+ , if D.mode D.debug then "-G" else "-O3"+ , machine+ , cufile ]+ where+ wordSize = sizeOf (undefined::Int)+ machine | wordSize == 4 = "-m32"+ | wordSize == 8 = "-m64"+ | otherwise = error "recreational scolding?"+++-- Open a unique file in the temporary directory used for compilation+-- by-products. The directory will be created if it does not exist.+--+openOutputFile :: String -> CIO (FilePath, Handle)+openOutputFile template = liftIO $ do+#ifdef ACCELERATE_CUDA_PERSISTENT_CACHE+ dir <- (</>) <$> getDataDir <*> pure "cache"+#else+ pid <- getProcessID+ dir <- (</>) <$> getTemporaryDirectory <*> pure ("accelerate-cuda-" ++ show pid)+#endif+ createDirectoryIfMissing True dir+ openTempFile dir template++#ifndef VERSION_unix+getProcessID :: ProcessHandle -> IO ProcessId+getProcessID = getProcessId+#endif++-- Debug+-- -----++{-# INLINE message #-}+message :: MonadIO m => String -> m ()+message msg = trace ("cc: " ++ msg) $ return ()++{-# INLINE trace #-}+trace :: MonadIO m => String -> m a -> m a+trace msg next = D.message D.dump_cc msg >> next+
+ Data/Array/Accelerate/CUDA/Debug.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE CPP, TemplateHaskell, TypeOperators #-}+{-# OPTIONS -fno-warn-unused-imports #-}+{-# OPTIONS -fno-warn-unused-binds #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Debug+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--+-- Hijack some command line arguments to pass runtime debugging options. This+-- might cause problems for users of the library...+--++module Data.Array.Accelerate.CUDA.Debug (++ showFFloatSIBase,++ message, event, when, mode,+ verbose, debug,+ dump_gc, dump_cc, dump_exec,++) where++import Numeric+import Data.List+import Data.Label+import Data.IORef+import Control.Monad.IO.Class+import System.IO.Unsafe+import System.Environment+import System.Console.GetOpt++#if MIN_VERSION_base(4,5,0)+import Debug.Trace ( traceIO, traceEventIO )+#else+import Debug.Trace ( putTraceMsg )++traceIO :: String -> IO ()+traceIO = putTraceMsg++traceEventIO :: String -> IO ()+traceEventIO = traceIO+#endif+++-- -----------------------------------------------------------------------------+-- Pretty-printing++showFFloatSIBase :: RealFloat a => Maybe Int -> a -> a -> ShowS+showFFloatSIBase p b n+ = showString+ . nubBy (\x y -> x == ' ' && y == ' ')+ $ showFFloat p n' [ ' ', si_unit ]+ where+ n' = n / (b ^^ (pow-4))+ pow = max 0 . min 8 . (+) 4 . floor $ logBase b n+ si_unit = "pnµm kMGT" !! pow+++-- -----------------------------------------------------------------------------+-- Internals++data Flags = Flags+ {+ -- phase control+ _dump_gc :: !Bool -- garbage collection & memory management+ , _dump_cc :: !Bool -- compilation & linking+ , _dump_exec :: !Bool -- kernel execution++ -- general options+ , _verbose :: !Bool -- additional status messages+ , _debug :: !Bool -- generate device code suitable for debugging+ }++$(mkLabels [''Flags])++flags :: [OptDescr (Flags -> Flags)]+flags =+ [ Option [] ["ddump-gc"] (NoArg (set dump_gc True)) "print device memory management trace"+ , Option [] ["ddump-cc"] (NoArg (set dump_cc True)) "print generated code and compilation information"+ , Option [] ["ddump-exec"] (NoArg (set dump_exec True)) "print kernel execution trace"+ , Option [] ["dverbose"] (NoArg (set verbose True)) "print additional information"+ , Option [] ["ddebug"] (NoArg (set debug True)) "generate debug information for device code"+ ]++initialise :: IO Flags+initialise = parse `fmap` getArgs+ where+ defaults = Flags False False False False False+ parse = foldl parse1 defaults+ parse1 opts x = case filter (\(Option _ [f] _ _) -> x `isPrefixOf` ('-':f)) flags of+ [Option _ _ (NoArg go) _] -> go opts+ _ -> opts -- not specified, or ambiguous++#ifdef ACCELERATE_DEBUG+{-# NOINLINE options #-}+options :: IORef Flags+options = unsafePerformIO $ newIORef =<< initialise+#endif++{-# INLINE mode #-}+mode :: (Flags :-> Bool) -> Bool+#ifdef ACCELERATE_DEBUG+mode f = unsafePerformIO $ get f `fmap` readIORef options+#else+mode _ = False+#endif++{-# INLINE message #-}+message :: MonadIO m => (Flags :-> Bool) -> String -> m ()+#ifdef ACCELERATE_DEBUG+message f str = when f (liftIO $ traceIO str)+#else+message _ _ = return ()+#endif++{-# INLINE event #-}+event :: MonadIO m => (Flags :-> Bool) -> String -> m ()+#ifdef ACCELERATE_DEBUG+event f str = when f (liftIO $ traceEventIO str)+#else+event _ _ = return ()+#endif++{-# INLINE when #-}+when :: MonadIO m => (Flags :-> Bool) -> m () -> m ()+#ifdef ACCELERATE_DEBUG+when f action+ | mode f = action+ | otherwise = return ()+#else+when _ _ = return ()+#endif+
+ Data/Array/Accelerate/CUDA/Execute.hs view
@@ -0,0 +1,937 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, IncoherentInstances #-}+{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, FlexibleInstances #-}+{-# LANGUAGE RankNTypes, TupleSections, TypeOperators, TypeSynonymInstances #-}+{-# OPTIONS -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.Execute+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--++module Data.Array.Accelerate.CUDA.Execute (++ -- * Execute a computation under a CUDA environment+ executeAcc, executeAfun1++) where+++-- friends+import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Representation hiding (Shape, sliceIndex)+import qualified Data.Array.Accelerate.Interpreter as I+import qualified Data.Array.Accelerate.Array.Data as AD+import qualified Data.Array.Accelerate.Array.Representation as R++import Data.Array.Accelerate.CUDA.AST+import Data.Array.Accelerate.CUDA.State+import Data.Array.Accelerate.CUDA.FullList ( FullList(..), List(..) )+import Data.Array.Accelerate.CUDA.Array.Data+import Data.Array.Accelerate.CUDA.Array.Sugar hiding+ (dim, size, index, shapeToList, sliceIndex)+import qualified Data.Array.Accelerate.CUDA.Array.Sugar as Sugar+import qualified Data.Array.Accelerate.CUDA.Debug as D ( message, dump_exec )+++-- libraries+import Prelude hiding ( sum, exp )+import Control.Applicative hiding ( Const )+import Control.Monad+import Control.Monad.Trans+import System.IO.Unsafe+import qualified Data.HashSet as Set++import Foreign ( Ptr, Storable )+import qualified Foreign as F+import qualified Foreign.CUDA.Driver as CUDA++#include "accelerate.h"+++-- Array expression evaluation+-- ---------------------------++-- Computations are evaluated by traversing the AST bottom-up, and for each node+-- distinguishing between three cases:+--+-- 1. If it is a Use node, return a reference to the device memory holding the+-- array data+--+-- 2. If it is a non-skeleton node, such as a let-binding or shape conversion,+-- this is executed directly by updating the environment or similar+--+-- 3. If it is a skeleton node, the associated binary object is retrieved,+-- memory allocated for the result, and the kernel(s) that implement the+-- skeleton are invoked+--++-- Evaluate a closed array expression+--+executeAcc :: Arrays a => ExecAcc a -> CIO a+executeAcc acc = executeOpenAcc acc Empty++-- Evaluate an expression with free array variables+--+executeAfun1 :: forall a b. (Arrays a, Arrays b) => ExecAfun (a -> b) -> a -> CIO b+executeAfun1 (Alam (Abody f)) arrs = do+ applyArraysR useArray (arrays (undefined::a)) (fromArr arrs)+ executeOpenAcc f (Empty `Push` arrs)++executeAfun1 _ _ =+ error "the sword comes out after you swallow it, right?"+++-- Evaluate an open array expression+--+executeOpenAcc :: ExecOpenAcc aenv a -> Val aenv -> CIO a+executeOpenAcc (ExecAcc kernelList@(FL _ kernel _) bindings acc) aenv =+ case acc of+ --+ -- (1) Array introduction+ --+ Use arr -> return (toArr arr)++ --+ -- (2) Environment manipulation+ --+ Avar ix -> return (prj ix aenv)++ Alet a b -> do+ a0 <- executeOpenAcc a aenv+ executeOpenAcc b (aenv `Push` a0)++ Atuple tup -> toTuple <$> executeAtuple tup aenv++ Aprj ix tup -> do+ arrs <- executeOpenAcc tup aenv+ return $! executeAprj ix (fromTuple arrs)++ Apply (Alam (Abody f)) a -> do+ a0 <- executeOpenAcc a aenv+ executeOpenAcc f (Empty `Push` a0)+ Apply _ _ -> error "Awww... the sky is crying"++ Acond p t e -> do+ cond <- executeExp p aenv+ if cond then executeOpenAcc t aenv+ else executeOpenAcc e aenv++ Reshape e a -> do+ ix <- executeExp e aenv+ a0 <- executeOpenAcc a aenv+ reshapeOp ix a0++ Unit e ->+ unitOp =<< executeExp e aenv++ --+ -- (3) Array computations+ --+ Generate e _ ->+ generateOp kernel bindings aenv =<< executeExp e aenv++ Replicate sliceIndex e a -> do+ slix <- executeExp e aenv+ a0 <- executeOpenAcc a aenv+ replicateOp kernel bindings aenv sliceIndex slix a0++ Index sliceIndex a e -> do+ slix <- executeExp e aenv+ a0 <- executeOpenAcc a aenv+ indexOp kernel bindings aenv sliceIndex a0 slix++ Map _ a -> do+ a0 <- executeOpenAcc a aenv+ mapOp kernel bindings aenv a0++ ZipWith _ a b -> do+ a1 <- executeOpenAcc a aenv+ a0 <- executeOpenAcc b aenv+ zipWithOp kernel bindings aenv a1 a0++ Fold _ _ a -> do+ a0 <- executeOpenAcc a aenv+ foldOp kernel bindings aenv a0++ Fold1 _ a -> do+ a0 <- executeOpenAcc a aenv+ fold1Op kernel bindings aenv a0++ FoldSeg _ _ a s -> do+ a0 <- executeOpenAcc a aenv+ s0 <- executeOpenAcc s aenv+ foldSegOp kernel bindings aenv a0 s0++ Fold1Seg _ a s -> do+ a0 <- executeOpenAcc a aenv+ s0 <- executeOpenAcc s aenv+ fold1SegOp kernel bindings aenv a0 s0++ Scanl _ _ a -> do+ a0 <- executeOpenAcc a aenv+ scanOp L kernelList bindings aenv a0++ Scanl' _ _ a -> do+ a0 <- executeOpenAcc a aenv+ scan'Op kernelList bindings aenv a0++ Scanl1 _ a -> do+ a0 <- executeOpenAcc a aenv+ scan1Op kernelList bindings aenv a0++ Scanr _ _ a -> do+ a0 <- executeOpenAcc a aenv+ scanOp R kernelList bindings aenv a0++ Scanr' _ _ a -> do+ a0 <- executeOpenAcc a aenv+ scan'Op kernelList bindings aenv a0++ Scanr1 _ a -> do+ a0 <- executeOpenAcc a aenv+ scan1Op kernelList bindings aenv a0++ Permute _ a _ b -> do+ a0 <- executeOpenAcc a aenv+ a1 <- executeOpenAcc b aenv+ permuteOp kernel bindings aenv a0 a1++ Backpermute e _ a -> do+ sh <- executeExp e aenv+ a0 <- executeOpenAcc a aenv+ backpermuteOp kernel bindings aenv sh a0++ Stencil _ _ a -> do+ a0 <- executeOpenAcc a aenv+ stencilOp kernel bindings aenv a0++ Stencil2 _ _ a _ b -> do+ a1 <- executeOpenAcc a aenv+ a0 <- executeOpenAcc b aenv+ stencil2Op kernel bindings aenv a1 a0++-- Tuples evaluation+--+executeAtuple :: Atuple (ExecOpenAcc aenv) t -> Val aenv -> CIO t+executeAtuple NilAtup _ = return ()+executeAtuple (SnocAtup t a) aenv = (,) <$> executeAtuple t aenv+ <*> executeOpenAcc a aenv++executeAprj :: TupleIdx arrs a -> arrs -> a+executeAprj ZeroTupIdx (_, a) = a+executeAprj (SuccTupIdx ix) (t, _) = executeAprj ix t+++-- Implementation of primitive array operations+-- --------------------------------------------++reshapeOp+ :: Shape dim+ => dim+ -> Array dim' e+ -> CIO (Array dim e)+reshapeOp newShape (Array oldShape adata)+ = BOUNDS_CHECK(check) "reshape" "shape mismatch" (Sugar.size newShape == size oldShape)+ $ return $ Array (fromElt newShape) adata+++unitOp+ :: Elt e+ => e+ -> CIO (Scalar e)+unitOp v = newArray Z (const v)+++generateOp+ :: (Shape dim, Elt e)+ => AccKernel (Array dim e)+ -> AccBindings aenv+ -> Val aenv+ -> dim+ -> CIO (Array dim e)+generateOp kernel bindings aenv sh = do+ res@(Array _ out) <- allocateArray sh+ execute kernel bindings aenv (Sugar.size sh)+ (((), out)+ , sh)+ return res+++replicateOp+ :: forall aenv e dim sl co slix. (Shape dim, Elt slix)+ => AccKernel (Array dim e)+ -> AccBindings aenv+ -> Val aenv+ -> SliceIndex (EltRepr slix) (EltRepr sl) co (EltRepr dim)+ -> slix+ -> Array sl e+ -> CIO (Array dim e)+replicateOp kernel bindings aenv sliceIndex slix (Array sh0 in0) = do+ let sh = toElt $ extend sliceIndex (fromElt slix) sh0+ sl = toElt sh0 :: sl+ res@(Array _ out) <- allocateArray sh+ execute kernel bindings aenv (Sugar.size sh)+ (((((), out)+ , in0)+ , sl)+ , sh)+ return res+ where+ extend :: SliceIndex slix' sl' co' dim' -> slix' -> sl' -> dim'+ extend (SliceNil) () () = ()+ extend (SliceAll sliceIdx) (slx,()) (sl,sz) = (extend sliceIdx slx sl, sz)+ extend (SliceFixed sliceIdx) (slx,sz) sl = (extend sliceIdx slx sl, sz)+++indexOp+ :: forall sl co slix aenv dim e. (Shape sl, Elt slix)+ => AccKernel (Array sl e)+ -> AccBindings aenv+ -> Val aenv+ -> SliceIndex (EltRepr slix) (EltRepr sl) co (EltRepr dim)+ -> Array dim e+ -> slix+ -> CIO (Array sl e)+indexOp kernel bindings aenv sliceIndex (Array sh0 in0) slix = do+ let sz = toElt sh0 :: dim+ sh = toElt $ restrict sliceIndex (fromElt slix) sh0 :: sl+ sl = Sugar.listToShape $ convertSlix sliceIndex (fromElt slix) :: sl+ res@(Array _ out) <- allocateArray sh+ execute kernel bindings aenv (Sugar.size sh)+ ((((((), out)+ , in0)+ , sh)+ , sl)+ , sz)+ return res+ where+ restrict :: SliceIndex slix' sl' co' dim' -> slix' -> dim' -> sl'+ restrict (SliceNil) () () = ()+ restrict (SliceAll sliceIdx) (slx,()) (sh,sz) = (restrict sliceIdx slx sh, sz)+ restrict (SliceFixed sliceIdx) (slx,i) (sh,sz)+ = BOUNDS_CHECK(checkIndex) "slice" i sz $ restrict sliceIdx slx sh+ --+ convertSlix :: SliceIndex slix' sl' co' dim' -> slix' -> [Int]+ convertSlix (SliceNil) () = []+ convertSlix (SliceAll sliceIdx) (s,()) = convertSlix sliceIdx s+ convertSlix (SliceFixed sliceIdx) (s,i) = i : convertSlix sliceIdx s+++mapOp+ :: Elt e+ => AccKernel (Array dim e)+ -> AccBindings aenv+ -> Val aenv+ -> Array dim e'+ -> CIO (Array dim e)+mapOp kernel bindings aenv (Array sh0 in0) = do+ res@(Array _ out) <- allocateArray (toElt sh0)+ execute kernel bindings aenv (size sh0)+ ((((), out)+ , in0)+ , convertIx (size sh0))+ return res++zipWithOp+ :: forall aenv dim a b c. Elt c+ => AccKernel (Array dim c)+ -> AccBindings aenv+ -> Val aenv+ -> Array dim a+ -> Array dim b+ -> CIO (Array dim c)+zipWithOp kernel bindings aenv (Array sh1 in1) (Array sh0 in0) = do+ res@(Array sh out) <- allocateArray $ toElt (sh1 `intersect` sh0)+ execute kernel bindings aenv (size sh)+ (((((((), out)+ , in1)+ , in0)+ , toElt sh :: dim)+ , toElt sh1 :: dim)+ , toElt sh0 :: dim)+ return res++foldOp, fold1Op+ :: forall dim e aenv. Shape dim+ => AccKernel (Array dim e)+ -> AccBindings aenv+ -> Val aenv+ -> Array (dim:.Int) e+ -> CIO (Array dim e)+fold1Op kernel bindings aenv in0@(Array (_,sz) _)+ = BOUNDS_CHECK(check) "fold1" "empty array" (sz > 0)+ $ foldOp kernel bindings aenv in0++foldOp kernel bindings aenv (Array sh0 in0)+ -- A recursive multi-block reduction when collapsing to a single value+ --+ | dim sh0 == 1 = do+ let numElements = size sh0+ (_,numBlocks,_) = configure kernel (size sh0)+ res@(Array _ out) <- allocateArray (toElt (fst sh0,numBlocks)) :: CIO (Array (dim:.Int) e)+ execute kernel bindings aenv numElements+ ((((), out)+ , in0)+ , convertIx numElements)+ if numBlocks > 1 then foldOp kernel bindings aenv res+ else return (Array (fst sh0) out)+ --+ -- Reduction over the innermost dimension of an array (single pass operation)+ --+ | otherwise = do+ let (sh, sz) = sh0+ interval_size = sz+ num_intervals = size sh+ num_elements = size sh0+ res@(Array _ out) <- allocateArray $ toElt sh+ execute kernel bindings aenv (num_intervals `max` 1)+ ((((((), out)+ , in0)+ , convertIx interval_size)+ , convertIx num_intervals)+ , convertIx num_elements)+ return res++foldSegOp, fold1SegOp+ :: forall aenv dim e i. Shape dim+ => AccKernel (Array (dim:.Int) e)+ -> AccBindings aenv+ -> Val aenv+ -> Array (dim:.Int) e+ -> Segments i+ -> CIO (Array (dim:.Int) e)+fold1SegOp kernel bindings aenv in0 seg =+ foldSegOp kernel bindings aenv in0 seg++foldSegOp kernel bindings aenv (Array sh0 in0) (Array shs seg) = do+ res@(Array sh out) <- allocateArray $ toElt (fst sh0, size shs-1)+ --+ message $ "foldSeg: shOut = (" ++ showShape (toElt sh :: dim :. Int) ++ ")"+ ++ ", shIn0 = (" ++ showShape (toElt sh0 :: dim :. Int) ++ ")"+ execute kernel bindings aenv (size sh)+ ((((((), out)+ , in0)+ , seg)+ , toElt sh :: dim :. Int)+ , toElt sh0 :: dim :. Int)+ return res+++data ScanDirection = L | R++scanOp+ :: forall aenv e. Elt e+ => ScanDirection+ -> FullList () (AccKernel (Vector e))+ -> AccBindings aenv+ -> Val aenv+ -> Vector e+ -> CIO (Vector e)+scanOp dir (FL _ kfold1' (Cons _ kscan Nil)) bindings aenv (Array sh0 in0) = do+ let (_,num_intervals,_) = configure kscan num_elements+ a_out@(Array _ out) <- allocateArray (Z :. num_elements + 1)+ (Array _ blk) <- allocateArray (Z :. num_intervals) :: CIO (Vector e)+ d_out <- devicePtrsOfArrayData out+ --+ -- depending on whether we are a left or right scan, we need to manipulate the+ -- pointers that specify the final element and main scan body+ --+ let interval_size = (num_elements + num_intervals - 1) `div` num_intervals+ body = marshalDevicePtrs out d_body+ sum = marshalDevicePtrs out d_sum+ (d_body, d_sum) =+ case dir of+ L -> (d_out, advancePtrsOfArrayData out num_elements d_out)+ R -> (advancePtrsOfArrayData out 1 d_out, d_out)+ --+ -- If the array is sized such that there is only a single interval, the first+ -- phase of calculating a per-interval carry-in value can be skipped+ --+ when (num_intervals > 1) $ do+ -- Compute the interval sum. Since we use associative operations, this can+ -- be done as a reduction instead of requiring a full left-/right-scan.+ message $ "scan phase 1: interval_size = " ++ shows interval_size+ ", num_intervals = " ++ shows num_intervals+ ", num_elements = " ++ show num_elements+ execute kfold1 bindings aenv num_elements+ ((((((), blk)+ , in0)+ , convertIx interval_size)+ , convertIx num_intervals)+ , convertIx num_elements)++ --+ -- Inclusive scan of the per-interval results to compute each segment's+ -- carry-in value.+ execute kscan bindings aenv 1+ (((((((), blk)+ , sum)+ , blk)+ , blk) -- not used, just need the right number of arguments+ , convertIx num_intervals)+ , convertIx num_intervals)++ --+ -- Prefix-sum of the input array, using interval carry-in values.+ message $ "scan phase 2: interval_size = " ++ shows interval_size+ ", num_elements = " ++ show num_elements+ execute kscan bindings aenv num_elements+ (((((((), body)+ , sum)+ , in0)+ , blk)+ , convertIx interval_size)+ , convertIx num_elements)+ return a_out+ where+ num_elements = size sh0+ kfold1 = retag kfold1' :: AccKernel (Vector e)+-- kscan1 = retag kscan1' :: AccKernel (Vector e)++scanOp _ _ _ _ _ = error "I'll just pretend to hug you until you get here."+++scan'Op+ :: forall aenv e. Elt e+ => FullList () (AccKernel (Vector e, Scalar e))+ -> AccBindings aenv+ -> Val aenv+ -> Vector e+ -> CIO (Vector e, Scalar e)+scan'Op (FL _ kfold1' (Cons _ kscan Nil)) bindings aenv (Array sh0 in0) = do+ let (_,num_intervals,_) = configure kscan num_elements+ (Array _ blk) <- allocateArray (Z :. num_intervals) :: CIO (Vector e)+ a_out@(Array _ out) <- allocateArray (Z :. num_elements)+ a_sum@(Array _ sum) <- allocateArray Z+ let interval_size = (num_elements + num_intervals - 1) `div` num_intervals+ --+ -- see comments in 'scanOp'+ when (num_intervals > 1) $ do+ message $ "scan phase 1: interval_size = " ++ shows interval_size+ ", num_intervals = " ++ shows num_intervals+ ", num_elements = " ++ show num_elements+ execute kfold1 bindings aenv num_elements+ ((((((), blk)+ , in0)+ , convertIx interval_size)+ , convertIx num_intervals)+ , convertIx num_elements)+ --+ execute kscan bindings aenv 1+ (((((((), blk)+ , sum)+ , blk)+ , blk) -- not used+ , convertIx num_intervals)+ , convertIx num_intervals)+ --+ message $ "scan phase 2: interval_size = " ++ shows interval_size+ ", num_elements = " ++ show num_elements+ execute kscan bindings aenv num_elements+ (((((((), out)+ , sum)+ , in0)+ , blk)+ , convertIx interval_size)+ , convertIx num_elements)+ return (a_out, a_sum)+ where+ num_elements = size sh0+ kfold1 = retag kfold1' :: AccKernel (Vector e)++scan'Op _ _ _ _ = error "If I promise not to kill you, can I have a hug?"+++scan1Op+ :: forall aenv e. Elt e+ => FullList () (AccKernel (Vector e))+ -> AccBindings aenv+ -> Val aenv+ -> Vector e+ -> CIO (Vector e)+scan1Op (FL _ kfold1' (Cons _ kscan1 Nil)) bindings aenv (Array sh0 in0) = do+ let (_,num_intervals,_) = configure kscan1 num_elements+ (Array _ sum) <- allocateArray Z :: CIO (Scalar e)+ (Array _ blk) <- allocateArray (Z :. num_intervals) :: CIO (Vector e)+ a_out@(Array _ out) <- allocateArray (Z :. num_elements)+ let interval_size = (num_elements + num_intervals - 1) `div` num_intervals+ --+ -- see comments in 'scanOp'+ when (num_intervals > 1) $ do+ message $ "scan phase 1: interval_size = " ++ shows interval_size+ ", num_intervals = " ++ shows num_intervals+ ", num_elements = " ++ show num_elements+ execute kfold1 bindings aenv num_elements+ ((((((), blk)+ , in0)+ , convertIx interval_size)+ , convertIx num_intervals)+ , convertIx num_elements)+ --+ execute kscan1 bindings aenv 1+ (((((((), blk)+ , sum)+ , blk)+ , blk) -- not used+ , convertIx num_intervals)+ , convertIx num_intervals)+ --+ message $ "scan phase 2: interval_size = " ++ shows interval_size+ ", num_elements = " ++ show num_elements+ execute kscan1 bindings aenv num_elements+ (((((((), out)+ , sum)+ , in0)+ , blk)+ , convertIx interval_size)+ , convertIx num_elements)+ return a_out+ where+ num_elements = size sh0+ kfold1 = retag kfold1' :: AccKernel (Vector e)++scan1Op _ _ _ _ = error "If you get wet, you'll get sick."+++permuteOp+ :: forall aenv dim dim' e. Elt e+ => AccKernel (Array dim' e)+ -> AccBindings aenv+ -> Val aenv+ -> Array dim' e -- default values+ -> Array dim e -- permuted array+ -> CIO (Array dim' e)+permuteOp kernel bindings aenv in0@(Array sh0 _) (Array sh1 in1) = do+ res@(Array _ out) <- allocateArray (toElt sh0)+ copyArray in0 res+ execute kernel bindings aenv (size sh0)+ (((((), out)+ , in1)+ , toElt sh0 :: dim')+ , toElt sh1 :: dim)+ return res++backpermuteOp+ :: forall aenv dim dim' e. (Shape dim', Elt e)+ => AccKernel (Array dim' e)+ -> AccBindings aenv+ -> Val aenv+ -> dim'+ -> Array dim e+ -> CIO (Array dim' e)+backpermuteOp kernel bindings aenv dim' (Array sh0 in0) = do+ res@(Array sh out) <- allocateArray dim'+ execute kernel bindings aenv (size sh)+ (((((), out)+ , in0)+ , toElt sh :: dim')+ , toElt sh0 :: dim)+ return res++stencilOp+ :: forall aenv dim a b. Elt b+ => AccKernel (Array dim b)+ -> AccBindings aenv+ -> Val aenv+ -> Array dim a+ -> CIO (Array dim b)+stencilOp kernel@(Kernel _ mdl _ _ _) bindings aenv in0@(Array sh0 _) = do+ res@(Array _ out) <- allocateArray (toElt sh0)+ bindStencil 0 mdl in0+ execute kernel bindings aenv (size sh0)+ (((), out)+ , toElt sh0 :: dim)+ return res++stencil2Op+ :: forall aenv dim a b c. Elt c+ => AccKernel (Array dim c)+ -> AccBindings aenv+ -> Val aenv+ -> Array dim a+ -> Array dim b+ -> CIO (Array dim c)+stencil2Op kernel@(Kernel _ mdl _ _ _) bindings aenv in1@(Array sh1 _) in0@(Array sh0 _) = do+ res@(Array sh out) <- allocateArray $ toElt (sh1 `intersect` sh0)+ bindStencil 1 mdl in1+ bindStencil 0 mdl in0+ execute kernel bindings aenv (size sh)+ (((((), out)+ , toElt sh :: dim)+ , toElt sh1 :: dim)+ , toElt sh0 :: dim)+ return res+++-- Expression evaluation+-- ---------------------++-- Evaluate an open expression+--+executeOpenExp :: PreOpenExp ExecOpenAcc env aenv t -> Val env -> Val aenv -> CIO t+executeOpenExp exp env aenv = do+ case exp of+ -- Local binders and variable indices, ranging over tuples and scalars+ Var ix -> return $! prj ix env+ Let x e -> do+ x' <- executeOpenExp x env aenv+ executeOpenExp e (env `Push` x') aenv++ -- Constant values+ Const c -> return $! toElt c+ PrimConst c -> return $! I.evalPrimConst c++ -- Primitive scalar operations+ PrimApp fun arg -> do+ x <- executeOpenExp arg env aenv+ return $! I.evalPrim fun x++ -- Tuples+ Tuple tup -> do+ t <- executeTuple tup env aenv+ return $! toTuple t++ Prj ix e -> do+ t <- executeOpenExp e env aenv+ return $! I.evalPrj ix (fromTuple t)++ -- Conditional expression+ Cond p t e -> do+ p' <- executeOpenExp p env aenv+ case p' of+ True -> executeOpenExp t env aenv+ False -> executeOpenExp e env aenv++ -- Array indices and shapes+ IndexAny -> return Sugar.Any+ IndexNil -> return Z+ IndexCons sh sz -> do+ sh' <- executeOpenExp sh env aenv+ sz' <- executeOpenExp sz env aenv+ return $! sh' :. sz'++ IndexHead sh -> do+ (_ :. ix) <- executeOpenExp sh env aenv+ return $! ix++ IndexTail sh -> do+ (ix :. _) <- executeOpenExp sh env aenv+ return $! ix++ -- Array shape and element indexing+ IndexScalar acc ix -> do+ arr' <- executeOpenAcc acc aenv+ ix' <- executeOpenExp ix env aenv+ indexArray arr' ix'++ Shape acc -> do+ (Array sh _) <- executeOpenAcc acc aenv+ return $! toElt sh++ ShapeSize e -> do+ sh <- executeOpenExp e env aenv+ return $! size (fromElt sh)+++-- Evaluate a closed expression+--+executeExp :: PreExp ExecOpenAcc aenv t -> Val aenv -> CIO t+executeExp e = executeOpenExp e Empty+++-- Tuple evaluation+--+executeTuple :: Tuple (PreOpenExp ExecOpenAcc env aenv) t -> Val env -> Val aenv -> CIO t+executeTuple NilTup _ _ = return ()+executeTuple (t `SnocTup` e) env aenv = (,) <$> executeTuple t env aenv+ <*> executeOpenExp e env aenv+++-- Array references in scalar code+-- -------------------------------++bindLifted :: CUDA.Module -> Val aenv -> AccBindings aenv -> CIO ()+bindLifted mdl aenv (AccBindings vars) = mapM_ (bindAcc mdl aenv) (Set.toList vars)+++bindAcc+ :: CUDA.Module+ -> Val aenv+ -> ArrayVar aenv+ -> CIO ()+bindAcc mdl aenv (ArrayVar idx) =+ let idx' = show $ idxToInt idx+ Array sh ad = prj idx aenv+ --+ bindDim = liftIO $+ CUDA.getPtr mdl ("sh" ++ idx') >>=+ CUDA.pokeListArray (convertSh sh) . fst+ --+ arr n = "arr" ++ idx' ++ "_a" ++ show (n::Int)+ tex = CUDA.getTex mdl . arr+ bindTex = marshalTextureData ad (size sh) =<< liftIO (sequence' $ map tex [0..])+ in+ bindDim >> bindTex+++bindStencil+ :: Int+ -> CUDA.Module+ -> Array dim e+ -> CIO ()+bindStencil s mdl (Array sh ad) =+ let sten n = "stencil" ++ show s ++ "_a" ++ show (n::Int)+ tex = CUDA.getTex mdl . sten+ in+ marshalTextureData ad (size sh) =<< liftIO (sequence' $ map tex [0..])+++-- Kernel execution+-- ----------------++-- Data which can be marshalled as arguments to a kernel invocation.+--+class Marshalable a where+ marshal :: a -> CIO [CUDA.FunParam]++instance Marshalable () where+ marshal _ = return []++#define primMarshalable(ty) \+instance Marshalable (ty) where { \+ marshal x = return [CUDA.VArg x] }++primMarshalable(Int)+primMarshalable(Int8)+primMarshalable(Int16)+primMarshalable(Int32)+primMarshalable(Int64)+primMarshalable(Word)+primMarshalable(Word8)+primMarshalable(Word16)+primMarshalable(Word32)+primMarshalable(Word64)+primMarshalable(Float)+primMarshalable(Double)+primMarshalable(Ptr a)+primMarshalable(CUDA.DevicePtr a)++instance Marshalable CUDA.FunParam where+ marshal x = return [x]++instance AD.ArrayElt e => Marshalable (AD.ArrayData e) where+ marshal = marshalArrayData++instance Marshalable a => Marshalable [a] where+ marshal = concatMapM marshal++instance (Marshalable a, Marshalable b) => Marshalable (a,b) where+ marshal (a,b) = (++) <$> marshal a <*> marshal b+++-- This requires incoherent instances \=+--+instance Shape sh => Storable sh where+ sizeOf sh = F.sizeOf (undefined::Int32) * (1 `max` Sugar.dim sh)+ alignment _ = F.alignment (undefined::Int32)+ poke p sh = F.pokeArray (F.castPtr p) (convertSh (fromElt sh))++instance Shape sh => Marshalable sh where+ marshal sh = return [CUDA.VArg sh]+++-- What launch parameters should we use to execute the kernel with a number of+-- array elements?+--+configure :: AccKernel a -> Int -> (Int, Int, Int)+configure (Kernel _ !_ !_ !_ !launchConfig) !n = launchConfig n+++-- Link the binary object implementing the computation, configure the kernel+-- launch parameters, and initiate the computation. This also handles lifting+-- and binding of array references from scalar expressions.+--+execute :: Marshalable args+ => AccKernel a -- The binary module implementing this kernel+ -> AccBindings aenv -- Array variables embedded in scalar expressions+ -> Val aenv+ -> Int+ -> args+ -> CIO ()+execute kernel@(Kernel _ !mdl !_ !_ !_) !bindings !aenv !n !args = do+ bindLifted mdl aenv bindings+ launch kernel (configure kernel n) args+++-- Execute a device function, with the given thread configuration and function+-- parameters. The tuple contains (threads per block, grid size, shared memory)+--+launch :: Marshalable args => AccKernel a -> (Int,Int,Int) -> args -> CIO ()+launch (Kernel entry _ !fn _ _) !(cta, grid, smem) !a = do+ message $ entry ++ " <<< " ++ shows grid ", " ++ shows cta ", " ++ shows smem " >>>"+ --+ args <- marshal a+ liftIO $ CUDA.launchKernel fn (grid,1,1) (cta,1,1) smem Nothing args+++-- Auxiliary functions+-- -------------------++-- Generalise concatMap for teh monadz+--+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = concat `liftM` mapM f xs++-- A lazier version of 'Control.Monad.sequence'+--+sequence' :: [IO a] -> IO [a]+sequence' = foldr k (return [])+ where k m ms = do { x <- m; xs <- unsafeInterleaveIO ms; return (x:xs) }++-- Extract shape dimensions as a list of integers. Singleton dimensions are+-- considered to be of unit size.+--+-- Internally, Accelerate uses snoc-based tuple projection, while the data+-- itself is stored in reading order. Ensure we match the behaviour of regular+-- tuples and code generation thereof.+--+convertSh :: R.Shape sh => sh -> [Int32]+convertSh = post . shapeToList+ where+ post [] = [1]+ post xs = reverse (map convertIx xs)++convertIx :: Int -> Int32+convertIx ix = INTERNAL_ASSERT "convertIx" (ix <= intmax) (fromIntegral ix)+ where intmax = fromIntegral (maxBound :: Int32)+++-- Apply a function to all components of an Arrays structure+--+applyArraysR+ :: (forall sh e. (Shape sh, Elt e) => Array sh e -> CIO ())+ -> ArraysR arrs+ -> arrs+ -> CIO ()+applyArraysR _ ArraysRunit () = return ()+applyArraysR f (ArraysRpair r1 r0) (a1, a0) = applyArraysR f r1 a1 >> applyArraysR f r0 a0+applyArraysR f ArraysRarray arr = f arr+++-- Debug+-- -----++{-# INLINE trace #-}+trace :: String -> CIO a -> CIO a+trace msg next = D.message D.dump_exec ("exec: " ++ msg) >> next++{-# INLINE message #-}+message :: String -> CIO ()+message s = s `trace` return ()+
+ Data/Array/Accelerate/CUDA/FullList.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Data.Array.Accelerate.CUDA.FullList+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--+-- Non-empty lists of key/value pairs. The lists are strict in the key and lazy+-- in the values. We assume that keys only occur once.+--++module Data.Array.Accelerate.CUDA.FullList (++ FullList(..),+ List(..),++ singleton,+ cons,+ size,+ lookup++) where++import Prelude hiding ( lookup )+++data FullList k v = FL !k v !(List k v)+data List k v = Nil | Cons !k v !(List k v)++infixr 5 `Cons`++instance (Eq k, Eq v) => Eq (FullList k v) where+ (FL k1 v1 xs) == (FL k2 v2 ys) = k1 == k2 && v1 == v2 && xs == ys+ (FL k1 v1 xs) /= (FL k2 v2 ys) = k1 /= k2 || v1 /= v2 || xs /= ys++instance (Eq k, Eq v) => Eq (List k v) where+ (Cons k1 v1 xs) == (Cons k2 v2 ys) = k1 == k2 && v1 == v2 && xs == ys+ Nil == Nil = True+ _ == _ = False++ (Cons k1 v1 xs) /= (Cons k2 v2 ys) = k1 /= k2 || v1 /= v2 || xs /= ys+ Nil /= Nil = False+ _ /= _ = True+++-- List-like operations+--+infixr 5 `cons`+cons :: k -> v -> FullList k v -> FullList k v+cons k v (FL k' v' xs) = FL k v (Cons k' v' xs)++singleton :: k -> v -> FullList k v+singleton k v = FL k v Nil++size :: FullList k v -> Int+size (FL _ _ xs) = 1 + sizeL xs++sizeL :: List k v -> Int+sizeL Nil = 0+sizeL (Cons _ _ xs) = 1 + sizeL xs++lookup :: Eq k => k -> FullList k v -> Maybe v+lookup key (FL k v xs)+ | key == k = Just v+ | otherwise = lookupL key xs+{-# INLINABLE lookup #-}++lookupL :: Eq k => k -> List k v -> Maybe v+lookupL !key = go+ where+ go Nil = Nothing+ go (Cons k v xs)+ | key == k = Just v+ | otherwise = go xs+{-# INLINABLE lookupL #-}+
+ Data/Array/Accelerate/CUDA/State.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- CUDA.Context+-- |+-- Module : Data.Array.Accelerate.CUDA.State+-- Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+-- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-partable (GHC extensions)+--+-- This module defines a state monad token which keeps track of the code+-- generator state, including memory transfers and external compilation+-- processes.+--++module Data.Array.Accelerate.CUDA.State (++ -- Types+ CIO, KernelTable, KernelKey, KernelEntry(KernelEntry), KernelObject(KernelObject),++ -- Evaluating computations+ evalCUDA, defaultContext, deviceProps,+ memoryTable, kernelTable, kernelName, kernelStatus++) where++-- friends+import Data.Array.Accelerate.CUDA.FullList ( FullList )+import Data.Array.Accelerate.CUDA.Debug ( message, verbose, dump_gc, showFFloatSIBase )+import Data.Array.Accelerate.CUDA.Array.Table as MT+import Data.Array.Accelerate.CUDA.Analysis.Device++-- library+import Data.Label+import Control.Exception+import Data.ByteString ( ByteString )+import Control.Concurrent.MVar ( MVar, newMVar )+import Control.Monad.State.Strict ( StateT(..), evalStateT )+import System.Process ( ProcessHandle )+import System.Mem ( performGC )+import System.Mem.Weak ( addFinalizer )+import System.IO.Unsafe+import Text.PrettyPrint+import qualified Foreign.CUDA.Driver as CUDA hiding ( device )+import qualified Foreign.CUDA.Driver.Context as CUDA+import qualified Foreign.CUDA.Analysis as CUDA+import qualified Data.HashTable.IO as HT++#ifdef ACCELERATE_CUDA_PERSISTENT_CACHE+import Data.Binary ( encodeFile, decodeFile )+import Control.Arrow ( second )+import Paths_accelerate ( getDataDir )+#endif+++-- An exact association between an accelerate computation and its+-- implementation, which is either a reference to the external compiler (nvcc)+-- or the resulting binary module.+--+-- Note that since we now support running in multiple contexts, we also need to+-- keep track of+-- a) the compute architecture the code was compiled for+-- b) which contexts have linked the code+--+-- We aren't concerned with true (typed) equality of an OpenAcc expression,+-- since we largely want to disregard the array environment; we really only want+-- to assert the type and index of those variables that are accessed by the+-- computation and no more, but we can not do that. Instead, this is keyed to+-- the generated kernel code.+--+type KernelTable = HT.BasicHashTable KernelKey KernelEntry++type KernelKey = (CUDA.Compute, ByteString)+data KernelEntry = KernelEntry+ {+ _kernelName :: !FilePath,+ _kernelStatus :: !(Either ProcessHandle KernelObject)+ }++data KernelObject = KernelObject+ {+ _binaryData :: !ByteString,+ _activeContexts :: {-# UNPACK #-} !(FullList CUDA.Context CUDA.Module)+ }++-- The state token for CUDA accelerated array operations+--+type CIO = StateT CUDAState IO+data CUDAState = CUDAState+ {+ _deviceProps :: !CUDA.DeviceProperties,+ _kernelTable :: {-# UNPACK #-} !KernelTable,+ _memoryTable :: {-# UNPACK #-} !MemoryTable+ }++instance Eq CUDA.Context where+ CUDA.Context p1 == CUDA.Context p2 = p1 == p2++$(mkLabels [''CUDAState, ''KernelEntry])+++-- Execution State+-- ---------------++-- |Evaluate a CUDA array computation+--+evalCUDA :: CUDA.Context -> CIO a -> IO a+evalCUDA ctx acc = bracket setup teardown $ evalStateT acc+ where+ teardown _ = CUDA.pop >> performGC+ setup = do+ CUDA.push ctx+ dev <- CUDA.device+ prp <- CUDA.props dev+ return $! CUDAState prp knl mem++ -- one-shot top-level mutable state+ {-# NOINLINE mem #-}+ {-# NOINLINE knl #-}+ mem = unsafePerformIO MT.new+ knl = unsafePerformIO HT.new+++-- Select and initialise a default CUDA device, and create a new execution+-- context. The device is selected based on compute capability and estimated+-- maximum throughput.+--+{-# NOINLINE defaultContext #-}+defaultContext :: MVar CUDA.Context+defaultContext = unsafePerformIO $ do+ CUDA.initialise []+ (dev,prp) <- selectBestDevice+ ctx <- CUDA.create dev [CUDA.SchedAuto] >> CUDA.pop+ ref <- newMVar ctx+ --+ message dump_gc $ "gc: initialise context"+ message verbose $ deviceInfo dev prp+ --+ addFinalizer ctx $ do+ message dump_gc $ "gc: finalise context"+ CUDA.destroy ctx+ --+ return ref+++-- Debugging+-- ---------++-- Nicely format a summary of the selected CUDA device, example:+--+-- Device 0: GeForce 9600M GT (compute capability 1.1)+-- 4 multiprocessors @ 1.25GHz (32 cores), 512MB global memory+--+deviceInfo :: CUDA.Device -> CUDA.DeviceProperties -> String+deviceInfo dev prp = render $+ devID <> colon <+> vcat [ name <+> parens compute+ , processors <+> at <+> text clock <+> parens cores <> comma <+> memory+ ]+ where+ name = text (CUDA.deviceName prp)+ compute = text "compute capatability" <+> double (CUDA.computeCapability prp)+ devID = text "Device" <+> int (fromIntegral $ CUDA.useDevice dev) -- hax+ processors = int (CUDA.multiProcessorCount prp) <+> text "multiprocessors"+ cores = int (CUDA.multiProcessorCount prp * coresPerMultiProcessor prp) <+> text "cores"+ memory = text mem <+> text "global memory"+ --+ clock = showFFloatSIBase (Just 2) 1000 (fromIntegral $ CUDA.clockRate prp * 1000 :: Double) "Hz"+ mem = showFFloatSIBase (Just 0) 1024 (fromIntegral $ CUDA.totalGlobalMem prp :: Double) "B"+ at = char '@'+++-- Persistent caching (deprecated)+-- -------------------------------++#ifdef ACCELERATE_CUDA_PERSISTENT_CACHE+-- Load and save the persistent kernel index file+--+indexFileName :: IO FilePath+indexFileName = do+ tmp <- (</> "cache") `fmap` getDataDir+ dir <- createDirectoryIfMissing True tmp >> canonicalizePath tmp+ return (dir </> "_index")++saveIndexFile :: CUDAState -> IO ()+saveIndexFile s = do+ ind <- indexFileName+ encodeFile ind . map (second _kernelName) =<< HT.toList (_kernelTable s)++-- Read the kernel index map file (if it exists), loading modules into the+-- current context+--+loadIndexFile :: IO (KernelTable, Int)+loadIndexFile = do+ f <- indexFileName+ x <- doesFileExist f+ e <- if x then mapM reload =<< decodeFile f+ else return []+ (,length e) <$> HT.fromList hashAccKey e+ where+ reload (k,n) = (k,) . KernelEntry n . Right <$> CUDA.loadFile (n `replaceExtension` ".cubin")+#endif+
+ Data/Array/Accelerate/Internal/Check.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP #-}+-- |+-- Module : Data.Array.Accelerate.Internal.Check+-- Copyright : Roman Lechinskiy, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Bounds checking infrastructure+--+-- Stolen from the Vector package by Roman Leshchinskiy. This code has a+-- BSD-style license. <http://hackage.haskell.org/package/vector>+--++module Data.Array.Accelerate.Internal.Check (++ -- * Bounds checking and assertion infrastructure+ Checks(..), doChecks,+ error, check, assert, checkIndex, checkLength, checkSlice++) where++import Prelude hiding( error )+import qualified Prelude as P++data Checks = Bounds | Unsafe | Internal deriving( Eq )++doBoundsChecks :: Bool+#ifdef ACCELERATE_BOUNDS_CHECKS+doBoundsChecks = True+#else+doBoundsChecks = False+#endif++doUnsafeChecks :: Bool+#ifdef ACCELERATE_UNSAFE_CHECKS+doUnsafeChecks = True+#else+doUnsafeChecks = False+#endif++doInternalChecks :: Bool+#ifdef ACCELERATE_INTERNAL_CHECKS+doInternalChecks = True+#else+doInternalChecks = False+#endif+++doChecks :: Checks -> Bool+{-# INLINE doChecks #-}+doChecks Bounds = doBoundsChecks+doChecks Unsafe = doUnsafeChecks+doChecks Internal = doInternalChecks++error :: String -> Int -> Checks -> String -> String -> a+error file line kind loc msg+ = P.error . unlines $+ (if kind == Internal+ then ([""+ ,"*** Internal error in package accelerate-cuda ***"+ ,"*** Please submit a bug report at https://github.com/AccelerateHS/accelerate/issues"]++)+ else id)+ [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]++check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a+{-# INLINE check #-}+check file line kind loc msg cond x+ | not (doChecks kind) || cond = x+ | otherwise = error file line kind loc msg++assert_msg :: String+assert_msg = "assertion failure"++assert :: String -> Int -> Checks -> String -> Bool -> a -> a+{-# INLINE assert #-}+assert file line kind loc = check file line kind loc assert_msg++checkIndex_msg :: Int -> Int -> String+{-# NOINLINE checkIndex_msg #-}+checkIndex_msg i n = "index out of bounds " ++ show (i,n)++checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a+{-# INLINE checkIndex #-}+checkIndex file line kind loc i n x+ = check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x+++checkLength_msg :: Int -> String+{-# NOINLINE checkLength_msg #-}+checkLength_msg n = "negative length " ++ show n++checkLength :: String -> Int -> Checks -> String -> Int -> a -> a+{-# INLINE checkLength #-}+checkLength file line kind loc n x+ = check file line kind loc (checkLength_msg n) (n >= 0) x+++checkSlice_msg :: Int -> Int -> Int -> String+{-# NOINLINE checkSlice_msg #-}+checkSlice_msg i m n = "invalid slice " ++ show (i,m,n)++checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a+{-# INLINE checkSlice #-}+checkSlice file line kind loc i m n x+ = check file line kind loc (checkSlice_msg i m n)+ (i >= 0 && m >= 0 && i+m <= n) x+
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) [2007..2012] The Accelerate Team. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * 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.+ * Neither the names of the contributors nor of their affiliations may + be used to endorse or promote products derived from this software + without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''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 COPYRIGHT HOLDERS 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.
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ accelerate-cuda.cabal view
@@ -0,0 +1,164 @@+Name: accelerate-cuda+Version: 0.12.0.0+Cabal-version: >= 1.6+Tested-with: GHC >= 7.4+Build-type: Configure++Synopsis: Accelerate backend for NVIDIA GPUs+Description:+ This library implements a backend for the Accelerate language instrumented for+ parallel execution on CUDA-capable NVIDIA GPUs.+ .+ To use this backend you need CUDA version 3.x or later installed. Note that+ currently there is no support for 'Char' and 'Bool' arrays (this is a+ limitation of the front-end language).++License: BSD3+License-file: LICENSE+Author: Manuel M T Chakravarty,+ Gabriele Keller,+ Sean Lee,+ Trevor L. McDonell+Maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+Bug-reports: https://github.com/AccelerateHS/accelerate/issues+Homepage: http://www.cse.unsw.edu.au/~chak/project/accelerate/++Category: Compilers/Interpreters, Concurrency, Data, Parallelism+Stability: Experimental++-- We require 'accelerate_cuda_shape.h' to be in this list so that it is copied+-- as part of the installation, although 'cabal sdist' does not grok that it is+-- generated by the configure script.+--+Data-files: cubits/accelerate_cuda_extras.h+ cubits/accelerate_cuda_function.h+ cubits/accelerate_cuda_shape.h+ cubits/accelerate_cuda_stencil.h+ cubits/accelerate_cuda_texture.h+ cubits/accelerate_cuda_util.h++Extra-tmp-files: config.status+ config.log+ cubits/accelerate_cuda_shape.h -- generated by configure++Extra-source-files: configure+ cubits/accelerate_cuda_shape.h.in+ include/accelerate.h++-- Flag pcache+-- Description: Enable the persistent caching of the compiled CUDA modules (experimental)+-- Default: False++Flag debug+ Description: Enable tracing message flags+ Default: False++Flag bounds-checks+ Description: Enable bounds checking+ Default: True++Flag unsafe-checks+ Description: Enable bounds checking in unsafe operations+ Default: False++Flag internal-checks+ Description: Enable internal consistency checks+ Default: False++Library+ Include-Dirs: include++ Build-depends: accelerate == 0.12.*,+ array >= 0.3,+ base == 4.*,+ binary >= 0.5,+ blaze-builder >= 0.3,+ bytestring >= 0.9,+ containers >= 0.4,+ cryptohash >= 0.7,+ cuda >= 0.4.1,+ directory >= 1.0,+ fclabels >= 1.0,+ filepath >= 1.0,+ hashable >= 1.1,+ hashtables >= 1.0.1,+ language-c-quote >= 0.3,+ mainland-pretty >= 0.1.1,+ mtl >= 2.0,+ pretty >= 1.0,+ process >= 1.0,+ srcloc >= 0.1,+ symbol >= 0.1,+ transformers >= 0.2,+ unordered-containers >= 0.1.4++ if os(windows)+ build-depends: Win32 >= 2.2.1+ else+ build-depends: unix >= 2.4++ Exposed-modules: Data.Array.Accelerate.CUDA++ Other-modules: Data.Array.Accelerate.CUDA.Analysis.Device+ Data.Array.Accelerate.CUDA.Analysis.Launch+ Data.Array.Accelerate.CUDA.Array.Data+ Data.Array.Accelerate.CUDA.Array.Prim+ Data.Array.Accelerate.CUDA.Array.Sugar+ Data.Array.Accelerate.CUDA.Array.Table+ Data.Array.Accelerate.CUDA.CodeGen+ Data.Array.Accelerate.CUDA.CodeGen.Base+ Data.Array.Accelerate.CUDA.CodeGen.Monad+ Data.Array.Accelerate.CUDA.CodeGen.Mapping+ Data.Array.Accelerate.CUDA.CodeGen.IndexSpace+ Data.Array.Accelerate.CUDA.CodeGen.PrefixSum+ Data.Array.Accelerate.CUDA.CodeGen.Reduction+ Data.Array.Accelerate.CUDA.CodeGen.Stencil+ Data.Array.Accelerate.CUDA.CodeGen.Type+ Data.Array.Accelerate.CUDA.AST+ Data.Array.Accelerate.CUDA.Compile+ Data.Array.Accelerate.CUDA.Debug+ Data.Array.Accelerate.CUDA.Execute+ Data.Array.Accelerate.CUDA.FullList+ Data.Array.Accelerate.CUDA.State+ Data.Array.Accelerate.Internal.Check+ Paths_accelerate_cuda++-- if flag(pcache)+-- CPP-options: -DACCELERATE_CUDA_PERSISTENT_CACHE++ if flag(debug)+ cpp-options: -DACCELERATE_DEBUG++ if flag(bounds-checks)+ cpp-options: -DACCELERATE_BOUNDS_CHECKS++ if flag(unsafe-checks)+ cpp-options: -DACCELERATE_UNSAFE_CHECKS++ if flag(internal-checks)+ cpp-options: -DACCELERATE_INTERNAL_CHECKS++ ghc-options: -O2+ -Wall+ -fwarn-tabs++ Extensions: BangPatterns,+ CPP,+ ExistentialQuantification,+ FlexibleContexts,+ FlexibleInstances,+ GADTs,+ PatternGuards,+ QuasiQuotes,+ RankNTypes,+ ScopedTypeVariables,+ TemplateHaskell,+ TupleSections,+ TypeFamilies,+ TypeOperators,+ TypeSynonymInstances++source-repository head+ type: git+ location: https://github.com/AccelerateHS/accelerate-cuda+
+ configure view
@@ -0,0 +1,3410 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.65 for accelerate-cuda 0.9.0.0.+#+# Report bugs to <accelerate@projects.haskell.org>.+#+#+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,+# Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+ emulate sh+ NULLCMD=:+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+ # is contrary to our usage. Disable this feature.+ alias -g '${1+"$@"}'='"$@"'+ setopt NO_GLOB_SUBST+else+ case `(set -o) 2>/dev/null` in #(+ *posix*) :+ set -o posix ;; #(+ *) :+ ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+ as_echo='print -r --'+ as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+ as_echo='printf %s\n'+ as_echo_n='printf %s'+else+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+ as_echo_n='/usr/ucb/echo -n'+ else+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+ as_echo_n_body='eval+ arg=$1;+ case $arg in #(+ *"$as_nl"*)+ expr "X$arg" : "X\\(.*\\)$as_nl";+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+ esac;+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+ '+ export as_echo_n_body+ as_echo_n='sh -c $as_echo_n_body as_echo'+ fi+ export as_echo_body+ as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+ PATH_SEPARATOR=:+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+ PATH_SEPARATOR=';'+ }+fi+++# IFS+# We need space, tab and new line, in precisely that order. Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" "" $as_nl"++# Find who we are. Look in the path if we contain no directory separator.+case $0 in #((+ *[\\/]* ) as_myself=$0 ;;+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+ done+IFS=$as_save_IFS++ ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+ as_myself=$0+fi+if test ! -f "$as_myself"; then+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+ exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there. '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH++if test "x$CONFIG_SHELL" = x; then+ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :+ emulate sh+ NULLCMD=:+ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+ # is contrary to our usage. Disable this feature.+ alias -g '\${1+\"\$@\"}'='\"\$@\"'+ setopt NO_GLOB_SUBST+else+ case \`(set -o) 2>/dev/null\` in #(+ *posix*) :+ set -o posix ;; #(+ *) :+ ;;+esac+fi+"+ as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :++else+ exitcode=1; echo positional parameters were not saved.+fi+test x\$exitcode = x0 || exit 1"+ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"+ if (eval "$as_required") 2>/dev/null; then :+ as_have_required=yes+else+ as_have_required=no+fi+ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :++else+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+as_found=false+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ as_found=:+ case $as_dir in #(+ /*)+ for as_base in sh bash ksh sh5; do+ # Try only shells that exist, to save several forks.+ as_shell=$as_dir/$as_base+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :+ CONFIG_SHELL=$as_shell as_have_required=yes+ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :+ break 2+fi+fi+ done;;+ esac+ as_found=false+done+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :+ CONFIG_SHELL=$SHELL as_have_required=yes+fi; }+IFS=$as_save_IFS+++ if test "x$CONFIG_SHELL" != x; then :+ # We cannot yet assume a decent shell, so we have to provide a+ # neutralization value for shells without unset; and this also+ # works around shells that cannot unset nonexistent variables.+ BASH_ENV=/dev/null+ ENV=/dev/null+ (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+ export CONFIG_SHELL+ exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}+fi++ if test x$as_have_required = xno; then :+ $as_echo "$0: This script requires a shell more modern than all"+ $as_echo "$0: the shells that I found on your system."+ if test x${ZSH_VERSION+set} = xset ; then+ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"+ $as_echo "$0: be upgraded to zsh 4.3.4 or later."+ else+ $as_echo "$0: Please tell bug-autoconf@gnu.org and+$0: accelerate@projects.haskell.org about your system,+$0: including any error possibly output before this+$0: message. Then install a modern shell, or manually run+$0: the script under such a shell if you do have one."+ fi+ exit 1+fi+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+ { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+ return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+ set +e+ as_fn_set_status $1+ exit $1+} # as_fn_exit++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++ case $as_dir in #(+ -*) as_dir=./$as_dir;;+ esac+ test -d "$as_dir" || eval $as_mkdir_p || {+ as_dirs=+ while :; do+ case $as_dir in #(+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+ *) as_qdir=$as_dir;;+ esac+ as_dirs="'$as_qdir' $as_dirs"+ as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+ X"$as_dir" : 'X\(//\)[^/]' \| \+ X"$as_dir" : 'X\(//\)$' \| \+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+ s//\1/+ q+ }+ /^X\(\/\/\)[^/].*/{+ s//\1/+ q+ }+ /^X\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`+ test -d "$as_dir" && break+ done+ test -z "$as_dirs" || eval "mkdir $as_dirs"+ } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"+++} # as_fn_mkdir_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+ eval 'as_fn_append ()+ {+ eval $1+=\$2+ }'+else+ as_fn_append ()+ {+ eval $1=\$$1\$2+ }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+ eval 'as_fn_arith ()+ {+ as_val=$(( $* ))+ }'+else+ as_fn_arith ()+ {+ as_val=`expr "$@" || test $? -eq 1`+ }+fi # as_fn_arith+++# as_fn_error ERROR [LINENO LOG_FD]+# ---------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with status $?, using 1 if that was 0.+as_fn_error ()+{+ as_status=$?; test $as_status -eq 0 && as_status=1+ if test "$3"; then+ as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3+ fi+ $as_echo "$as_me: error: $1" >&2+ as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+ test "X`expr 00001 : '.*\(...\)'`" = X001; then+ as_expr=expr+else+ as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+ as_basename=basename+else+ as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+ as_dirname=dirname+else+ as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+ X"$0" : 'X\(//\)$' \| \+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+ sed '/^.*\/\([^/][^/]*\)\/*$/{+ s//\1/+ q+ }+ /^X\/\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\/\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++ as_lineno_1=$LINENO as_lineno_1a=$LINENO+ as_lineno_2=$LINENO as_lineno_2a=$LINENO+ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)+ sed -n '+ p+ /[$]LINENO/=+ ' <$as_myself |+ sed '+ s/[$]LINENO.*/&-/+ t lineno+ b+ :lineno+ N+ :loop+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+ t loop+ s/-\n.*//+ ' >$as_me.lineno &&+ chmod +x "$as_me.lineno" ||+ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++ # Don't try to exec as it changes $[0], causing all sort of problems+ # (the dirname of $[0] is not the place where we might find the+ # original and so on. Autoconf is especially sensitive to this).+ . "./$as_me.lineno"+ # Exit status is that of the last command.+ exit+}++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+ case `echo 'xy\c'` in+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.+ xy) ECHO_C='\c';;+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null+ ECHO_T=' ';;+ esac;;+*)+ ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+ rm -f conf$$.dir/conf$$.file+else+ rm -f conf$$.dir+ mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+ if ln -s conf$$.file conf$$ 2>/dev/null; then+ as_ln_s='ln -s'+ # ... but there are two gotchas:+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+ # In both cases, we have to default to `cp -p'.+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+ as_ln_s='cp -p'+ elif ln conf$$.file conf$$ 2>/dev/null; then+ as_ln_s=ln+ else+ as_ln_s='cp -p'+ fi+else+ as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+ as_mkdir_p='mkdir -p "$as_dir"'+else+ test -d ./-p && rmdir ./-p+ as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+ as_test_x='test -x'+else+ if ls -dL / >/dev/null 2>&1; then+ as_ls_L_option=L+ else+ as_ls_L_option=+ fi+ as_test_x='+ eval sh -c '\''+ if test -d "$1"; then+ test -d "$1/.";+ else+ case $1 in #(+ -*)set "./$1";;+ esac;+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+ ???[sx]*):;;*)false;;esac;fi+ '\'' sh+ '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++test -n "$DJDIR" || exec 7<&0 </dev/null+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# Identity of this package.+PACKAGE_NAME='accelerate-cuda'+PACKAGE_TARNAME='accelerate-cuda'+PACKAGE_VERSION='0.9.0.0'+PACKAGE_STRING='accelerate-cuda 0.9.0.0'+PACKAGE_BUGREPORT='accelerate@projects.haskell.org'+PACKAGE_URL=''++ac_unique_file="Data/Array/Accelerate/CUDA.hs"+ac_subst_vars='LTLIBOBJS+LIBOBJS+hs_int_type+GHC+OBJEXT+EXEEXT+ac_ct_CXX+CPPFLAGS+LDFLAGS+CXXFLAGS+CXX+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+'+ ac_precious_vars='build_alias+host_alias+target_alias+CXX+CXXFLAGS+LDFLAGS+LIBS+CPPFLAGS+CCC'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+ # If the previous option needs an argument, assign it.+ if test -n "$ac_prev"; then+ eval $ac_prev=\$ac_option+ ac_prev=+ continue+ fi++ case $ac_option in+ *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+ *) ac_optarg=yes ;;+ esac++ # Accept the important Cygnus configure options, so we can diagnose typos.++ case $ac_dashdash$ac_option in+ --)+ ac_dashdash=yes ;;++ -bindir | --bindir | --bindi | --bind | --bin | --bi)+ ac_prev=bindir ;;+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+ bindir=$ac_optarg ;;++ -build | --build | --buil | --bui | --bu)+ ac_prev=build_alias ;;+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)+ build_alias=$ac_optarg ;;++ -cache-file | --cache-file | --cache-fil | --cache-fi \+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+ ac_prev=cache_file ;;+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+ cache_file=$ac_optarg ;;++ --config-cache | -C)+ cache_file=config.cache ;;++ -datadir | --datadir | --datadi | --datad)+ ac_prev=datadir ;;+ -datadir=* | --datadir=* | --datadi=* | --datad=*)+ datadir=$ac_optarg ;;++ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+ | --dataroo | --dataro | --datar)+ ac_prev=datarootdir ;;+ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+ datarootdir=$ac_optarg ;;++ -disable-* | --disable-*)+ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+ # Reject names that are not valid shell variable names.+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+ as_fn_error "invalid feature name: $ac_useropt"+ ac_useropt_orig=$ac_useropt+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+ case $ac_user_opts in+ *"+"enable_$ac_useropt"+"*) ;;+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+ ac_unrecognized_sep=', ';;+ esac+ eval enable_$ac_useropt=no ;;++ -docdir | --docdir | --docdi | --doc | --do)+ ac_prev=docdir ;;+ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+ docdir=$ac_optarg ;;++ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+ ac_prev=dvidir ;;+ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+ dvidir=$ac_optarg ;;++ -enable-* | --enable-*)+ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+ # Reject names that are not valid shell variable names.+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+ as_fn_error "invalid feature name: $ac_useropt"+ ac_useropt_orig=$ac_useropt+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+ case $ac_user_opts in+ *"+"enable_$ac_useropt"+"*) ;;+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+ ac_unrecognized_sep=', ';;+ esac+ eval enable_$ac_useropt=\$ac_optarg ;;++ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+ | --exec | --exe | --ex)+ ac_prev=exec_prefix ;;+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+ | --exec=* | --exe=* | --ex=*)+ exec_prefix=$ac_optarg ;;++ -gas | --gas | --ga | --g)+ # Obsolete; use --with-gas.+ with_gas=yes ;;++ -help | --help | --hel | --he | -h)+ ac_init_help=long ;;+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+ ac_init_help=recursive ;;+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+ ac_init_help=short ;;++ -host | --host | --hos | --ho)+ ac_prev=host_alias ;;+ -host=* | --host=* | --hos=* | --ho=*)+ host_alias=$ac_optarg ;;++ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+ ac_prev=htmldir ;;+ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+ | --ht=*)+ htmldir=$ac_optarg ;;++ -includedir | --includedir | --includedi | --included | --include \+ | --includ | --inclu | --incl | --inc)+ ac_prev=includedir ;;+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+ | --includ=* | --inclu=* | --incl=* | --inc=*)+ includedir=$ac_optarg ;;++ -infodir | --infodir | --infodi | --infod | --info | --inf)+ ac_prev=infodir ;;+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+ infodir=$ac_optarg ;;++ -libdir | --libdir | --libdi | --libd)+ ac_prev=libdir ;;+ -libdir=* | --libdir=* | --libdi=* | --libd=*)+ libdir=$ac_optarg ;;++ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+ | --libexe | --libex | --libe)+ ac_prev=libexecdir ;;+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+ | --libexe=* | --libex=* | --libe=*)+ libexecdir=$ac_optarg ;;++ -localedir | --localedir | --localedi | --localed | --locale)+ ac_prev=localedir ;;+ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+ localedir=$ac_optarg ;;++ -localstatedir | --localstatedir | --localstatedi | --localstated \+ | --localstate | --localstat | --localsta | --localst | --locals)+ ac_prev=localstatedir ;;+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+ localstatedir=$ac_optarg ;;++ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+ ac_prev=mandir ;;+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+ mandir=$ac_optarg ;;++ -nfp | --nfp | --nf)+ # Obsolete; use --without-fp.+ with_fp=no ;;++ -no-create | --no-create | --no-creat | --no-crea | --no-cre \+ | --no-cr | --no-c | -n)+ no_create=yes ;;++ -no-recursion | --no-recursion | --no-recursio | --no-recursi \+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+ no_recursion=yes ;;++ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+ | --oldin | --oldi | --old | --ol | --o)+ ac_prev=oldincludedir ;;+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+ oldincludedir=$ac_optarg ;;++ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+ ac_prev=prefix ;;+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+ prefix=$ac_optarg ;;++ -program-prefix | --program-prefix | --program-prefi | --program-pref \+ | --program-pre | --program-pr | --program-p)+ ac_prev=program_prefix ;;+ -program-prefix=* | --program-prefix=* | --program-prefi=* \+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+ program_prefix=$ac_optarg ;;++ -program-suffix | --program-suffix | --program-suffi | --program-suff \+ | --program-suf | --program-su | --program-s)+ ac_prev=program_suffix ;;+ -program-suffix=* | --program-suffix=* | --program-suffi=* \+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+ program_suffix=$ac_optarg ;;++ -program-transform-name | --program-transform-name \+ | --program-transform-nam | --program-transform-na \+ | --program-transform-n | --program-transform- \+ | --program-transform | --program-transfor \+ | --program-transfo | --program-transf \+ | --program-trans | --program-tran \+ | --progr-tra | --program-tr | --program-t)+ ac_prev=program_transform_name ;;+ -program-transform-name=* | --program-transform-name=* \+ | --program-transform-nam=* | --program-transform-na=* \+ | --program-transform-n=* | --program-transform-=* \+ | --program-transform=* | --program-transfor=* \+ | --program-transfo=* | --program-transf=* \+ | --program-trans=* | --program-tran=* \+ | --progr-tra=* | --program-tr=* | --program-t=*)+ program_transform_name=$ac_optarg ;;++ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+ ac_prev=pdfdir ;;+ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+ pdfdir=$ac_optarg ;;++ -psdir | --psdir | --psdi | --psd | --ps)+ ac_prev=psdir ;;+ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+ psdir=$ac_optarg ;;++ -q | -quiet | --quiet | --quie | --qui | --qu | --q \+ | -silent | --silent | --silen | --sile | --sil)+ silent=yes ;;++ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+ ac_prev=sbindir ;;+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+ | --sbi=* | --sb=*)+ sbindir=$ac_optarg ;;++ -sharedstatedir | --sharedstatedir | --sharedstatedi \+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+ | --sharedst | --shareds | --shared | --share | --shar \+ | --sha | --sh)+ ac_prev=sharedstatedir ;;+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+ | --sha=* | --sh=*)+ sharedstatedir=$ac_optarg ;;++ -site | --site | --sit)+ ac_prev=site ;;+ -site=* | --site=* | --sit=*)+ site=$ac_optarg ;;++ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+ ac_prev=srcdir ;;+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+ srcdir=$ac_optarg ;;++ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+ | --syscon | --sysco | --sysc | --sys | --sy)+ ac_prev=sysconfdir ;;+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+ sysconfdir=$ac_optarg ;;++ -target | --target | --targe | --targ | --tar | --ta | --t)+ ac_prev=target_alias ;;+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+ target_alias=$ac_optarg ;;++ -v | -verbose | --verbose | --verbos | --verbo | --verb)+ verbose=yes ;;++ -version | --version | --versio | --versi | --vers | -V)+ ac_init_version=: ;;++ -with-* | --with-*)+ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+ # Reject names that are not valid shell variable names.+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+ as_fn_error "invalid package name: $ac_useropt"+ ac_useropt_orig=$ac_useropt+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+ case $ac_user_opts in+ *"+"with_$ac_useropt"+"*) ;;+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+ ac_unrecognized_sep=', ';;+ esac+ eval with_$ac_useropt=\$ac_optarg ;;++ -without-* | --without-*)+ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`+ # Reject names that are not valid shell variable names.+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+ as_fn_error "invalid package name: $ac_useropt"+ ac_useropt_orig=$ac_useropt+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+ case $ac_user_opts in+ *"+"with_$ac_useropt"+"*) ;;+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+ ac_unrecognized_sep=', ';;+ esac+ eval with_$ac_useropt=no ;;++ --x)+ # Obsolete; use --with-x.+ with_x=yes ;;++ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+ | --x-incl | --x-inc | --x-in | --x-i)+ ac_prev=x_includes ;;+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+ x_includes=$ac_optarg ;;++ -x-libraries | --x-libraries | --x-librarie | --x-librari \+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+ ac_prev=x_libraries ;;+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+ x_libraries=$ac_optarg ;;++ -*) as_fn_error "unrecognized option: \`$ac_option'+Try \`$0 --help' for more information."+ ;;++ *=*)+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+ # Reject names that are not valid shell variable names.+ case $ac_envvar in #(+ '' | [0-9]* | *[!_$as_cr_alnum]* )+ as_fn_error "invalid variable name: \`$ac_envvar'" ;;+ esac+ eval $ac_envvar=\$ac_optarg+ export $ac_envvar ;;++ *)+ # FIXME: should be removed in autoconf 3.0.+ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}+ ;;++ esac+done++if test -n "$ac_prev"; then+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`+ as_fn_error "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+ case $enable_option_checking in+ no) ;;+ fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;+ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+ esac+fi++# Check all directory arguments for consistency.+for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \+ datadir sysconfdir sharedstatedir localstatedir includedir \+ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+ libdir localedir mandir+do+ eval ac_val=\$$ac_var+ # Remove trailing slashes.+ case $ac_val in+ */ )+ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+ eval $ac_var=\$ac_val;;+ esac+ # Be sure to have absolute directory names.+ case $ac_val in+ [\\/$]* | ?:[\\/]* ) continue;;+ NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+ esac+ as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"+done++# There might be people who depend on the old broken behavior: `$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+ if test "x$build_alias" = x; then+ cross_compiling=maybe+ $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.+ If a cross compiler is detected then cross compile mode will be used." >&2+ elif test "x$build_alias" != "x$host_alias"; then+ cross_compiling=yes+ fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+ as_fn_error "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+ as_fn_error "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+ ac_srcdir_defaulted=yes+ # Try the directory containing this script, then the parent directory.+ ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+ X"$as_myself" : 'X\(//\)[^/]' \| \+ X"$as_myself" : 'X\(//\)$' \| \+ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_myself" |+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+ s//\1/+ q+ }+ /^X\(\/\/\)[^/].*/{+ s//\1/+ q+ }+ /^X\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`+ srcdir=$ac_confdir+ if test ! -r "$srcdir/$ac_unique_file"; then+ srcdir=..+ fi+else+ ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."+ as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"+fi+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_abs_confdir=`(+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"+ pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+ srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+ eval ac_env_${ac_var}_set=\${${ac_var}+set}+ eval ac_env_${ac_var}_value=\$${ac_var}+ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+ eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+ # Omit some internal or obsolete options to make the list less imposing.+ # This message is too long to be a string in the A/UX 3.1 sh.+ cat <<_ACEOF+\`configure' configures accelerate-cuda 0.9.0.0 to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE. See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+ -h, --help display this help and exit+ --help=short display options specific to this package+ --help=recursive display the short help of all the included packages+ -V, --version display version information and exit+ -q, --quiet, --silent do not print \`checking...' messages+ --cache-file=FILE cache test results in FILE [disabled]+ -C, --config-cache alias for \`--cache-file=config.cache'+ -n, --no-create do not create output files+ --srcdir=DIR find the sources in DIR [configure dir or \`..']++Installation directories:+ --prefix=PREFIX install architecture-independent files in PREFIX+ [$ac_default_prefix]+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX+ [PREFIX]++By default, \`make install' will install all the files in+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify+an installation prefix other than \`$ac_default_prefix' using \`--prefix',+for instance \`--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+ --bindir=DIR user executables [EPREFIX/bin]+ --sbindir=DIR system admin executables [EPREFIX/sbin]+ --libexecdir=DIR program executables [EPREFIX/libexec]+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]+ --libdir=DIR object code libraries [EPREFIX/lib]+ --includedir=DIR C header files [PREFIX/include]+ --oldincludedir=DIR C header files for non-gcc [/usr/include]+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]+ --infodir=DIR info documentation [DATAROOTDIR/info]+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]+ --mandir=DIR man documentation [DATAROOTDIR/man]+ --docdir=DIR documentation root [DATAROOTDIR/doc/accelerate-cuda]+ --htmldir=DIR html documentation [DOCDIR]+ --dvidir=DIR dvi documentation [DOCDIR]+ --pdfdir=DIR pdf documentation [DOCDIR]+ --psdir=DIR ps documentation [DOCDIR]+_ACEOF++ cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then+ case $ac_init_help in+ short | recursive ) echo "Configuration of accelerate-cuda 0.9.0.0:";;+ esac+ cat <<\_ACEOF++Some influential environment variables:+ CXX C++ compiler command+ CXXFLAGS C++ compiler flags+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a+ nonstandard directory <lib dir>+ LIBS libraries to pass to the linker, e.g. -l<library>+ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if+ you have headers in a nonstandard directory <include dir>++Use these variables to override the choices made by `configure' or to help+it to find libraries and programs with nonstandard names/locations.++Report bugs to <accelerate@projects.haskell.org>.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+ # If there are subdirs, report their specific --help.+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+ test -d "$ac_dir" ||+ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+ continue+ ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+ # A ".." for each directory in $ac_dir_suffix.+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+ case $ac_top_builddir_sub in+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;+ esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+ .) # We are building in place.+ ac_srcdir=.+ ac_top_srcdir=$ac_top_builddir_sub+ ac_abs_top_srcdir=$ac_pwd ;;+ [\\/]* | ?:[\\/]* ) # Absolute name.+ ac_srcdir=$srcdir$ac_dir_suffix;+ ac_top_srcdir=$srcdir+ ac_abs_top_srcdir=$srcdir ;;+ *) # Relative name.+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+ ac_top_srcdir=$ac_top_build_prefix$srcdir+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++ cd "$ac_dir" || { ac_status=$?; continue; }+ # Check for guested configure.+ if test -f "$ac_srcdir/configure.gnu"; then+ echo &&+ $SHELL "$ac_srcdir/configure.gnu" --help=recursive+ elif test -f "$ac_srcdir/configure"; then+ echo &&+ $SHELL "$ac_srcdir/configure" --help=recursive+ else+ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2+ fi || ac_status=$?+ cd "$ac_pwd" || { ac_status=$?; break; }+ done+fi++test -n "$ac_init_help" && exit $ac_status+if $ac_init_version; then+ cat <<\_ACEOF+accelerate-cuda configure 0.9.0.0+generated by GNU Autoconf 2.65++Copyright (C) 2009 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+ exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##++# ac_fn_cxx_try_compile LINENO+# ----------------------------+# Try to compile conftest.$ac_ext, and return whether this succeeded.+ac_fn_cxx_try_compile ()+{+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ rm -f conftest.$ac_objext+ if { { ac_try="$ac_compile"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_compile") 2>conftest.err+ ac_status=$?+ if test -s conftest.err; then+ grep -v '^ *+' conftest.err >conftest.er1+ cat conftest.er1 >&5+ mv -f conftest.er1 conftest.err+ fi+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; } && {+ test -z "$ac_cxx_werror_flag" ||+ test ! -s conftest.err+ } && test -s conftest.$ac_objext; then :+ ac_retval=0+else+ $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++ ac_retval=1+fi+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ as_fn_set_status $ac_retval++} # ac_fn_cxx_try_compile+cat >config.log <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by accelerate-cuda $as_me 0.9.0.0, which was+generated by GNU Autoconf 2.65. Invocation command line was++ $ $0 $@++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`++/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ $as_echo "PATH: $as_dir"+ done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+ for ac_arg+ do+ case $ac_arg in+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \+ | -silent | --silent | --silen | --sile | --sil)+ continue ;;+ *\'*)+ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+ esac+ case $ac_pass in+ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+ 2)+ as_fn_append ac_configure_args1 " '$ac_arg'"+ if test $ac_must_keep_next = true; then+ ac_must_keep_next=false # Got value, back to normal.+ else+ case $ac_arg in+ *=* | --config-cache | -C | -disable-* | --disable-* \+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+ | -with-* | --with-* | -without-* | --without-* | --x)+ case "$ac_configure_args0 " in+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+ esac+ ;;+ -* ) ac_must_keep_next=true ;;+ esac+ fi+ as_fn_append ac_configure_args " '$ac_arg'"+ ;;+ esac+ done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log. We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+ # Save into config.log some information that might help in debugging.+ {+ echo++ cat <<\_ASBOX+## ---------------- ##+## Cache variables. ##+## ---------------- ##+_ASBOX+ echo+ # The following way of writing the cache mishandles newlines in values,+(+ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+ eval ac_val=\$$ac_var+ case $ac_val in #(+ *${as_nl}*)+ case $ac_var in #(+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+ esac+ case $ac_var in #(+ _ | IFS | as_nl) ;; #(+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+ *) { eval $ac_var=; unset $ac_var;} ;;+ esac ;;+ esac+ done+ (set) 2>&1 |+ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+ *${as_nl}ac_space=\ *)+ sed -n \+ "s/'\''/'\''\\\\'\'''\''/g;+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+ ;; #(+ *)+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+ ;;+ esac |+ sort+)+ echo++ cat <<\_ASBOX+## ----------------- ##+## Output variables. ##+## ----------------- ##+_ASBOX+ echo+ for ac_var in $ac_subst_vars+ do+ eval ac_val=\$$ac_var+ case $ac_val in+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+ esac+ $as_echo "$ac_var='\''$ac_val'\''"+ done | sort+ echo++ if test -n "$ac_subst_files"; then+ cat <<\_ASBOX+## ------------------- ##+## File substitutions. ##+## ------------------- ##+_ASBOX+ echo+ for ac_var in $ac_subst_files+ do+ eval ac_val=\$$ac_var+ case $ac_val in+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+ esac+ $as_echo "$ac_var='\''$ac_val'\''"+ done | sort+ echo+ fi++ if test -s confdefs.h; then+ cat <<\_ASBOX+## ----------- ##+## confdefs.h. ##+## ----------- ##+_ASBOX+ echo+ cat confdefs.h+ echo+ fi+ test "$ac_signal" != 0 &&+ $as_echo "$as_me: caught signal $ac_signal"+ $as_echo "$as_me: exit $exit_status"+ } >&5+ rm -f core *.core core.conftest.* &&+ rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+ exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++$as_echo "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++cat >>confdefs.h <<_ACEOF+#define PACKAGE_NAME "$PACKAGE_NAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_VERSION "$PACKAGE_VERSION"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_STRING "$PACKAGE_STRING"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_URL "$PACKAGE_URL"+_ACEOF+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+ac_site_file1=NONE+ac_site_file2=NONE+if test -n "$CONFIG_SITE"; then+ ac_site_file1=$CONFIG_SITE+elif test "x$prefix" != xNONE; then+ ac_site_file1=$prefix/share/config.site+ ac_site_file2=$prefix/etc/config.site+else+ ac_site_file1=$ac_default_prefix/share/config.site+ ac_site_file2=$ac_default_prefix/etc/config.site+fi+for ac_site_file in "$ac_site_file1" "$ac_site_file2"+do+ test "x$ac_site_file" = xNONE && continue+ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+$as_echo "$as_me: loading site script $ac_site_file" >&6;}+ sed 's/^/| /' "$ac_site_file" >&5+ . "$ac_site_file"+ fi+done++if test -r "$cache_file"; then+ # Some versions of bash will fail to source /dev/null (special files+ # actually), so we avoid doing that. DJGPP emulates it as a regular file.+ if test /dev/null != "$cache_file" && test -f "$cache_file"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+$as_echo "$as_me: loading cache $cache_file" >&6;}+ case $cache_file in+ [\\/]* | ?:[\\/]* ) . "$cache_file";;+ *) . "./$cache_file";;+ esac+ fi+else+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+$as_echo "$as_me: creating cache $cache_file" >&6;}+ >$cache_file+fi++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+ eval ac_old_set=\$ac_cv_env_${ac_var}_set+ eval ac_new_set=\$ac_env_${ac_var}_set+ eval ac_old_val=\$ac_cv_env_${ac_var}_value+ eval ac_new_val=\$ac_env_${ac_var}_value+ case $ac_old_set,$ac_new_set in+ set,)+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+ ac_cache_corrupted=: ;;+ ,set)+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+ ac_cache_corrupted=: ;;+ ,);;+ *)+ if test "x$ac_old_val" != "x$ac_new_val"; then+ # differences in whitespace do not lead to failure.+ ac_old_val_w=`echo x $ac_old_val`+ ac_new_val_w=`echo x $ac_new_val`+ if test "$ac_old_val_w" != "$ac_new_val_w"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+ ac_cache_corrupted=:+ else+ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+ eval $ac_var=\$ac_old_val+ fi+ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5+$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}+ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5+$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}+ fi;;+ esac+ # Pass precious variables to config.status.+ if test "$ac_new_set" = set; then+ case $ac_new_val in+ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+ *) ac_arg=$ac_var=$ac_new_val ;;+ esac+ case " $ac_configure_args " in+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.+ *) as_fn_append ac_configure_args " '$ac_arg'" ;;+ esac+ fi+done+if $ac_cache_corrupted; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}+ as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++ac_config_files="$ac_config_files cubits/accelerate_cuda_shape.h"+++# This doesn't pick up a user specified '--with-compiler' flag+#+ac_ext=cpp+ac_cpp='$CXXCPP $CPPFLAGS'+ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_cxx_compiler_gnu+if test -z "$CXX"; then+ if test -n "$CCC"; then+ CXX=$CCC+ else+ if test -n "$ac_tool_prefix"; then+ for ac_prog in nvcc+ do+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_CXX+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ if test -n "$CXX"; then+ ac_cv_prog_CXX="$CXX" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ for ac_exec_ext in '' $ac_executable_extensions; do+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ ac_cv_prog_CXX="$ac_tool_prefix$ac_prog"+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+ break 2+ fi+done+ done+IFS=$as_save_IFS++fi+fi+CXX=$ac_cv_prog_CXX+if test -n "$CXX"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5+$as_echo "$CXX" >&6; }+else+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++ test -n "$CXX" && break+ done+fi+if test -z "$CXX"; then+ ac_ct_CXX=$CXX+ for ac_prog in nvcc+do+ # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ if test -n "$ac_ct_CXX"; then+ ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ for ac_exec_ext in '' $ac_executable_extensions; do+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ ac_cv_prog_ac_ct_CXX="$ac_prog"+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+ break 2+ fi+done+ done+IFS=$as_save_IFS++fi+fi+ac_ct_CXX=$ac_cv_prog_ac_ct_CXX+if test -n "$ac_ct_CXX"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CXX" >&5+$as_echo "$ac_ct_CXX" >&6; }+else+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++ test -n "$ac_ct_CXX" && break+done++ if test "x$ac_ct_CXX" = x; then+ CXX="g++"+ else+ case $cross_compiling:$ac_tool_warned in+yes:)+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+ CXX=$ac_ct_CXX+ fi+fi++ fi+fi+# Provide some information about the compiler.+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler version" >&5+set X $ac_compile+ac_compiler=$2+for ac_option in --version -v -V -qversion; do+ { { ac_try="$ac_compiler $ac_option >&5"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err+ ac_status=$?+ if test -s conftest.err; then+ sed '10a\+... rest of stderr output deleted ...+ 10q' conftest.err >conftest.er1+ cat conftest.er1 >&5+ fi+ rm -f conftest.er1 conftest.err+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }+done++cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{++ ;+ return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C++ compiler works" >&5+$as_echo_n "checking whether the C++ compiler works... " >&6; }+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`++# The possible output files:+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"++ac_rmfiles=+for ac_file in $ac_files+do+ case $ac_file in+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+ * ) ac_rmfiles="$ac_rmfiles $ac_file";;+ esac+done+rm -f $ac_rmfiles++if { { ac_try="$ac_link_default"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_link_default") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }; then :+ # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'+# in a Makefile. We should not override ac_cv_exeext if it was cached,+# so that the user can short-circuit this test for compilers unknown to+# Autoconf.+for ac_file in $ac_files ''+do+ test -f "$ac_file" || continue+ case $ac_file in+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )+ ;;+ [ab].out )+ # We found the default executable, but exeext='' is most+ # certainly right.+ break;;+ *.* )+ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;+ then :; else+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+ fi+ # We set ac_cv_exeext here because the later test for it is not+ # safe: cross compilers may not add the suffix if given an `-o'+ # argument, so we may need to know it at that point already.+ # Even if this section looks crufty: it has the advantage of+ # actually working.+ break;;+ * )+ break;;+ esac+done+test "$ac_cv_exeext" = no && ac_cv_exeext=++else+ ac_file=''+fi+if test -z "$ac_file"; then :+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+$as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+{ as_fn_set_status 77+as_fn_error "C++ compiler cannot create executables+See \`config.log' for more details." "$LINENO" 5; }; }+else+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5+$as_echo "yes" >&6; }+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler default output file name" >&5+$as_echo_n "checking for C++ compiler default output file name... " >&6; }+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5+$as_echo "$ac_file" >&6; }+ac_exeext=$ac_cv_exeext++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5+$as_echo_n "checking for suffix of executables... " >&6; }+if { { ac_try="$ac_link"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_link") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }; then :+ # If both `conftest.exe' and `conftest' are `present' (well, observable)+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will+# work properly (i.e., refer to `conftest.exe'), while it won't with+# `rm'.+for ac_file in conftest.exe conftest conftest.*; do+ test -f "$ac_file" || continue+ case $ac_file in+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+ break;;+ * ) break;;+ esac+done+else+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error "cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details." "$LINENO" 5; }+fi+rm -f conftest conftest$ac_cv_exeext+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5+$as_echo "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */+#include <stdio.h>+int+main ()+{+FILE *f = fopen ("conftest.out", "w");+ return ferror (f) || fclose (f) != 0;++ ;+ return 0;+}+_ACEOF+ac_clean_files="$ac_clean_files conftest.out"+# Check that the compiler produces executables we can run. If not, either+# the compiler is broken, or we cross compile.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5+$as_echo_n "checking whether we are cross compiling... " >&6; }+if test "$cross_compiling" != yes; then+ { { ac_try="$ac_link"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_link") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }+ if { ac_try='./conftest$ac_cv_exeext'+ { { case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_try") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }; }; then+ cross_compiling=no+ else+ if test "$cross_compiling" = maybe; then+ cross_compiling=yes+ else+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error "cannot run C++ compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details." "$LINENO" 5; }+ fi+ fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5+$as_echo "$cross_compiling" >&6; }++rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5+$as_echo_n "checking for suffix of object files... " >&6; }+if test "${ac_cv_objext+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{++ ;+ return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { { ac_try="$ac_compile"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_compile") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }; then :+ for ac_file in conftest.o conftest.obj conftest.*; do+ test -f "$ac_file" || continue;+ case $ac_file in+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+ break;;+ esac+done+else+ $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error "cannot compute suffix of object files: cannot compile+See \`config.log' for more details." "$LINENO" 5; }+fi+rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5+$as_echo "$ac_cv_objext" >&6; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5+$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; }+if test "${ac_cv_cxx_compiler_gnu+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{+#ifndef __GNUC__+ choke me+#endif++ ;+ return 0;+}+_ACEOF+if ac_fn_cxx_try_compile "$LINENO"; then :+ ac_compiler_gnu=yes+else+ ac_compiler_gnu=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+ac_cv_cxx_compiler_gnu=$ac_compiler_gnu++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cxx_compiler_gnu" >&5+$as_echo "$ac_cv_cxx_compiler_gnu" >&6; }+if test $ac_compiler_gnu = yes; then+ GXX=yes+else+ GXX=+fi+ac_test_CXXFLAGS=${CXXFLAGS+set}+ac_save_CXXFLAGS=$CXXFLAGS+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5+$as_echo_n "checking whether $CXX accepts -g... " >&6; }+if test "${ac_cv_prog_cxx_g+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ ac_save_cxx_werror_flag=$ac_cxx_werror_flag+ ac_cxx_werror_flag=yes+ ac_cv_prog_cxx_g=no+ CXXFLAGS="-g"+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{++ ;+ return 0;+}+_ACEOF+if ac_fn_cxx_try_compile "$LINENO"; then :+ ac_cv_prog_cxx_g=yes+else+ CXXFLAGS=""+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{++ ;+ return 0;+}+_ACEOF+if ac_fn_cxx_try_compile "$LINENO"; then :++else+ ac_cxx_werror_flag=$ac_save_cxx_werror_flag+ CXXFLAGS="-g"+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++int+main ()+{++ ;+ return 0;+}+_ACEOF+if ac_fn_cxx_try_compile "$LINENO"; then :+ ac_cv_prog_cxx_g=yes+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+ ac_cxx_werror_flag=$ac_save_cxx_werror_flag+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_g" >&5+$as_echo "$ac_cv_prog_cxx_g" >&6; }+if test "$ac_test_CXXFLAGS" = set; then+ CXXFLAGS=$ac_save_CXXFLAGS+elif test $ac_cv_prog_cxx_g = yes; then+ if test "$GXX" = yes; then+ CXXFLAGS="-g -O2"+ else+ CXXFLAGS="-g"+ fi+else+ if test "$GXX" = yes; then+ CXXFLAGS="-O2"+ else+ CXXFLAGS=+ fi+fi+ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++# Extract the first word of "ghc", so it can be a program name with args.+set dummy ghc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_path_GHC+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ case $GHC in+ [\\/]* | ?:[\\/]*)+ ac_cv_path_GHC="$GHC" # Let the user override the test with a path.+ ;;+ *)+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ for ac_exec_ext in '' $ac_executable_extensions; do+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ ac_cv_path_GHC="$as_dir/$ac_word$ac_exec_ext"+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+ break 2+ fi+done+ done+IFS=$as_save_IFS++ ;;+esac+fi+GHC=$ac_cv_path_GHC+if test -n "$GHC"; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GHC" >&5+$as_echo "$GHC" >&6; }+else+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of Int" >&5+$as_echo_n "checking size of Int... " >&6; }++hs_int_size=`$GHC -w -ignore-dot-ghci -e "Foreign.sizeOf (undefined::Int)"`+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hs_int_size" >&5+$as_echo "$hs_int_size" >&6; }++case $hs_int_size in+ 4) hs_int_type=int32_t ;;+ 8) hs_int_type=int64_t ;;+ *) as_fn_error "could not determine size of a Haskell Int" "$LINENO" 5+esac+++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems. If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# `ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* `ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+ eval ac_val=\$$ac_var+ case $ac_val in #(+ *${as_nl}*)+ case $ac_var in #(+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+ esac+ case $ac_var in #(+ _ | IFS | as_nl) ;; #(+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+ *) { eval $ac_var=; unset $ac_var;} ;;+ esac ;;+ esac+ done++ (set) 2>&1 |+ case $as_nl`(ac_space=' '; set) 2>&1` in #(+ *${as_nl}ac_space=\ *)+ # `set' does not quote correctly, so add quotes: double-quote+ # substitution turns \\\\ into \\, and sed turns \\ into \.+ sed -n \+ "s/'/'\\\\''/g;+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+ ;; #(+ *)+ # `set' quotes correctly as required by POSIX, so do not add quotes.+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+ ;;+ esac |+ sort+) |+ sed '+ /^ac_cv_env_/b end+ t clear+ :clear+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/+ t end+ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+ :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+ if test -w "$cache_file"; then+ test "x$cache_file" != "x/dev/null" &&+ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+$as_echo "$as_me: updating cache $cache_file" >&6;}+ cat confcache >$cache_file+ else+ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}+ fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++# Transform confdefs.h into DEFS.+# Protect against shell expansion while executing Makefile rules.+# Protect against Makefile macro expansion.+#+# If the first sed substitution is executed (which looks for macros that+# take arguments), then branch to the quote section. Otherwise,+# look for a macro that doesn't take arguments.+ac_script='+:mline+/\\$/{+ N+ s,\\\n,,+ b mline+}+t clear+:clear+s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g+t quote+s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g+t quote+b any+:quote+s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g+s/\[/\\&/g+s/\]/\\&/g+s/\$/$$/g+H+:any+${+ g+ s/^\n//+ s/\n/ /g+ p+}+'+DEFS=`sed -n "$ac_script" confdefs.h`+++ac_libobjs=+ac_ltlibobjs=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+ # 1. Remove the extension, and $U if already installed.+ ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+ ac_i=`$as_echo "$ac_i" | sed "$ac_script"`+ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR+ # will be set to the directory where LIBOBJS objects are built.+ as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+ as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: ${CONFIG_STATUS=./config.status}+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+ emulate sh+ NULLCMD=:+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+ # is contrary to our usage. Disable this feature.+ alias -g '${1+"$@"}'='"$@"'+ setopt NO_GLOB_SUBST+else+ case `(set -o) 2>/dev/null` in #(+ *posix*) :+ set -o posix ;; #(+ *) :+ ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+ as_echo='print -r --'+ as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+ as_echo='printf %s\n'+ as_echo_n='printf %s'+else+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+ as_echo_n='/usr/ucb/echo -n'+ else+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+ as_echo_n_body='eval+ arg=$1;+ case $arg in #(+ *"$as_nl"*)+ expr "X$arg" : "X\\(.*\\)$as_nl";+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+ esac;+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+ '+ export as_echo_n_body+ as_echo_n='sh -c $as_echo_n_body as_echo'+ fi+ export as_echo_body+ as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+ PATH_SEPARATOR=:+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+ PATH_SEPARATOR=';'+ }+fi+++# IFS+# We need space, tab and new line, in precisely that order. Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" "" $as_nl"++# Find who we are. Look in the path if we contain no directory separator.+case $0 in #((+ *[\\/]* ) as_myself=$0 ;;+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+ IFS=$as_save_IFS+ test -z "$as_dir" && as_dir=.+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+ done+IFS=$as_save_IFS++ ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+ as_myself=$0+fi+if test ! -f "$as_myself"; then+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+ exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there. '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH+++# as_fn_error ERROR [LINENO LOG_FD]+# ---------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with status $?, using 1 if that was 0.+as_fn_error ()+{+ as_status=$?; test $as_status -eq 0 && as_status=1+ if test "$3"; then+ as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3+ fi+ $as_echo "$as_me: error: $1" >&2+ as_fn_exit $as_status+} # as_fn_error+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+ return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+ set +e+ as_fn_set_status $1+ exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+ { eval $1=; unset $1;}+}+as_unset=as_fn_unset+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+ eval 'as_fn_append ()+ {+ eval $1+=\$2+ }'+else+ as_fn_append ()+ {+ eval $1=\$$1\$2+ }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+ eval 'as_fn_arith ()+ {+ as_val=$(( $* ))+ }'+else+ as_fn_arith ()+ {+ as_val=`expr "$@" || test $? -eq 1`+ }+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+ test "X`expr 00001 : '.*\(...\)'`" = X001; then+ as_expr=expr+else+ as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+ as_basename=basename+else+ as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+ as_dirname=dirname+else+ as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+ X"$0" : 'X\(//\)$' \| \+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+ sed '/^.*\/\([^/][^/]*\)\/*$/{+ s//\1/+ q+ }+ /^X\/\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\/\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+ case `echo 'xy\c'` in+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.+ xy) ECHO_C='\c';;+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null+ ECHO_T=' ';;+ esac;;+*)+ ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+ rm -f conf$$.dir/conf$$.file+else+ rm -f conf$$.dir+ mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+ if ln -s conf$$.file conf$$ 2>/dev/null; then+ as_ln_s='ln -s'+ # ... but there are two gotchas:+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+ # In both cases, we have to default to `cp -p'.+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+ as_ln_s='cp -p'+ elif ln conf$$.file conf$$ 2>/dev/null; then+ as_ln_s=ln+ else+ as_ln_s='cp -p'+ fi+else+ as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++ case $as_dir in #(+ -*) as_dir=./$as_dir;;+ esac+ test -d "$as_dir" || eval $as_mkdir_p || {+ as_dirs=+ while :; do+ case $as_dir in #(+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+ *) as_qdir=$as_dir;;+ esac+ as_dirs="'$as_qdir' $as_dirs"+ as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+ X"$as_dir" : 'X\(//\)[^/]' \| \+ X"$as_dir" : 'X\(//\)$' \| \+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+ s//\1/+ q+ }+ /^X\(\/\/\)[^/].*/{+ s//\1/+ q+ }+ /^X\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`+ test -d "$as_dir" && break+ done+ test -z "$as_dirs" || eval "mkdir $as_dirs"+ } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+ as_mkdir_p='mkdir -p "$as_dir"'+else+ test -d ./-p && rmdir ./-p+ as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+ as_test_x='test -x'+else+ if ls -dL / >/dev/null 2>&1; then+ as_ls_L_option=L+ else+ as_ls_L_option=+ fi+ as_test_x='+ eval sh -c '\''+ if test -d "$1"; then+ test -d "$1/.";+ else+ case $1 in #(+ -*)set "./$1";;+ esac;+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+ ???[sx]*):;;*)false;;esac;fi+ '\'' sh+ '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.+ac_log="+This file was extended by accelerate-cuda $as_me 0.9.0.0, which was+generated by GNU Autoconf 2.65. Invocation command line was++ CONFIG_FILES = $CONFIG_FILES+ CONFIG_HEADERS = $CONFIG_HEADERS+ CONFIG_LINKS = $CONFIG_LINKS+ CONFIG_COMMANDS = $CONFIG_COMMANDS+ $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF++case $ac_config_files in *"+"*) set x $ac_config_files; shift; ac_config_files=$*;;+esac++++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_files="$ac_config_files"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+\`$as_me' instantiates files and other configuration actions+from templates according to the current configuration. Unless the files+and actions are specified as TAGs, all are instantiated by default.++Usage: $0 [OPTION]... [TAG]...++ -h, --help print this help, then exit+ -V, --version print version number and configuration settings, then exit+ --config print configuration, then exit+ -q, --quiet, --silent+ do not print progress messages+ -d, --debug don't remove temporary files+ --recheck update $as_me by reconfiguring in the same conditions+ --file=FILE[:TEMPLATE]+ instantiate the configuration file FILE++Configuration files:+$config_files++Report bugs to <accelerate@projects.haskell.org>."++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"+ac_cs_version="\\+accelerate-cuda config.status 0.9.0.0+configured by $0, generated by GNU Autoconf 2.65,+ with options \\"\$ac_cs_config\\"++Copyright (C) 2009 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+ case $1 in+ --*=*)+ ac_option=`expr "X$1" : 'X\([^=]*\)='`+ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+ ac_shift=:+ ;;+ *)+ ac_option=$1+ ac_optarg=$2+ ac_shift=shift+ ;;+ esac++ case $ac_option in+ # Handling of the options.+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+ ac_cs_recheck=: ;;+ --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+ $as_echo "$ac_cs_version"; exit ;;+ --config | --confi | --conf | --con | --co | --c )+ $as_echo "$ac_cs_config"; exit ;;+ --debug | --debu | --deb | --de | --d | -d )+ debug=: ;;+ --file | --fil | --fi | --f )+ $ac_shift+ case $ac_optarg in+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+ esac+ as_fn_append CONFIG_FILES " '$ac_optarg'"+ ac_need_defaults=false;;+ --he | --h | --help | --hel | -h )+ $as_echo "$ac_cs_usage"; exit ;;+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \+ | -silent | --silent | --silen | --sile | --sil | --si | --s)+ ac_cs_silent=: ;;++ # This is an error.+ -*) as_fn_error "unrecognized option: \`$1'+Try \`$0 --help' for more information." ;;++ *) as_fn_append ac_config_targets " $1"+ ac_need_defaults=false ;;++ esac+ shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+ exec 6>/dev/null+ ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+ set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+ shift+ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6+ CONFIG_SHELL='$SHELL'+ export CONFIG_SHELL+ exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+ echo+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+ $as_echo "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+ case $ac_config_target in+ "cubits/accelerate_cuda_shape.h") CONFIG_FILES="$CONFIG_FILES cubits/accelerate_cuda_shape.h" ;;++ *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+ esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used. Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files+fi++# Have a temporary directory for convenience. Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Hook for its removal unless debugging.+# Note that there is a small window in which the directory will not be cleaned:+# after its creation but before its name has been assigned to `$tmp'.+$debug ||+{+ tmp=+ trap 'exit_status=$?+ { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status+' 0+ trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+ test -n "$tmp" && test -d "$tmp"+} ||+{+ tmp=./conf$$-$RANDOM+ (umask 077 && mkdir "$tmp")+} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5++# Set up the scripts for CONFIG_FILES section.+# No need to generate them if there are no CONFIG_FILES.+# This happens for instance with `./config.status config.h'.+if test -n "$CONFIG_FILES"; then+++ac_cr=`echo X | tr X '\015'`+# On cygwin, bash can eat \r inside `` if the user requested igncr.+# But we know of no other shell where ac_cr would be empty at this+# point, so we can use a bashism as a fallback.+if test "x$ac_cr" = x; then+ eval ac_cr=\$\'\\r\'+fi+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then+ ac_cs_awk_cr='\r'+else+ ac_cs_awk_cr=$ac_cr+fi++echo 'BEGIN {' >"$tmp/subs1.awk" &&+_ACEOF+++{+ echo "cat >conf$$subs.awk <<_ACEOF" &&+ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&+ echo "_ACEOF"+} >conf$$subs.sh ||+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5+ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`+ac_delim='%!_!# '+for ac_last_try in false false false false false :; do+ . ./conf$$subs.sh ||+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5++ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`+ if test $ac_delim_n = $ac_delim_num; then+ break+ elif $ac_last_try; then+ as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5+ else+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+ fi+done+rm -f conf$$subs.sh++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&+_ACEOF+sed -n '+h+s/^/S["/; s/!.*/"]=/+p+g+s/^[^!]*!//+:repl+t repl+s/'"$ac_delim"'$//+t delim+:nl+h+s/\(.\{148\}\)..*/\1/+t more1+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/+p+n+b repl+:more1+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t nl+:delim+h+s/\(.\{148\}\)..*/\1/+t more2+s/["\\]/\\&/g; s/^/"/; s/$/"/+p+b+:more2+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t delim+' <conf$$subs.awk | sed '+/^[^""]/{+ N+ s/\n//+}+' >>$CONFIG_STATUS || ac_write_fail=1+rm -f conf$$subs.awk+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACAWK+cat >>"\$tmp/subs1.awk" <<_ACAWK &&+ for (key in S) S_is_set[key] = 1+ FS = ""++}+{+ line = $ 0+ nfields = split(line, field, "@")+ substed = 0+ len = length(field[1])+ for (i = 2; i < nfields; i++) {+ key = field[i]+ keylen = length(key)+ if (S_is_set[key]) {+ value = S[key]+ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)+ len += length(value) + length(field[++i])+ substed = 1+ } else+ len += 1 + keylen+ }++ print line+}++_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then+ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"+else+ cat+fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \+ || as_fn_error "could not setup config files machinery" "$LINENO" 5+_ACEOF++# VPATH may cause trouble with some makes, so we remove $(srcdir),+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+ ac_vpsub='/^[ ]*VPATH[ ]*=/{+s/:*\$(srcdir):*/:/+s/:*\${srcdir}:*/:/+s/:*@srcdir@:*/:/+s/^\([^=]*=[ ]*\):*/\1/+s/:*$//+s/^[^=]*=[ ]*$//+}'+fi++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+fi # test -n "$CONFIG_FILES"+++eval set X " :F $CONFIG_FILES "+shift+for ac_tag+do+ case $ac_tag in+ :[FHLC]) ac_mode=$ac_tag; continue;;+ esac+ case $ac_mode$ac_tag in+ :[FHL]*:*);;+ :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;+ :[FH]-) ac_tag=-:-;;+ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+ esac+ ac_save_IFS=$IFS+ IFS=:+ set x $ac_tag+ IFS=$ac_save_IFS+ shift+ ac_file=$1+ shift++ case $ac_mode in+ :L) ac_source=$1;;+ :[FH])+ ac_file_inputs=+ for ac_f+ do+ case $ac_f in+ -) ac_f="$tmp/stdin";;+ *) # Look for the file first in the build tree, then in the source tree+ # (if the path is not absolute). The absolute path cannot be DOS-style,+ # because $ac_f cannot contain `:'.+ test -f "$ac_f" ||+ case $ac_f in+ [\\/$]*) false;;+ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;+ esac ||+ as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;+ esac+ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+ as_fn_append ac_file_inputs " '$ac_f'"+ done++ # Let's still pretend it is `configure' which instantiates (i.e., don't+ # use $as_me), people would be surprised to read:+ # /* config.h. Generated by config.status. */+ configure_input='Generated from '`+ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+ `' by configure.'+ if test x"$ac_file" != x-; then+ configure_input="$ac_file. $configure_input"+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+$as_echo "$as_me: creating $ac_file" >&6;}+ fi+ # Neutralize special characters interpreted by sed in replacement strings.+ case $configure_input in #(+ *\&* | *\|* | *\\* )+ ac_sed_conf_input=`$as_echo "$configure_input" |+ sed 's/[\\\\&|]/\\\\&/g'`;; #(+ *) ac_sed_conf_input=$configure_input;;+ esac++ case $ac_tag in+ *:-:* | *:-) cat >"$tmp/stdin" \+ || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;+ esac+ ;;+ esac++ ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+ X"$ac_file" : 'X\(//\)[^/]' \| \+ X"$ac_file" : 'X\(//\)$' \| \+ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$ac_file" |+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+ s//\1/+ q+ }+ /^X\(\/\/\)[^/].*/{+ s//\1/+ q+ }+ /^X\(\/\/\)$/{+ s//\1/+ q+ }+ /^X\(\/\).*/{+ s//\1/+ q+ }+ s/.*/./; q'`+ as_dir="$ac_dir"; as_fn_mkdir_p+ ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+ # A ".." for each directory in $ac_dir_suffix.+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+ case $ac_top_builddir_sub in+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;+ esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+ .) # We are building in place.+ ac_srcdir=.+ ac_top_srcdir=$ac_top_builddir_sub+ ac_abs_top_srcdir=$ac_pwd ;;+ [\\/]* | ?:[\\/]* ) # Absolute name.+ ac_srcdir=$srcdir$ac_dir_suffix;+ ac_top_srcdir=$srcdir+ ac_abs_top_srcdir=$srcdir ;;+ *) # Relative name.+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+ ac_top_srcdir=$ac_top_build_prefix$srcdir+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++ case $ac_mode in+ :F)+ #+ # CONFIG_FILE+ #++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# If the template does not know about datarootdir, expand it.+# FIXME: This hack should be removed a few years after 2.60.+ac_datarootdir_hack=; ac_datarootdir_seen=+ac_sed_dataroot='+/datarootdir/ {+ p+ q+}+/@datadir@/p+/@docdir@/p+/@infodir@/p+/@localedir@/p+/@mandir@/p'+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in+*datarootdir*) ac_datarootdir_seen=yes;;+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ ac_datarootdir_hack='+ s&@datadir@&$datadir&g+ s&@docdir@&$docdir&g+ s&@infodir@&$infodir&g+ s&@localedir@&$localedir&g+ s&@mandir@&$mandir&g+ s&\\\${datarootdir}&$datarootdir&g' ;;+esac+_ACEOF++# Neutralize VPATH when `$srcdir' = `.'.+# Shell code in configure.ac might set extrasub.+# FIXME: do we really want to maintain this feature?+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_sed_extra="$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s|@configure_input@|$ac_sed_conf_input|;t t+s&@top_builddir@&$ac_top_builddir_sub&;t t+s&@top_build_prefix@&$ac_top_build_prefix&;t t+s&@srcdir@&$ac_srcdir&;t t+s&@abs_srcdir@&$ac_abs_srcdir&;t t+s&@top_srcdir@&$ac_top_srcdir&;t t+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t+s&@builddir@&$ac_builddir&;t t+s&@abs_builddir@&$ac_abs_builddir&;t t+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t+$ac_datarootdir_hack+"+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \+ || as_fn_error "could not create $ac_file" "$LINENO" 5++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+ { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined. Please make sure it is defined." >&5+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined. Please make sure it is defined." >&2;}++ rm -f "$tmp/stdin"+ case $ac_file in+ -) cat "$tmp/out" && rm -f "$tmp/out";;+ *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;+ esac \+ || as_fn_error "could not create $ac_file" "$LINENO" 5+ ;;++++ esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+ as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded. So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status. When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+ ac_cs_success=:+ ac_config_status_args=+ test "$silent" = yes &&+ ac_config_status_args="$ac_config_status_args --quiet"+ exec 5>/dev/null+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+ exec 5>>config.log+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which+ # would make configure fail if this is the last instruction.+ $ac_cs_success || as_fn_exit $?+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi++
+ cubits/accelerate_cuda_extras.h view
@@ -0,0 +1,22 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Extras+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_EXTRAS_H__+#define __ACCELERATE_CUDA_EXTRAS_H__++#include "accelerate_cuda_function.h"+#include "accelerate_cuda_shape.h"+#include "accelerate_cuda_stencil.h"+#include "accelerate_cuda_texture.h"++#endif+
+ cubits/accelerate_cuda_function.h view
@@ -0,0 +1,209 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Function+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_FUNCTION_H__+#define __ACCELERATE_CUDA_FUNCTION_H__++#include <stdint.h>+#include <cuda_runtime.h>++#ifdef __cplusplus++/* -----------------------------------------------------------------------------+ * Device functions required to support generated code+ * -------------------------------------------------------------------------- */++/*+ * Left/Right bitwise rotation+ */+template <typename T>+static __inline__ __device__ T rotateL(const T x, const int32_t i)+{+ const int32_t i8 = i & 8 * sizeof(x) - 1;+ return i8 == 0 ? x : x << i8 | x >> 8 * sizeof(x) - i8;+}++template <typename T>+static __inline__ __device__ T rotateR(const T x, const int32_t i)+{+ const int32_t i8 = i & 8 * sizeof(x) - 1;+ return i8 == 0 ? x : x >> i8 | x << 8 * sizeof(x) - i8;+}++/*+ * Integer division, truncated towards negative infinity+ */+template <typename T>+static __inline__ __device__ T idiv(const T x, const T y)+{+ return x > 0 && y < 0 ? (x - y - 1) / y : (x < 0 && y > 0 ? (x - y + 1) / y : x / y);+}++/*+ * Integer modulus, Haskell style+ */+template <typename T>+static __inline__ __device__ T mod(const T x, const T y)+{+ const T r = x % y;+ return x > 0 && y < 0 || x < 0 && y > 0 ? (r != 0 ? r + y : 0) : r;+}+++/*+ * Type coercion+ */+template <typename T>+static __inline__ __device__ uint32_t reinterpret32(const T x)+{+ union { T a; uint32_t b; } u;++ u.a = x;+ return u.b;+}++template <>+static __inline__ __device__ uint32_t reinterpret32(const float x)+{+ return __float_as_int(x);+}++template <typename T>+static __inline__ __device__ uint64_t reinterpret64(const T x)+{+ union { T a; uint64_t b; } u;++ u.a = x;+ return u.b;+}++#if !defined(__CUDA_ARCH__) || __CUDA_ARCH__ >= 130+template <>+static __inline__ __device__ uint64_t reinterpret64(const double x)+{+ return __double_as_longlong(x);+}+#endif+++/*+ * Atomic compare-and-swap, with type coercion+ */+template <typename T>+static __inline__ __device__ T atomicCAS32(T* address, T compare, T val)+{+ union { T a; uint32_t b; } u;++ u.b = atomicCAS((uint32_t*) address, reinterpret32<T>(compare), reinterpret32<T>(val));+ return u.a;+}++template <>+static __inline__ __device__ int32_t atomicCAS32(int32_t* address, int32_t compare, int32_t val)+{+ return atomicCAS(address, compare, val);+}++template <>+static __inline__ __device__ uint32_t atomicCAS32(uint32_t* address, uint32_t compare, uint32_t val)+{+ return atomicCAS(address, compare, val);+}++#if !defined(__CUDA_ARCH__) || __CUDA_ARCH__ >= 120+template <typename T>+static __inline__ __device__ T atomicCAS64(T* address, T compare, T val)+{+ union { T a; unsigned long long int b; } u;++ u.b = atomicCAS((unsigned long long int*) address, reinterpret64<T>(compare), reinterpret64<T>(val));+ return u.a;+}++template <>+static __inline__ __device__ unsigned long long int atomicCAS64(unsigned long long int* address, unsigned long long int compare, unsigned long long int val)+{+ return atomicCAS(address, compare, val);+}+#endif++#if 0+/* -----------------------------------------------------------------------------+ * Additional helper functions+ * -------------------------------------------------------------------------- */++/*+ * Determine if the input is a power of two+ */+template <typename T>+static __inline__ __host__ __device__ T isPow2(const T x)+{+ return ((x&(x-1)) == 0);+}++/*+ * Compute the next highest power of two+ */+template <typename T>+static __inline__ __host__ T ceilPow2(const T x)+{+#if 0+ --x;+ x |= x >> 1;+ x |= x >> 2;+ x |= x >> 4;+ x |= x >> 8;+ x |= x >> 16;+ return ++x;+#endif++ return (isPow2(x)) ? x : 1u << (int) ceil(log2((double)x));+}++/*+ * Compute the next lowest power of two+ */+template <typename T>+static __inline__ __host__ T floorPow2(const T x)+{+#if 0+ float nf = (float) n;+ return 1 << (((*(int*)&nf) >> 23) - 127);+#endif++ int exp;+ frexp(x, &exp);+ return 1 << (exp - 1);+}++/*+ * computes next highest multiple of f from x+ */+template <typename T>+static __inline__ __host__ T multiple(const T x, const T f)+{+ return ((x + (f-1)) / f);+}++/*+ * MS Excel-style CEIL() function. Rounds x up to nearest multiple of f+ */+template <typename T>+static __inline__ __host__ T ceiling(const T x, const T f)+{+ return multiple(x, f) * f;+}+#endif++#endif // __cplusplus+#endif // __ACCELERATE_CUDA_FUNCTION_H__+
+ cubits/accelerate_cuda_shape.h view
@@ -0,0 +1,338 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Shape+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_SHAPE_H__+#define __ACCELERATE_CUDA_SHAPE_H__++#include <stdint.h>+#include <cuda_runtime.h>++/*+ * For the time being, the D.A.A.CUDA.Execute converts shape components from+ * Haskell Ints (which may be 32- or 64-bits) into CUDA integers which are+ * 32-bit. This is to avoid undue register pressure. Lift this restriction if+ * future hardware gains better 64-bit support and/or we need to access very+ * large arrays.+ *+ * typedef int64_t Ix;+ */+typedef int32_t Ix;+typedef void* DIM0;+typedef Ix DIM1;+typedef struct { Ix a1,a0; } DIM2;+typedef struct { Ix a2,a1,a0; } DIM3;+typedef struct { Ix a3,a2,a1,a0; } DIM4;+typedef struct { Ix a4,a3,a2,a1,a0; } DIM5;+typedef struct { Ix a5,a4,a3,a2,a1,a0; } DIM6;+typedef struct { Ix a6,a5,a4,a3,a2,a1,a0; } DIM7;+typedef struct { Ix a7,a6,a5,a4,a3,a2,a1,a0; } DIM8;+typedef struct { Ix a8,a7,a6,a5,a4,a3,a2,a1,a0; } DIM9;++#ifdef __cplusplus++/* -----------------------------------------------------------------------------+ * Shape construction and destruction+ */++/*+ * Convert the individual dimensions of a linear array into a shape+ */+static __inline__ __device__ DIM0 shape()+{+ return NULL;+}++static __inline__ __device__ DIM1 shape(const Ix a)+{+ return a;+}++static __inline__ __device__ DIM2 shape(const Ix b, const Ix a)+{+ DIM2 sh = { b, a };+ return sh;+}++static __inline__ __device__ DIM3 shape(const Ix c, const Ix b, const Ix a)+{+ DIM3 sh = { c, b, a };+ return sh;+}++static __inline__ __device__ DIM4 shape(const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM4 sh = { d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM5 shape(const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM5 sh = { e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM6 shape(const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM6 sh = { f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM7 shape(const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM7 sh = { g, f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM8 shape(const Ix h, const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM8 sh = { h, g, f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM9 shape(const Ix i, const Ix h, const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM9 sh = { i, h, g, f, e, d, c, b, a };+ return sh;+}++/*+ * Yield the inner-most dimension of a shape only+ */+template <typename Shape>+static __inline__ __device__ Ix indexHead(const Shape ix)+{+ return ix.a0;+}++template <>+static __inline__ __device__ Ix indexHead(const DIM0 ix)+{+ return 0;+}++template <>+static __inline__ __device__ Ix indexHead(const DIM1 ix)+{+ return ix;+}+++/*+ * Yield all but the inner-most dimension of a shape+ */+static __inline__ __device__ DIM0 indexTail(const DIM1 ix)+{+ return 0;+}++static __inline__ __device__ DIM1 indexTail(const DIM2 ix)+{+ return ix.a1;+}++static __inline__ __device__ DIM2 indexTail(const DIM3 ix)+{+ return shape(ix.a2, ix.a1);+}++static __inline__ __device__ DIM3 indexTail(const DIM4 ix)+{+ return shape(ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM4 indexTail(const DIM5 ix)+{+ return shape(ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM5 indexTail(const DIM6 ix)+{+ return shape(ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM6 indexTail(const DIM7 ix)+{+ return shape(ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM7 indexTail(const DIM8 ix)+{+ return shape(ix.a7, ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM8 indexTail(const DIM9 ix)+{+ return shape(ix.a8, ix.a7, ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}+++/* -----------------------------------------------------------------------------+ * Shape methods+ */++/*+ * Number of dimensions of a shape+ */+template <typename Shape>+static __inline__ __device__ int dim(const Shape sh)+{+ return dim(indexTail(sh)) + 1;+}++template <>+static __inline__ __device__ int dim(const DIM0 sh)+{+ return 0;+}+++/*+ * Yield the total number of elements in a shape+ */+template <typename Shape>+static __inline__ __device__ int size(const Shape sh)+{+ return size(indexTail(sh)) * indexHead(sh);+}++template <>+static __inline__ __device__ int size(const DIM0 sh)+{+ return 1;+}+++/*+ * Add an index to the head of a shape+ */+static __inline__ __device__ DIM1 indexCons(const DIM0 sh, const Ix ix)+{+ return shape(ix);+}++static __inline__ __device__ DIM2 indexCons(const DIM1 sh, const Ix ix)+{+ return shape(sh, ix);+}++static __inline__ __device__ DIM3 indexCons(const DIM2 sh, const Ix ix)+{+ return shape(sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM4 indexCons(const DIM3 sh, const Ix ix)+{+ return shape(sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM5 indexCons(const DIM4 sh, const Ix ix)+{+ return shape(sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM6 indexCons(const DIM5 sh, const Ix ix)+{+ return shape(sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM7 indexCons(const DIM6 sh, const Ix ix)+{+ return shape(sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM8 indexCons(const DIM7 sh, const Ix ix)+{+ return shape(sh.a6, sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM9 indexCons(const DIM8 sh, const Ix ix)+{+ return shape(sh.a7, sh.a6, sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}+++/*+ * Yield the index position in a linear, row-major representation of the array.+ * First argument is the shape of the array, the second the index+ */+template <typename Shape>+static __inline__ __device__ Ix toIndex(const Shape sh, const Shape ix)+{+ return toIndex(indexTail(sh), indexTail(ix)) * indexHead(sh) + indexHead(ix);+}++template <>+static __inline__ __device__ Ix toIndex(const DIM0 sh, const DIM0 ix)+{+ return 0;+}++template <>+static __inline__ __device__ Ix toIndex(const DIM1 sh, const DIM1 ix)+{+ return ix;+}+++/*+ * Inverse of 'toIndex'+ */+template <typename Shape>+static __inline__ __device__ Shape fromIndex(const Shape sh, const Ix ix)+{+ const Ix d = indexHead(sh);+ return indexCons(fromIndex(indexTail(sh), ix / d), ix % d);+}++template <>+static __inline__ __device__ DIM0 fromIndex(const DIM0 sh, const Ix ix)+{+ return 0;+}++template <>+static __inline__ __device__ DIM1 fromIndex(const DIM1 sh, const Ix ix)+{+ return ix;+}+++/*+ * Test for the magic index `ignore`+ */+template <typename Shape>+static __inline__ __device__ int ignore(const Shape ix)+{+ return indexHead(ix) == -1 && ignore(indexTail(ix));+}++template <>+static __inline__ __device__ int ignore(const DIM0 ix)+{+ return 1;+}+++#else++static __inline__ __device__ int dim(const Ix sh);+static __inline__ __device__ int size(const Ix sh);+static __inline__ __device__ int shape(const Ix sh);+static __inline__ __device__ int toIndex(const Ix sh, const Ix ix);+static __inline__ __device__ int fromIndex(const Ix sh, const Ix ix);+static __inline__ __device__ int indexHead(const Ix ix);+static __inline__ __device__ int indexTail(const Ix ix);+static __inline__ __device__ int indexCons(const Ix sh, const Ix ix);++#endif // __cplusplus+#endif // __ACCELERATE_CUDA_SHAPE_H__+
+ cubits/accelerate_cuda_shape.h.in view
@@ -0,0 +1,338 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Shape+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_SHAPE_H__+#define __ACCELERATE_CUDA_SHAPE_H__++#include <stdint.h>+#include <cuda_runtime.h>++/*+ * For the time being, the D.A.A.CUDA.Execute converts shape components from+ * Haskell Ints (which may be 32- or 64-bits) into CUDA integers which are+ * 32-bit. This is to avoid undue register pressure. Lift this restriction if+ * future hardware gains better 64-bit support and/or we need to access very+ * large arrays.+ *+ * typedef @hs_int_type@ Ix;+ */+typedef int32_t Ix;+typedef void* DIM0;+typedef Ix DIM1;+typedef struct { Ix a1,a0; } DIM2;+typedef struct { Ix a2,a1,a0; } DIM3;+typedef struct { Ix a3,a2,a1,a0; } DIM4;+typedef struct { Ix a4,a3,a2,a1,a0; } DIM5;+typedef struct { Ix a5,a4,a3,a2,a1,a0; } DIM6;+typedef struct { Ix a6,a5,a4,a3,a2,a1,a0; } DIM7;+typedef struct { Ix a7,a6,a5,a4,a3,a2,a1,a0; } DIM8;+typedef struct { Ix a8,a7,a6,a5,a4,a3,a2,a1,a0; } DIM9;++#ifdef __cplusplus++/* -----------------------------------------------------------------------------+ * Shape construction and destruction+ */++/*+ * Convert the individual dimensions of a linear array into a shape+ */+static __inline__ __device__ DIM0 shape()+{+ return NULL;+}++static __inline__ __device__ DIM1 shape(const Ix a)+{+ return a;+}++static __inline__ __device__ DIM2 shape(const Ix b, const Ix a)+{+ DIM2 sh = { b, a };+ return sh;+}++static __inline__ __device__ DIM3 shape(const Ix c, const Ix b, const Ix a)+{+ DIM3 sh = { c, b, a };+ return sh;+}++static __inline__ __device__ DIM4 shape(const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM4 sh = { d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM5 shape(const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM5 sh = { e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM6 shape(const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM6 sh = { f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM7 shape(const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM7 sh = { g, f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM8 shape(const Ix h, const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM8 sh = { h, g, f, e, d, c, b, a };+ return sh;+}++static __inline__ __device__ DIM9 shape(const Ix i, const Ix h, const Ix g, const Ix f, const Ix e, const Ix d, const Ix c, const Ix b, const Ix a)+{+ DIM9 sh = { i, h, g, f, e, d, c, b, a };+ return sh;+}++/*+ * Yield the inner-most dimension of a shape only+ */+template <typename Shape>+static __inline__ __device__ Ix indexHead(const Shape ix)+{+ return ix.a0;+}++template <>+static __inline__ __device__ Ix indexHead(const DIM0 ix)+{+ return 0;+}++template <>+static __inline__ __device__ Ix indexHead(const DIM1 ix)+{+ return ix;+}+++/*+ * Yield all but the inner-most dimension of a shape+ */+static __inline__ __device__ DIM0 indexTail(const DIM1 ix)+{+ return 0;+}++static __inline__ __device__ DIM1 indexTail(const DIM2 ix)+{+ return ix.a1;+}++static __inline__ __device__ DIM2 indexTail(const DIM3 ix)+{+ return shape(ix.a2, ix.a1);+}++static __inline__ __device__ DIM3 indexTail(const DIM4 ix)+{+ return shape(ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM4 indexTail(const DIM5 ix)+{+ return shape(ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM5 indexTail(const DIM6 ix)+{+ return shape(ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM6 indexTail(const DIM7 ix)+{+ return shape(ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM7 indexTail(const DIM8 ix)+{+ return shape(ix.a7, ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}++static __inline__ __device__ DIM8 indexTail(const DIM9 ix)+{+ return shape(ix.a8, ix.a7, ix.a6, ix.a5, ix.a4, ix.a3, ix.a2, ix.a1);+}+++/* -----------------------------------------------------------------------------+ * Shape methods+ */++/*+ * Number of dimensions of a shape+ */+template <typename Shape>+static __inline__ __device__ int dim(const Shape sh)+{+ return dim(indexTail(sh)) + 1;+}++template <>+static __inline__ __device__ int dim(const DIM0 sh)+{+ return 0;+}+++/*+ * Yield the total number of elements in a shape+ */+template <typename Shape>+static __inline__ __device__ int size(const Shape sh)+{+ return size(indexTail(sh)) * indexHead(sh);+}++template <>+static __inline__ __device__ int size(const DIM0 sh)+{+ return 1;+}+++/*+ * Add an index to the head of a shape+ */+static __inline__ __device__ DIM1 indexCons(const DIM0 sh, const Ix ix)+{+ return shape(ix);+}++static __inline__ __device__ DIM2 indexCons(const DIM1 sh, const Ix ix)+{+ return shape(sh, ix);+}++static __inline__ __device__ DIM3 indexCons(const DIM2 sh, const Ix ix)+{+ return shape(sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM4 indexCons(const DIM3 sh, const Ix ix)+{+ return shape(sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM5 indexCons(const DIM4 sh, const Ix ix)+{+ return shape(sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM6 indexCons(const DIM5 sh, const Ix ix)+{+ return shape(sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM7 indexCons(const DIM6 sh, const Ix ix)+{+ return shape(sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM8 indexCons(const DIM7 sh, const Ix ix)+{+ return shape(sh.a6, sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}++static __inline__ __device__ DIM9 indexCons(const DIM8 sh, const Ix ix)+{+ return shape(sh.a7, sh.a6, sh.a5, sh.a4, sh.a3, sh.a2, sh.a1, sh.a0, ix);+}+++/*+ * Yield the index position in a linear, row-major representation of the array.+ * First argument is the shape of the array, the second the index+ */+template <typename Shape>+static __inline__ __device__ Ix toIndex(const Shape sh, const Shape ix)+{+ return toIndex(indexTail(sh), indexTail(ix)) * indexHead(sh) + indexHead(ix);+}++template <>+static __inline__ __device__ Ix toIndex(const DIM0 sh, const DIM0 ix)+{+ return 0;+}++template <>+static __inline__ __device__ Ix toIndex(const DIM1 sh, const DIM1 ix)+{+ return ix;+}+++/*+ * Inverse of 'toIndex'+ */+template <typename Shape>+static __inline__ __device__ Shape fromIndex(const Shape sh, const Ix ix)+{+ const Ix d = indexHead(sh);+ return indexCons(fromIndex(indexTail(sh), ix / d), ix % d);+}++template <>+static __inline__ __device__ DIM0 fromIndex(const DIM0 sh, const Ix ix)+{+ return 0;+}++template <>+static __inline__ __device__ DIM1 fromIndex(const DIM1 sh, const Ix ix)+{+ return ix;+}+++/*+ * Test for the magic index `ignore`+ */+template <typename Shape>+static __inline__ __device__ int ignore(const Shape ix)+{+ return indexHead(ix) == -1 && ignore(indexTail(ix));+}++template <>+static __inline__ __device__ int ignore(const DIM0 ix)+{+ return 1;+}+++#else++static __inline__ __device__ int dim(const Ix sh);+static __inline__ __device__ int size(const Ix sh);+static __inline__ __device__ int shape(const Ix sh);+static __inline__ __device__ int toIndex(const Ix sh, const Ix ix);+static __inline__ __device__ int fromIndex(const Ix sh, const Ix ix);+static __inline__ __device__ int indexHead(const Ix ix);+static __inline__ __device__ int indexTail(const Ix ix);+static __inline__ __device__ int indexCons(const Ix sh, const Ix ix);++#endif // __cplusplus+#endif // __ACCELERATE_CUDA_SHAPE_H__+
+ cubits/accelerate_cuda_stencil.h view
@@ -0,0 +1,93 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Stencil+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_STENCIL_H__+#define __ACCELERATE_CUDA_STENCIL_H__++#include <accelerate_cuda_shape.h>++#ifdef __cplusplus++/*+ * Test if an index lies within the boundaries of a shape+ */+template <typename Shape>+static __inline__ __device__ int inRange(const Shape sh, const Shape ix)+{+ return inRange(indexHead(sh), indexHead(ix)) && inRange(indexTail(sh), indexTail(ix));+}++template <>+static __inline__ __device__ int inRange(const DIM1 sz, const DIM1 i)+{+ return i >= 0 && i < sz;+}++template <>+static __inline__ __device__ int inRange(const DIM0 sz, const DIM0 i)+{+ return i == 0;+}+++/*+ * Boundary condition handlers+ */+template <typename Shape>+static __inline__ __device__ Shape clamp(const Shape sh, const Shape ix)+{+ return indexCons( clamp(indexTail(sh), indexTail(ix))+ , clamp(indexHead(sh), indexHead(ix)) );+}++template <>+static __inline__ __device__ DIM1 clamp(const DIM1 sz, const DIM1 i)+{+ // CUDA-4.0 does not include 64-bit min/max functions for Fermi (?)+ return max(0, min((int) i, (int) sz-1));+}+++template <typename Shape>+static __inline__ __device__ Shape mirror(const Shape sh, const Shape ix)+{+ return indexCons( mirror(indexTail(sh), indexTail(ix))+ , mirror(indexHead(sh), indexHead(ix)) );+}++template <>+static __inline__ __device__ DIM1 mirror(const DIM1 sz, const DIM1 i)+{+ if (i < 0) return -i;+ else if (i >= sz) return sz - (i-sz+2);+ else return i;+}+++template <typename Shape>+static __inline__ __device__ Shape wrap(const Shape sh, const Shape ix)+{+ return indexCons( wrap(indexTail(sh), indexTail(ix))+ , wrap(indexHead(sh), indexHead(ix)) );+}++template <>+static __inline__ __device__ DIM1 wrap(const DIM1 sz, const DIM1 i)+{+ if (i < 0) return sz+i;+ else if (i >= sz) return i-sz;+ else return i;+}++#endif++#endif
+ cubits/accelerate_cuda_texture.h view
@@ -0,0 +1,133 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Texture+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * CUDA texture definitions and access functions are defined in terms of+ * templates, and hence only available through the C++ interface. Expose some+ * dummy wrappers to enable parsing with language-c.+ *+ * We don't have a definition for `Int' or `Word', since the bitwidth of the+ * Haskell and C types may be different.+ *+ * NOTE ON 64-BIT TYPES+ * The CUDA device uses little-endian arithmetic. We haven't accounted for the+ * fact that this may be different on the host, for both initial data transfer+ * and the unpacking below.+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_TEXTURE_H__+#define __ACCELERATE_CUDA_TEXTURE_H__++#include <stdint.h>+#include <cuda_runtime.h>++#if defined(__cplusplus) && defined(__CUDACC__)++typedef texture<uint2, 1> TexWord64;+typedef texture<uint32_t, 1> TexWord32;+typedef texture<uint16_t, 1> TexWord16;+typedef texture<uint8_t, 1> TexWord8;+typedef texture<int2, 1> TexInt64;+typedef texture<int32_t, 1> TexInt32;+typedef texture<int16_t, 1> TexInt16;+typedef texture<int8_t, 1> TexInt8;+typedef texture<float, 1> TexFloat;+typedef texture<char, 1> TexCChar;++static __inline__ __device__ uint8_t indexArray(TexWord8 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ uint16_t indexArray(TexWord16 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ uint32_t indexArray(TexWord32 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ uint64_t indexArray(TexWord64 t, const int x)+{+ union { uint2 x; uint64_t y; } v;+ v.x = tex1Dfetch(t,x);+ return v.y;+}++static __inline__ __device__ int8_t indexArray(TexInt8 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ int16_t indexArray(TexInt16 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ int32_t indexArray(TexInt32 t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ int64_t indexArray(TexInt64 t, const int x)+{+ union { int2 x; int64_t y; } v;+ v.x = tex1Dfetch(t,x);+ return v.y;+}++static __inline__ __device__ float indexArray(TexFloat t, const int x) { return tex1Dfetch(t,x); }+static __inline__ __device__ char indexArray(TexCChar t, const int x) { return tex1Dfetch(t,x); }++#if defined(__LP64__)+typedef TexInt64 TexCLong;+typedef TexWord64 TexCULong;+#else+typedef TexInt32 TexCLong;+typedef TexWord32 TexCULong;+#endif++/*+ * Synonyms for C-types. NVCC will force Ints to be 32-bits.+ */+typedef TexInt8 TexCSChar;+typedef TexWord8 TexCUChar;+typedef TexInt16 TexCShort;+typedef TexWord16 TexCUShort;+typedef TexInt32 TexCInt;+typedef TexWord32 TexCUInt;+typedef TexInt64 TexCLLong;+typedef TexWord64 TexCULLong;+typedef TexFloat TexCFloat;++/*+ * Doubles, only available when compiled for Compute 1.3 and greater+ */+typedef texture<int2, 1> TexDouble;+typedef TexDouble TexCDouble;++#if !defined(CUDA_NO_SM_13_DOUBLE_INTRINSICS)+static __inline__ __device__ double indexDArray(TexDouble t, const int x)+{+ int2 v = tex1Dfetch(t,x);+ return __hiloint2double(v.y,v.x);+}+#endif++#else++typedef void* TexWord64;+typedef void* TexWord32;+typedef void* TexWord16;+typedef void* TexWord8;+typedef void* TexInt64;+typedef void* TexInt32;+typedef void* TexInt16;+typedef void* TexInt8;+typedef void* TexCShort;+typedef void* TexCUShort;+typedef void* TexCInt;+typedef void* TexCUInt;+typedef void* TexCLong;+typedef void* TexCULong;+typedef void* TexCLLong;+typedef void* TexCULLong;+typedef void* TexFloat;+typedef void* TexDouble;+typedef void* TexCFloat;+typedef void* TexCDouble;+typedef void* TexCChar;+typedef void* TexCSChar;+typedef void* TexCUChar;++void* indexArray(const void*, const int);+void* indexDArray(const void*, const int);++#endif // defined(__cplusplus) && defined(__CUDACC__)+#endif // __ACCELERATE_CUDA_TEXTURE_H__+
+ cubits/accelerate_cuda_util.h view
@@ -0,0 +1,70 @@+/* -----------------------------------------------------------------------------+ *+ * Module : Util+ * Copyright : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee+ * [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+ * License : BSD3+ *+ * Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+ * Stability : experimental+ *+ * ---------------------------------------------------------------------------*/++#ifndef __ACCELERATE_CUDA_UTIL_H__+#define __ACCELERATE_CUDA_UTIL_H__++#include <math.h>+#include <cuda_runtime.h>++/*+ * Core assert function. Don't let this escape...+ */+#if defined(__CUDACC__) || !defined(__DEVICE_EMULATION__)+#define __assert(e, file, line) ((void)0)+#else+#define __assert(e, file, line) \+ ((void) fprintf (stderr, "%s:%u: failed assertion `%s'\n", file, line, e), abort())+#endif++/*+ * Test the given expression, and abort the program if it evaluates to false.+ * Only available in debug mode.+ */+#ifndef _DEBUG+#define assert(e) ((void)0)+#else+#define assert(e) \+ ((void) ((e) ? (void(0)) : __assert (#e, __FILE__, __LINE__)))+#endif++/*+ * Macro to insert __syncthreads() in device emulation mode+ */+#ifdef __DEVICE_EMULATION__+#define __EMUSYNC __syncthreads()+#else+#define __EMUSYNC+#endif++/*+ * Check the return status of CUDA API calls, and abort with an appropriate+ * error string on failure.+ */+#define CUDA_SAFE_CALL_NO_SYNC(call) \+ do { \+ cudaError err = call; \+ if(cudaSuccess != err) { \+ const char *str = cudaGetErrorString(err); \+ __assert(str, __FILE__, __LINE__); \+ } \+ } while (0)++#define CUDA_SAFE_CALL(call) \+ do { \+ CUDA_SAFE_CALL_NO_SYNC(call); \+ CUDA_SAFE_CALL_NO_SYNC(cudaThreadSynchronize()); \+ } while (0)++#undef __assert+#endif // __ACCELERATE_CUDA_UTIL_H__+
+ include/accelerate.h view
@@ -0,0 +1,31 @@++#ifndef ACCELERATE_H+#define ACCELERATE_H+import qualified Data.Array.Accelerate.Internal.Check as Ck+++/*+ * Internal checks+ */+#define ERROR(f) (Ck.f __FILE__ __LINE__)+#define ASSERT (Ck.assert __FILE__ __LINE__)+#define ENSURE (Ck.f __FILE__ __LINE__)+#define CHECK(f) (Ck.f __FILE__ __LINE__)++#define BOUNDS_ERROR(f) (ERROR(f) Ck.Bounds)+#define BOUNDS_ASSERT (ASSERT Ck.Bounds)+#define BOUNDS_ENSURE (ENSURE Ck.Bounds)+#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds)++#define UNSAFE_ERROR(f) (ERROR(f) Ck.Unsafe)+#define UNSAFE_ASSERT (ASSERT Ck.Unsafe)+#define UNSAFE_ENSURE (ENSURE Ck.Unsafe)+#define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe)++#define INTERNAL_ERROR(f) (ERROR(f) Ck.Internal)+#define INTERNAL_ASSERT (ASSERT Ck.Internal)+#define INTERNAL_ENSURE (ENSURE Ck.Internal)+#define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal)++#endif+