accelerate-llvm-native (empty) → 1.0.0.0
raw patch · 27 files changed
+3876/−0 lines, 27 filesdep +acceleratedep +accelerate-llvmdep +basesetup-changed
Dependencies added: accelerate, accelerate-llvm, base, containers, directory, dlist, fclabels, libffi, llvm-hs, llvm-hs-pure, mtl, time
Files
- Data/Array/Accelerate/LLVM/Native.hs +193/−0
- Data/Array/Accelerate/LLVM/Native/Array/Data.hs +104/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen.hs +46/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Base.hs +87/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Fold.hs +292/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/FoldSeg.hs +177/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Generate.hs +54/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Loop.hs +46/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Map.hs +94/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Permute.hs +298/−0
- Data/Array/Accelerate/LLVM/Native/CodeGen/Scan.hs +814/−0
- Data/Array/Accelerate/LLVM/Native/Compile.hs +101/−0
- Data/Array/Accelerate/LLVM/Native/Compile/Link.hs +56/−0
- Data/Array/Accelerate/LLVM/Native/Compile/Module.hs +153/−0
- Data/Array/Accelerate/LLVM/Native/Compile/Optimise.hs +143/−0
- Data/Array/Accelerate/LLVM/Native/Debug.hs +42/−0
- Data/Array/Accelerate/LLVM/Native/Execute.hs +517/−0
- Data/Array/Accelerate/LLVM/Native/Execute/Async.hs +52/−0
- Data/Array/Accelerate/LLVM/Native/Execute/Environment.hs +25/−0
- Data/Array/Accelerate/LLVM/Native/Execute/LBS.hs +34/−0
- Data/Array/Accelerate/LLVM/Native/Execute/Marshal.hs +101/−0
- Data/Array/Accelerate/LLVM/Native/Foreign.hs +82/−0
- Data/Array/Accelerate/LLVM/Native/State.hs +140/−0
- Data/Array/Accelerate/LLVM/Native/Target.hs +76/−0
- LICENSE +23/−0
- Setup.hs +2/−0
- accelerate-llvm-native.cabal +124/−0
+ Data/Array/Accelerate/LLVM/Native.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module implements a backend for the /Accelerate/ language targeting+-- multicore CPUs. Expressions are on-line translated into LLVM code, which is+-- just-in-time executed in parallel over the available CPUs. Functions are+-- automatically parallel, provided you specify '+RTS -Nwhatever' on the command+-- line when running the program.+--++module Data.Array.Accelerate.LLVM.Native (++ Acc, Arrays,++ -- * Synchronous execution+ run, runWith,+ run1, run1With,+ stream, streamWith,++ -- * Asynchronous execution+ Async,+ wait, poll, cancel,++ runAsync, runAsyncWith,+ run1Async, run1AsyncWith,++ -- * Execution targets+ Native, Strategy,+ createTarget, balancedParIO, unbalancedParIO,++) where++-- accelerate+import Data.Array.Accelerate.Async+import Data.Array.Accelerate.Trafo+import Data.Array.Accelerate.Array.Sugar ( Arrays )+import Data.Array.Accelerate.Smart ( Acc )+import Data.Array.Accelerate.LLVM.Native.Debug as Debug++import Data.Array.Accelerate.LLVM.Native.Compile ( compileAcc, compileAfun )+import Data.Array.Accelerate.LLVM.Native.Execute ( executeAcc, executeAfun1 )+import Data.Array.Accelerate.LLVM.Native.State+import Data.Array.Accelerate.LLVM.Native.Target++-- standard library+import Control.Monad.Trans+import System.IO.Unsafe+import Text.Printf+++-- Accelerate: LLVM backend for multicore CPUs+-- -------------------------------------------++-- | Compile and run a complete embedded array program.+--+-- NOTE: it is recommended to use 'run1' whenever possible.+--+run :: Arrays a => Acc a -> a+run = runWith defaultTarget++-- | As 'run', but execute using the specified target (thread gang).+--+runWith :: Arrays a => Native -> Acc a -> a+runWith target a = unsafePerformIO (run' target a)++-- | As 'run', but allow the computation to run asynchronously and return+-- immediately without waiting for the result. The status of the computation can+-- be queried using 'wait', 'poll', and 'cancel'.+--+runAsync :: Arrays a => Acc a -> IO (Async a)+runAsync = runAsyncWith defaultTarget++-- | As 'runAsync', but execute using the specified target (thread gang).+--+runAsyncWith :: Arrays a => Native -> Acc a -> IO (Async a)+runAsyncWith target a = async (run' target a)++run' :: Arrays a => Native -> Acc a -> IO a+run' target a = execute+ where+ !acc = convertAccWith (config target) a+ execute = do+ dumpGraph acc+ evalNative target $ do+ exec <- phase "compile" elapsedS (compileAcc acc) >>= dumpStats+ res <- phase "execute" elapsedP (executeAcc exec)+ return res+++-- | 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 enables us to bypass+-- front-end conversion stages and move directly to the execution phase. If you+-- have a computation applied repeatedly to different input data, use this,+-- specifying any changing aspects of the computation via the input parameter.+-- If the function is only evaluated once, this is equivalent to 'run'.+--+-- To use 'run1' effectively you must express your program as a function of one+-- argument. If your program takes more than one argument, you can use+-- 'Data.Array.Accelerate.lift' and 'Data.Array.Accelerate.unlift' to tuple up+-- the arguments.+--+-- At an example, once your program is expressed as a function of one argument,+-- instead of the usual:+--+-- > step :: Acc (Vector a) -> Acc (Vector b)+-- > step = ...+-- >+-- > simulate :: Vector a -> Vector b+-- > simulate xs = run $ step (use xs)+--+-- Instead write:+--+-- > simulate xs = run1 step xs+--+-- You can use the debugging options to check whether this is working+-- successfully by, for example, observing no output from the @-ddump-cc@ flag+-- at the second and subsequent invocations.+--+-- See the programs in the 'accelerate-examples' package for examples.+--+run1 :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> b+run1 = run1With defaultTarget++-- | As 'run1', but execute using the specified target (thread gang).+--+run1With :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> a -> b+run1With = run1' unsafePerformIO++-- | As 'run1', but execute asynchronously.+--+run1Async :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> IO (Async b)+run1Async = run1AsyncWith defaultTarget++-- | As 'run1Async', but execute using the specified target (thread gang).+--+run1AsyncWith :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> a -> IO (Async b)+run1AsyncWith = run1' async++run1' :: (Arrays a, Arrays b) => (IO b -> c) -> Native -> (Acc a -> Acc b) -> a -> c+run1' using target f = \a -> using (execute a)+ where+ !acc = convertAfunWith (config target) f+ !afun = unsafePerformIO $ do+ dumpGraph acc+ phase "compile" elapsedS (evalNative target (compileAfun acc)) >>= dumpStats+ execute a = phase "execute" elapsedP (evalNative target (executeAfun1 afun a))+++-- | 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 = streamWith defaultTarget++-- | As 'stream', but execute using the specified target (thread gang).+--+streamWith :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> [a] -> [b]+streamWith target f arrs = map go arrs+ where+ !go = run1With target f+++-- How the Accelerate program should be evaluated.+--+-- TODO: make sharing/fusion runtime configurable via debug flags or otherwise.+--+config :: Native -> Phase+config target = phases+ { convertOffsetOfSegment = gangSize target > 1+ }+++-- Debugging+-- =========++dumpStats :: MonadIO m => a -> m a+dumpStats x = dumpSimplStats >> return x++phase :: MonadIO m => String -> (Double -> Double -> String) -> m a -> m a+phase n fmt go = timed dump_phases (\wall cpu -> printf "phase %s: %s" n (fmt wall cpu)) go+
+ Data/Array/Accelerate/LLVM/Native/Array/Data.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Array.Data+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Array.Data (++ module Data.Array.Accelerate.LLVM.Array.Data,++ cloneArray,++) where++-- accelerate+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.LLVM.State+import Data.Array.Accelerate.LLVM.Array.Data+import Data.Array.Accelerate.LLVM.Native.Target+import Data.Array.Accelerate.LLVM.Native.Execute.Async ()++-- standard library+import Control.Monad.Trans+import Data.Word+import Foreign.C+import Foreign.Ptr+import Foreign.Storable+++-- | Data instance for arrays in the native backend. We assume a shared-memory+-- machine, and just manipulate the underlying Haskell array directly.+--+instance Remote Native+++-- | Copy an array into a newly allocated array. This uses 'memcpy'.+--+cloneArray :: (Shape sh, Elt e) => Array sh e -> LLVM Native (Array sh e)+cloneArray arr@(Array _ src) = liftIO $ do+ out@(Array _ dst) <- allocateArray sh+ copyR arrayElt src dst+ return out+ where+ sh = shape arr+ n = size sh++ copyR :: ArrayEltR e -> ArrayData e -> ArrayData e -> IO ()+ copyR ArrayEltRunit _ _ = return ()+ copyR (ArrayEltRpair aeR1 aeR2) ad1 ad2 = copyR aeR1 (fstArrayData ad1) (fstArrayData ad2) >>+ copyR aeR2 (sndArrayData ad1) (sndArrayData ad2)+ --+ copyR ArrayEltRint ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRint8 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRint16 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRint32 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRint64 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRword ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRword8 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRword16 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRword32 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRword64 ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRfloat ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRdouble ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRbool ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRchar ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcshort ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcushort ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcint ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcuint ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRclong ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRculong ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcllong ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcullong ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcfloat ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcdouble ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcchar ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcschar ad1 ad2 = copyPrim ad1 ad2+ copyR ArrayEltRcuchar ad1 ad2 = copyPrim ad1 ad2++ copyPrim :: forall e a. (ArrayElt e, ArrayPtrs e ~ Ptr a, Storable a) => ArrayData e -> ArrayData e -> IO ()+ copyPrim a1 a2 = do+ let p1 = ptrsOfArrayData a1+ p2 = ptrsOfArrayData a2+ memcpy (castPtr p2) (castPtr p1) (n * sizeOf (undefined :: a))+++-- Standard C functions+-- --------------------++memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+memcpy p q s = c_memcpy p q (fromIntegral s) >> return ()++foreign import ccall unsafe "string.h memcpy" c_memcpy+ :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)+
+ Data/Array/Accelerate/LLVM/Native/CodeGen.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.CodeGen (++ KernelMetadata(..),++) where++-- accelerate+import Data.Array.Accelerate.LLVM.CodeGen++import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Fold+import Data.Array.Accelerate.LLVM.Native.CodeGen.FoldSeg+import Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+import Data.Array.Accelerate.LLVM.Native.CodeGen.Map+import Data.Array.Accelerate.LLVM.Native.CodeGen.Permute+import Data.Array.Accelerate.LLVM.Native.CodeGen.Scan+import Data.Array.Accelerate.LLVM.Native.Target+++instance Skeleton Native where+ map _ = mkMap+ generate _ = mkGenerate+ fold _ = mkFold+ fold1 _ = mkFold1+ foldSeg _ = mkFoldSeg+ fold1Seg _ = mkFold1Seg+ scanl _ = mkScanl+ scanl1 _ = mkScanl1+ scanl' _ = mkScanl'+ scanr _ = mkScanr+ scanr1 _ = mkScanr1+ scanr' _ = mkScanr'+ permute _ = mkPermute+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Base.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Base+-- Copyright : [2015..2017] 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.LLVM.Native.CodeGen.Base+ where++import Data.Array.Accelerate.Type+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Downcast+import Data.Array.Accelerate.LLVM.CodeGen.IR+import Data.Array.Accelerate.LLVM.CodeGen.Module+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar+import Data.Array.Accelerate.LLVM.Native.Target ( Native )++import LLVM.AST.Type.Name+import qualified LLVM.AST.Global as LLVM+import qualified LLVM.AST.Type as LLVM+++-- | Generate function parameters that will specify the first and last (linear)+-- index of the array this thread should evaluate.+--+gangParam :: (IR Int, IR Int, [LLVM.Parameter])+gangParam =+ let t = scalarType+ start = "ix.start"+ end = "ix.end"+ in+ (local t start, local t end, [ scalarParameter t start, scalarParameter t end ] )+++-- | The thread ID of a gang worker+--+gangId :: (IR Int, [LLVM.Parameter])+gangId =+ let t = scalarType+ tid = "ix.tid"+ in+ (local t tid, [ scalarParameter t tid ] )+++-- Global function definitions+-- ---------------------------++data instance KernelMetadata Native = KM_Native ()++-- | Combine kernels into a single program+--+(+++) :: IROpenAcc Native aenv a -> IROpenAcc Native aenv a -> IROpenAcc Native aenv a+IROpenAcc k1 +++ IROpenAcc k2 = IROpenAcc (k1 ++ k2)++-- | Create a single kernel program+--+makeOpenAcc :: Label -> [LLVM.Parameter] -> CodeGen () -> CodeGen (IROpenAcc Native aenv a)+makeOpenAcc name param kernel = do+ body <- makeKernel name param kernel+ return $ IROpenAcc [body]++-- | Create a complete kernel function by running the code generation process+-- specified in the final parameter.+--+makeKernel :: Label -> [LLVM.Parameter] -> CodeGen () -> CodeGen (Kernel Native aenv a)+makeKernel name param kernel = do+ _ <- kernel+ code <- createBlocks+ return $ Kernel+ { kernelMetadata = KM_Native ()+ , unKernel = LLVM.functionDefaults+ { LLVM.returnType = LLVM.VoidType+ , LLVM.name = downcast name+ , LLVM.parameters = (param, False)+ , LLVM.basicBlocks = code+ }+ }+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Fold.hs view
@@ -0,0 +1,292 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Fold+-- Copyright : [2014..2017] 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.LLVM.Native.CodeGen.Fold+ where++-- accelerate+import Data.Array.Accelerate.Analysis.Match+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Type++import Data.Array.Accelerate.LLVM.Analysis.Match+import Data.Array.Accelerate.LLVM.CodeGen.Arithmetic as A+import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Constant+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.IR+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+import Data.Array.Accelerate.LLVM.Native.Target ( Native )++import Control.Applicative+import Prelude as P hiding ( length )+++-- Reduce a (possibly empty) array along the innermost dimension. The reduction+-- function must be associative to allow for an efficient parallel+-- implementation. The initial element does not need to be a neutral element of+-- the operator.+--+mkFold+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkFold aenv f z acc+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = (+++) <$> mkFoldAll aenv f (Just z) acc+ <*> mkFoldFill aenv z++ | otherwise+ = (+++) <$> mkFoldDim aenv f (Just z) acc+ <*> mkFoldFill aenv z+++-- Reduce a non-empty array along the innermost dimension. The reduction+-- function must be associative to allow for efficient parallel implementation.+--+mkFold1+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkFold1 aenv f acc+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = mkFoldAll aenv f Nothing acc++ | otherwise+ = mkFoldDim aenv f Nothing acc+++-- Reduce a multidimensional (>1) array along the innermost dimension.+--+-- For simplicity, each element of the output (reduction along the entire length+-- of an innermost-dimension index) is computed by a single thread.+--+mkFoldDim+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkFoldDim aenv combine mseed IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh e))+ paramEnv = envParam aenv+ --+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ stride = local scalarType ("ix.stride" :: Name Int)+ in+ makeOpenAcc "fold" (paramGang ++ paramStride : paramOut ++ paramEnv) $ do++ imapFromTo start end $ \seg -> do+ from <- mul numType seg stride+ to <- add numType from stride+ --+ r <- case mseed of+ Just seed -> do z <- seed+ reduceFromTo from to (app2 combine) z (app1 delayedLinearIndex)+ Nothing -> reduce1FromTo from to (app2 combine) (app1 delayedLinearIndex)+ writeArray arrOut seg r+ return_+++-- Reduce an array to single element.+--+-- Since reductions consume arrays that have been fused into them,+-- a parallel fold requires two passes. At an example, take vector dot+-- product:+--+-- > dotp xs ys = fold (+) 0 (zipWith (*) xs ys)+--+-- 1. The first pass reads in the fused array data, in this case corresponding+-- to the function (\i -> (xs!i) * (ys!i)).+--+-- 2. The second pass reads in the manifest array data from the first step and+-- directly reduces the array. This second step should be small and so is+-- usually just done by a single core.+--+-- Note that the first step is split into two kernels, the second of which+-- reads a carry-in value of that thread's partial reduction, so that+-- threads can still participate in work-stealing. These kernels must not+-- be invoked over empty ranges.+--+-- The final step is sequential reduction of the partial results. If this+-- is an exclusive reduction, the seed element is included at this point.+--+mkFoldAll+ :: forall aenv e. Elt e+ => Gamma aenv -- ^ array environment+ -> IRFun2 Native aenv (e -> e -> e) -- ^ combination function+ -> Maybe (IRExp Native aenv e) -- ^ seed element, if this is an exclusive reduction+ -> IRDelayed Native aenv (Vector e) -- ^ input data+ -> CodeGen (IROpenAcc Native aenv (Scalar e))+mkFoldAll aenv combine mseed arr =+ foldr1 (+++) <$> sequence [ mkFoldAllS aenv combine mseed arr+ , mkFoldAllP1 aenv combine arr+ , mkFoldAllP2 aenv combine mseed+ ]+++-- Sequential reduction of an entire array to a single element+--+mkFoldAllS+ :: forall aenv e. Elt e+ => Gamma aenv -- ^ array environment+ -> IRFun2 Native aenv (e -> e -> e) -- ^ combination function+ -> Maybe (IRExp Native aenv e) -- ^ seed element, if this is an exclusive reduction+ -> IRDelayed Native aenv (Vector e) -- ^ input data+ -> CodeGen (IROpenAcc Native aenv (Scalar e))+mkFoldAllS aenv combine mseed IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ paramEnv = envParam aenv+ (arrOut, paramOut) = mutableArray ("out" :: Name (Scalar e))+ zero = lift 0 :: IR Int+ in+ makeOpenAcc "foldAllS" (paramGang ++ paramOut ++ paramEnv) $ do+ r <- case mseed of+ Just seed -> do z <- seed+ reduceFromTo start end (app2 combine) z (app1 delayedLinearIndex)+ Nothing -> reduce1FromTo start end (app2 combine) (app1 delayedLinearIndex)+ writeArray arrOut zero r+ return_++-- Parallel reduction of an entire array to a single element, step 1.+--+-- Threads reduce each stripe of the input into a temporary array, incorporating+-- any fused functions on the way.+--+mkFoldAllP1+ :: forall aenv e. Elt e+ => Gamma aenv -- ^ array environment+ -> IRFun2 Native aenv (e -> e -> e) -- ^ combination function+ -> IRDelayed Native aenv (Vector e) -- ^ input data+ -> CodeGen (IROpenAcc Native aenv (Scalar e))+mkFoldAllP1 aenv combine IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ paramEnv = envParam aenv+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ length = local scalarType ("ix.length" :: Name Int)+ stride = local scalarType ("ix.stride" :: Name Int)+ paramLength = scalarParameter scalarType ("ix.length" :: Name Int)+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ in+ makeOpenAcc "foldAllP1" (paramGang ++ paramLength : paramStride : paramTmp ++ paramEnv) $ do++ -- A thread reduces a sequential (non-empty) stripe of the input and stores+ -- that value into a temporary array at a specific index. The size of the+ -- stripe is fixed, but work stealing occurs between stripe indices. This+ -- method thus supports non-commutative operators because the order of+ -- operations remains left-to-right.+ --+ imapFromTo start end $ \i -> do+ inf <- A.mul numType i stride+ a <- A.add numType inf stride+ sup <- A.min scalarType a length+ r <- reduce1FromTo inf sup (app2 combine) (app1 delayedLinearIndex)+ writeArray arrTmp i r++ return_++-- Parallel reduction of an entire array to a single element, step 2.+--+-- A single thread reduces the temporary array to a single element.+--+-- During execution, we choose a stripe size in phase 1 so that the temporary is+-- small-ish and thus suitable for sequential reduction. An alternative would be+-- to keep the stripe size constant and, for if the partial reductions array is+-- large, continuing reducing it in parallel.+--+mkFoldAllP2+ :: forall aenv e. Elt e+ => Gamma aenv -- ^ array environment+ -> IRFun2 Native aenv (e -> e -> e) -- ^ combination function+ -> Maybe (IRExp Native aenv e) -- ^ seed element, if this is an exclusive reduction+ -> CodeGen (IROpenAcc Native aenv (Scalar e))+mkFoldAllP2 aenv combine mseed =+ let+ (start, end, paramGang) = gangParam+ paramEnv = envParam aenv+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ (arrOut, paramOut) = mutableArray ("out" :: Name (Scalar e))+ zero = lift 0 :: IR Int+ in+ makeOpenAcc "foldAllP2" (paramGang ++ paramTmp ++ paramOut ++ paramEnv) $ do+ r <- case mseed of+ Just seed -> do z <- seed+ reduceFromTo start end (app2 combine) z (readArray arrTmp)+ Nothing -> reduce1FromTo start end (app2 combine) (readArray arrTmp)+ writeArray arrOut zero r+ return_+++-- Exclusive reductions over empty arrays (of any dimension) fill the lower+-- dimensions with the initial element+--+mkFoldFill+ :: (Shape sh, Elt e)+ => Gamma aenv+ -> IRExp Native aenv e+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkFoldFill aenv seed =+ mkGenerate aenv (IRFun1 (const seed))++-- Reduction loops+-- ---------------++-- Reduction of a (possibly empty) index space.+--+reduceFromTo+ :: Elt a+ => IR Int -- ^ starting index+ -> IR Int -- ^ final index (exclusive)+ -> (IR a -> IR a -> CodeGen (IR a)) -- ^ combination function+ -> IR a -- ^ initial value+ -> (IR Int -> CodeGen (IR a)) -- ^ function to retrieve element at index+ -> CodeGen (IR a)+reduceFromTo m n f z get =+ iterFromTo m n z $ \i acc -> do+ x <- get i+ y <- f acc x+ return y++-- Reduction of an array over a _non-empty_ index space. The array must+-- contain at least one element.+--+reduce1FromTo+ :: Elt a+ => IR Int -- ^ starting index+ -> IR Int -- ^ final index+ -> (IR a -> IR a -> CodeGen (IR a)) -- ^ combination function+ -> (IR Int -> CodeGen (IR a)) -- ^ function to retrieve element at index+ -> CodeGen (IR a)+reduce1FromTo m n f get = do+ z <- get m+ m1 <- add numType m (ir numType (num numType 1))+ reduceFromTo m1 n f z get+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/FoldSeg.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.FoldSeg+-- Copyright : [2014..2017] 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.LLVM.Native.CodeGen.FoldSeg+ where++-- accelerate+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Type++import Data.Array.Accelerate.LLVM.CodeGen.Arithmetic as A+import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.IR+import Data.Array.Accelerate.LLVM.CodeGen.Exp ( indexHead )+import Data.Array.Accelerate.LLVM.CodeGen.Loop+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Fold+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+import Data.Array.Accelerate.LLVM.Native.Target ( Native )++import Control.Applicative+import Control.Monad+import Prelude as P+++-- Segmented reduction along the innermost dimension of an array. Performs one+-- reduction per segment of the source array.+--+mkFoldSeg+ :: forall aenv sh i e. (Shape sh, IsIntegral i, Elt i, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> IRDelayed Native aenv (Segments i)+ -> CodeGen (IROpenAcc Native aenv (Array (sh :. Int) e))+mkFoldSeg aenv combine seed arr seg =+ (+++) <$> mkFoldSegS aenv combine (Just seed) arr seg+ <*> mkFoldSegP aenv combine (Just seed) arr seg+++-- Segmented reduction along the innermost dimension of an array, where /all/+-- segments are non-empty.+--+mkFold1Seg+ :: forall aenv sh i e. (Shape sh, IsIntegral i, Elt i, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> IRDelayed Native aenv (Segments i)+ -> CodeGen (IROpenAcc Native aenv (Array (sh :. Int) e))+mkFold1Seg aenv combine arr seg =+ (+++) <$> mkFoldSegS aenv combine Nothing arr seg+ <*> mkFoldSegP aenv combine Nothing arr seg+++-- Segmented reduction where a single processor reduces the entire array. The+-- segments array contains the length of each segment.+--+mkFoldSegS+ :: forall aenv sh i e. (Shape sh, IsIntegral i, Elt i, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> IRDelayed Native aenv (Segments i)+ -> CodeGen (IROpenAcc Native aenv (Array (sh :. Int) e))+mkFoldSegS aenv combine mseed arr seg =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array (sh :. Int) e))+ paramEnv = envParam aenv+ in+ makeOpenAcc "foldSegS" (paramGang ++ paramOut ++ paramEnv) $ do++ -- Number of segments, useful only if reducing DIM2 and higher+ ss <- indexHead <$> delayedExtent seg++ let test si = A.lt scalarType (A.fst si) end+ initial = A.pair start (lift 0)++ body :: IR (Int,Int) -> CodeGen (IR (Int,Int))+ body (A.unpair -> (s,inf)) = do+ -- We can avoid an extra division if this is a DIM1 array. Higher+ -- dimensional reductions need to wrap around the segment array at+ -- each new lower-dimensional index.+ s' <- case rank (undefined::sh) of+ 0 -> return s+ _ -> A.rem integralType s ss++ len <- A.fromIntegral integralType numType =<< app1 (delayedLinearIndex seg) s'+ sup <- A.add numType inf len++ r <- case mseed of+ Just seed -> do z <- seed+ reduceFromTo inf sup (app2 combine) z (app1 (delayedLinearIndex arr))+ Nothing -> reduce1FromTo inf sup (app2 combine) (app1 (delayedLinearIndex arr))+ writeArray arrOut s r++ t <- A.add numType s (lift 1)+ return $ A.pair t sup++ void $ while test body initial+ return_+++-- This implementation assumes that the segments array represents the offset+-- indices to the source array, rather than the lengths of each segment. The+-- segment-offset approach is required for parallel implementations.+--+mkFoldSegP+ :: forall aenv sh i e. (Shape sh, IsIntegral i, Elt i, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Array (sh :. Int) e)+ -> IRDelayed Native aenv (Segments i)+ -> CodeGen (IROpenAcc Native aenv (Array (sh :. Int) e))+mkFoldSegP aenv combine mseed arr seg =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array (sh :. Int) e))+ paramEnv = envParam aenv+ in+ makeOpenAcc "foldSegP" (paramGang ++ paramOut ++ paramEnv) $ do++ -- Number of segments and size of the innermost dimension. These are+ -- required if we are reducing a DIM2 or higher array, to properly compute+ -- the start and end indices of the portion of the array to reduce. Note+ -- that this is a segment-offset array computed by 'scanl (+) 0' of the+ -- segment length array, so its size has increased by one.+ sz <- indexHead <$> delayedExtent arr+ ss <- do n <- indexHead <$> delayedExtent seg+ A.sub numType n (lift 1)++ imapFromTo start end $ \s -> do++ i <- case rank (undefined::sh) of+ 0 -> return s+ _ -> A.rem integralType s ss+ j <- A.add numType i (lift 1)+ u <- A.fromIntegral integralType numType =<< app1 (delayedLinearIndex seg) i+ v <- A.fromIntegral integralType numType =<< app1 (delayedLinearIndex seg) j++ (inf,sup) <- A.unpair <$> case rank (undefined::sh) of+ 0 -> return (A.pair u v)+ _ -> do q <- A.quot integralType s ss+ a <- A.mul numType q sz+ A.pair <$> A.add numType u a <*> A.add numType v a++ r <- case mseed of+ Just seed -> do z <- seed+ reduceFromTo inf sup (app2 combine) z (app1 (delayedLinearIndex arr))+ Nothing -> reduce1FromTo inf sup (app2 combine) (app1 (delayedLinearIndex arr))++ writeArray arrOut s r++ return_+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Generate.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+ where++-- accelerate+import Data.Array.Accelerate.Array.Sugar ( Array, Shape, Elt )++import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.Exp+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.Target ( Native )+import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+++-- Construct a new array by applying a function to each index. Each thread+-- processes multiple adjacent elements.+--+mkGenerate+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun1 Native aenv (sh -> e)+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkGenerate aenv apply =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh e))+ paramEnv = envParam aenv+ in+ makeOpenAcc "generate" (paramGang ++ paramOut ++ paramEnv) $ do++ imapFromTo start end $ \i -> do+ ix <- indexOfInt (irArrayShape arrOut) i -- convert to multidimensional index+ r <- app1 apply ix -- apply generator function+ writeArray arrOut i r -- store result++ return_+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Loop.hs view
@@ -0,0 +1,46 @@+-- |+-- Module : Data.Array.Accelerate.LLVM.CodeGen.Native.Loop+-- Copyright : [2014..2017] 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.LLVM.Native.CodeGen.Loop+ where++-- accelerate+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.LLVM.CodeGen.Arithmetic+import Data.Array.Accelerate.LLVM.CodeGen.IR+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import qualified Data.Array.Accelerate.LLVM.CodeGen.Loop as Loop+++-- | A standard 'for' loop, that steps from the start to end index executing the+-- given function at each index.+--+imapFromTo+ :: IR Int -- ^ starting index (inclusive)+ -> IR Int -- ^ final index (exclusive)+ -> (IR Int -> CodeGen ()) -- ^ apply at each index+ -> CodeGen ()+imapFromTo start end body =+ Loop.imapFromStepTo start (lift 1) end body++-- | Iterate with an accumulator between the start and end index, executing the+-- given function at each.+--+iterFromTo+ :: Elt a+ => IR Int -- ^ starting index (inclusive)+ -> IR Int -- ^ final index (exclusive)+ -> IR a -- ^ initial value+ -> (IR Int -> IR a -> CodeGen (IR a)) -- ^ apply at each index+ -> CodeGen (IR a)+iterFromTo start end seed body =+ Loop.iterFromStepTo start (lift 1) end seed body+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Map.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Map+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.CodeGen.Map+ where++-- accelerate+import Data.Array.Accelerate.Array.Sugar ( Array, Elt )++import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.Target ( Native )+import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+++-- C Code+-- ======+--+-- float f(float);+--+-- void map(float* __restrict__ out, const float* __restrict__ in, const int n)+-- {+-- for (int i = 0; i < n; ++i)+-- out[i] = f(in[i]);+--+-- return;+-- }++-- Corresponding LLVM+-- ==================+--+-- define void @map(float* noalias nocapture %out, float* noalias nocapture %in, i32 %n) nounwind uwtable ssp {+-- %1 = icmp sgt i32 %n, 0+-- br i1 %1, label %.lr.ph, label %._crit_edge+--+-- .lr.ph: ; preds = %0, %.lr.ph+-- %indvars.iv = phi i64 [ %indvars.iv.next, %.lr.ph ], [ 0, %0 ]+-- %2 = getelementptr inbounds float* %in, i64 %indvars.iv+-- %3 = load float* %2, align 4+-- %4 = tail call float @apply(float %3) nounwind+-- %5 = getelementptr inbounds float* %out, i64 %indvars.iv+-- store float %4, float* %5, align 4+-- %indvars.iv.next = add i64 %indvars.iv, 1+-- %lftr.wideiv = trunc i64 %indvars.iv.next to i32+-- %exitcond = icmp eq i32 %lftr.wideiv, %n+-- br i1 %exitcond, label %._crit_edge, label %.lr.ph+--+-- ._crit_edge: ; preds = %.lr.ph, %0+-- ret void+-- }+--+-- declare float @apply(float)+--+++-- Apply the given unary function to each element of an array.+--+mkMap :: forall aenv sh a b. Elt b+ => Gamma aenv+ -> IRFun1 Native aenv (a -> b)+ -> IRDelayed Native aenv (Array sh a)+ -> CodeGen (IROpenAcc Native aenv (Array sh b))+mkMap aenv apply IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh b))+ paramEnv = envParam aenv+ in+ makeOpenAcc "map" (paramGang ++ paramOut ++ paramEnv) $ do++ imapFromTo start end $ \i -> do+ xs <- app1 delayedLinearIndex i+ ys <- app1 apply xs+ writeArray arrOut i ys++ return_+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Permute.hs view
@@ -0,0 +1,298 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Permute+-- Copyright : [2016..2017] 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.LLVM.Native.CodeGen.Permute+ where++-- accelerate+import Data.Array.Accelerate.Array.Sugar ( Array, Vector, Shape, Elt, eltType )+import Data.Array.Accelerate.Error+import qualified Data.Array.Accelerate.Array.Sugar as S++import Data.Array.Accelerate.LLVM.CodeGen.Arithmetic as A+import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Constant+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.Exp+import Data.Array.Accelerate.LLVM.CodeGen.IR+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Permute+import Data.Array.Accelerate.LLVM.CodeGen.Ptr+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.Target ( Native )+import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop++import LLVM.AST.Type.AddrSpace+import LLVM.AST.Type.Instruction+import LLVM.AST.Type.Instruction.Atomic+import LLVM.AST.Type.Instruction.RMW as RMW+import LLVM.AST.Type.Instruction.Volatile+import LLVM.AST.Type.Representation++import Control.Applicative+import Control.Monad ( void )+import Data.Typeable+import Prelude+++-- Forward permutation specified by an indexing mapping. The resulting 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 combination+-- function.+--+-- The combination function must be /associative/ and /commutative/. Elements+-- that are mapped to the magic index 'ignore' are dropped.+--+mkPermute+ :: (Shape sh, Shape sh', Elt e)+ => Gamma aenv+ -> IRPermuteFun Native aenv (e -> e -> e)+ -> IRFun1 Native aenv (sh -> sh')+ -> IRDelayed Native aenv (Array sh e)+ -> CodeGen (IROpenAcc Native aenv (Array sh' e))+mkPermute aenv combine project arr =+ (+++) <$> mkPermuteS aenv combine project arr+ <*> mkPermuteP aenv combine project arr+++-- Forward permutation which does not require locking the output array. This+-- could be because we are executing sequentially with a single thread, or+-- because the default values are unused (e.g. for a filter).+--+-- We could also use this method if we can prove that the mapping function is+-- injective (distinct elements in the domain map to distinct elements in the+-- co-domain).+--+mkPermuteS+ :: forall aenv sh sh' e. (Shape sh, Shape sh', Elt e)+ => Gamma aenv+ -> IRPermuteFun Native aenv (e -> e -> e)+ -> IRFun1 Native aenv (sh -> sh')+ -> IRDelayed Native aenv (Array sh e)+ -> CodeGen (IROpenAcc Native aenv (Array sh' e))+mkPermuteS aenv IRPermuteFun{..} project IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh' e))+ paramEnv = envParam aenv+ in+ makeOpenAcc "permuteS" (paramGang ++ paramOut ++ paramEnv) $ do++ sh <- delayedExtent++ imapFromTo start end $ \i -> do++ ix <- indexOfInt sh i+ ix' <- app1 project ix++ unless (ignore ix') $ do+ j <- intOfIndex (irArrayShape arrOut) ix'++ -- project element onto the destination array and update+ x <- app1 delayedLinearIndex i+ y <- readArray arrOut j+ r <- app2 combine x y++ writeArray arrOut j r++ return_+++-- Parallel forward permutation has to take special care because different+-- threads could concurrently try to update the same memory location. Where+-- available we make use of special atomic instructions and other optimisations,+-- but in the general case each element of the output array has a lock which+-- must be obtained by the thread before it can update that memory location.+--+-- TODO: After too many failures to acquire the lock on an element, the thread+-- should back off and try a different element, adding this failed element to+-- a queue or some such.+--+mkPermuteP+ :: forall aenv sh sh' e. (Shape sh, Shape sh', Elt e)+ => Gamma aenv+ -> IRPermuteFun Native aenv (e -> e -> e)+ -> IRFun1 Native aenv (sh -> sh')+ -> IRDelayed Native aenv (Array sh e)+ -> CodeGen (IROpenAcc Native aenv (Array sh' e))+mkPermuteP aenv IRPermuteFun{..} project arr =+ case atomicRMW of+ Nothing -> mkPermuteP_mutex aenv combine project arr+ Just (rmw, f) -> mkPermuteP_rmw aenv rmw f project arr+++-- Parallel forward permutation function which uses atomic instructions to+-- implement lock-free array updates.+--+mkPermuteP_rmw+ :: forall aenv sh sh' e. (Shape sh, Shape sh', Elt e)+ => Gamma aenv+ -> RMWOperation+ -> IRFun1 Native aenv (e -> e)+ -> IRFun1 Native aenv (sh -> sh')+ -> IRDelayed Native aenv (Array sh e)+ -> CodeGen (IROpenAcc Native aenv (Array sh' e))+mkPermuteP_rmw aenv rmw update project IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh' e))+ paramEnv = envParam aenv+ in+ makeOpenAcc "permuteP_rmw" (paramGang ++ paramOut ++ paramEnv) $ do++ sh <- delayedExtent++ imapFromTo start end $ \i -> do++ ix <- indexOfInt sh i+ ix' <- app1 project ix++ unless (ignore ix') $ do+ j <- intOfIndex (irArrayShape arrOut) ix'+ x <- app1 delayedLinearIndex i+ r <- app1 update x++ case rmw of+ Exchange+ -> writeArray arrOut j r+ --+ _ | SingleTuple s <- eltType (undefined::e)+ , Just adata <- gcast (irArrayData arrOut)+ , Just r' <- gcast r+ -> do+ addr <- instr' $ GetElementPtr (asPtr defaultAddrSpace (op s adata)) [op integralType j]+ --+ case s of+ NumScalarType (IntegralNumType t) -> void . instr' $ AtomicRMW t NonVolatile rmw addr (op t r') (CrossThread, AcquireRelease)+ NumScalarType t | RMW.Add <- rmw -> atomicCAS_rmw s (A.add t r') addr+ NumScalarType t | RMW.Sub <- rmw -> atomicCAS_rmw s (A.sub t r') addr+ _ -> case rmw of+ RMW.Min -> atomicCAS_cmp s A.lt addr (op s r')+ RMW.Max -> atomicCAS_cmp s A.gt addr (op s r')+ _ -> $internalError "mkPermute_rmw" "unexpected transition"+ --+ _ -> $internalError "mkPermute_rmw" "unexpected transition"++ return_+++-- Parallel forward permutation function which uses a spinlock to acquire+-- a mutex before updating the value at that location.+--+mkPermuteP_mutex+ :: forall aenv sh sh' e. (Shape sh, Shape sh', Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRFun1 Native aenv (sh -> sh')+ -> IRDelayed Native aenv (Array sh e)+ -> CodeGen (IROpenAcc Native aenv (Array sh' e))+mkPermuteP_mutex aenv combine project IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array sh' e))+ (arrLock, paramLock) = mutableArray ("lock" :: Name (Vector Word8))+ paramEnv = envParam aenv+ in+ makeOpenAcc "permuteP_mutex" (paramGang ++ paramOut ++ paramLock ++ paramEnv) $ do++ sh <- delayedExtent++ imapFromTo start end $ \i -> do++ ix <- indexOfInt sh i+ ix' <- app1 project ix++ -- project element onto the destination array and (atomically) update+ unless (ignore ix') $ do+ j <- intOfIndex (irArrayShape arrOut) ix'+ x <- app1 delayedLinearIndex i++ atomically arrLock j $ do+ y <- readArray arrOut j+ r <- app2 combine x y+ writeArray arrOut j r++ return_+++-- Atomically execute the critical section only when the lock at the given array+-- index is obtained. The thread spins waiting for the lock to be released and+-- there is no backoff strategy in case the lock is contended.+--+-- It is important that the thread loops trying to acquire the lock without+-- writing data anything until the lock value changes. Then, because of MESI+-- caching protocols there will be no bus traffic while the CPU waits for the+-- value to change.+--+-- <https://en.wikipedia.org/wiki/Spinlock#Significant_optimizations>+--+atomically+ :: IRArray (Vector Word8)+ -> IR Int+ -> CodeGen a+ -> CodeGen a+atomically barriers i action = do+ let+ lock = integral integralType 1+ unlock = integral integralType 0+ unlocked = lift 0+ --+ spin <- newBlock "spinlock.entry"+ crit <- newBlock "spinlock.critical-section"+ exit <- newBlock "spinlock.exit"++ addr <- instr' $ GetElementPtr (asPtr defaultAddrSpace (op integralType (irArrayData barriers))) [op integralType i]+ _ <- br spin++ -- Atomically (attempt to) set the lock slot to the locked state. If the slot+ -- was unlocked we just acquired it, otherwise the state remains unchanged and+ -- we spin until it becomes available.+ setBlock spin+ old <- instr $ AtomicRMW integralType NonVolatile Exchange addr lock (CrossThread, Acquire)+ ok <- A.eq scalarType old unlocked+ _ <- cbr ok crit spin++ -- We just acquired the lock; perform the critical section then release the+ -- lock and exit. For ("some") x86 processors, an unlocked MOV instruction+ -- could be used rather than the slower XCHG, due to subtle memory ordering+ -- rules.+ setBlock crit+ r <- action+ _ <- instr $ AtomicRMW integralType NonVolatile Exchange addr unlock (CrossThread, Release)+ _ <- br exit++ setBlock exit+ return r+++-- Helper functions+-- ----------------++-- Test whether the given index is the magic value 'ignore'. This operates+-- strictly rather than performing short-circuit (&&).+--+ignore :: forall ix. Shape ix => IR ix -> CodeGen (IR Bool)+ignore (IR ix) = go (S.eltType (undefined::ix)) (S.fromElt (S.ignore::ix)) ix+ where+ go :: TupleType t -> t -> Operands t -> CodeGen (IR Bool)+ go UnitTuple () OP_Unit = return (lift True)+ go (PairTuple tsh tsz) (ish, isz) (OP_Pair sh sz) = do x <- go tsh ish sh+ y <- go tsz isz sz+ land' x y+ go (SingleTuple t) ig sz = A.eq t (ir t (scalar t ig)) (ir t (op' t sz))+
+ Data/Array/Accelerate/LLVM/Native/CodeGen/Scan.hs view
@@ -0,0 +1,814 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.CodeGen.Scan+-- Copyright : [2014..2017] 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.LLVM.Native.CodeGen.Scan+ where++-- accelerate+import Data.Array.Accelerate.Analysis.Match+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Type++import Data.Array.Accelerate.LLVM.Analysis.Match+import Data.Array.Accelerate.LLVM.CodeGen.Arithmetic as A+import Data.Array.Accelerate.LLVM.CodeGen.Array+import Data.Array.Accelerate.LLVM.CodeGen.Base+import Data.Array.Accelerate.LLVM.CodeGen.Environment+import Data.Array.Accelerate.LLVM.CodeGen.Exp+import Data.Array.Accelerate.LLVM.CodeGen.IR ( IR )+import Data.Array.Accelerate.LLVM.CodeGen.Loop+import Data.Array.Accelerate.LLVM.CodeGen.Monad+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Native.CodeGen.Base+import Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+import Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+import Data.Array.Accelerate.LLVM.Native.Target ( Native )++import Control.Applicative+import Control.Monad+import Data.String ( fromString )+import Data.Coerce as Safe+import Prelude as P+++data Direction = L | R++-- 'Data.List.scanl' style left-to-right exclusive scan, but with the+-- restriction that the combination function must be associative to enable+-- efficient parallel implementation.+--+-- > scanl (+) 10 (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> Array (Z :. 11) [10,10,11,13,16,20,25,31,38,46,55]+--+mkScanl+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e))+mkScanl aenv combine seed arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = foldr1 (+++) <$> sequence [ mkScanS L aenv combine (Just seed) arr+ , mkScanP L aenv combine (Just seed) arr+ , mkScanFill aenv seed+ ]+ --+ | otherwise+ = (+++) <$> mkScanS L aenv combine (Just seed) arr+ <*> mkScanFill aenv seed+++-- 'Data.List.scanl1' style left-to-right inclusive scan, but with the+-- restriction that the combination function must be associative to enable+-- efficient parallel implementation. The array must not be empty.+--+-- > scanl1 (+) (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> Array (Z :. 10) [0,1,3,6,10,15,21,28,36,45]+--+mkScanl1+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e))+mkScanl1 aenv combine arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = (+++) <$> mkScanS L aenv combine Nothing arr+ <*> mkScanP L aenv combine Nothing arr+ --+ | otherwise+ = mkScanS L aenv combine Nothing arr+++-- Variant of 'scanl' where the final result is returned in a separate array.+--+-- > scanr' (+) 10 (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> ( Array (Z :. 10) [10,10,11,13,16,20,25,31,38,46]+-- , Array Z [55]+-- )+--+mkScanl'+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e, Array sh e))+mkScanl' aenv combine seed arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = foldr1 (+++) <$> sequence [ mkScan'S L aenv combine seed arr+ , mkScan'P L aenv combine seed arr+ , mkScan'Fill aenv seed+ ]+ --+ | otherwise+ = (+++) <$> mkScan'S L aenv combine seed arr+ <*> mkScan'Fill aenv seed+++-- 'Data.List.scanr' style right-to-left exclusive scan, but with the+-- restriction that the combination function must be associative to enable+-- efficient parallel implementation.+--+-- > scanr (+) 10 (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> Array (Z :. 11) [55,55,54,52,49,45,40,34,27,19,10]+--+mkScanr+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e))+mkScanr aenv combine seed arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = foldr1 (+++) <$> sequence [ mkScanS R aenv combine (Just seed) arr+ , mkScanP R aenv combine (Just seed) arr+ , mkScanFill aenv seed+ ]+ --+ | otherwise+ = (+++) <$> mkScanS R aenv combine (Just seed) arr+ <*> mkScanFill aenv seed+++-- 'Data.List.scanr1' style right-to-left inclusive scan, but with the+-- restriction that the combination function must be associative to enable+-- efficient parallel implementation. The array must not be empty.+--+-- > scanr (+) 10 (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> Array (Z :. 10) [45,45,44,42,39,35,30,24,17,9]+--+mkScanr1+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e))+mkScanr1 aenv combine arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = (+++) <$> mkScanS R aenv combine Nothing arr+ <*> mkScanP R aenv combine Nothing arr+ --+ | otherwise+ = mkScanS R aenv combine Nothing arr+++-- Variant of 'scanr' where the final result is returned in a separate array.+--+-- > scanr' (+) 10 (use $ fromList (Z :. 10) [0..])+-- >+-- > ==> ( Array (Z :. 10) [55,54,52,49,45,40,34,27,19,10]+-- , Array Z [55]+-- )+--+mkScanr'+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e, Array sh e))+mkScanr' aenv combine seed arr+ | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)+ = foldr1 (+++) <$> sequence [ mkScan'S R aenv combine seed arr+ , mkScan'P R aenv combine seed arr+ , mkScan'Fill aenv seed+ ]+ --+ | otherwise+ = (+++) <$> mkScan'S R aenv combine seed arr+ <*> mkScan'Fill aenv seed+++-- If the innermost dimension of an exclusive scan is empty, then we just fill+-- the result with the seed element.+--+mkScanFill+ :: (Shape sh, Elt e)+ => Gamma aenv+ -> IRExp Native aenv e+ -> CodeGen (IROpenAcc Native aenv (Array sh e))+mkScanFill aenv seed =+ mkGenerate aenv (IRFun1 (const seed))++mkScan'Fill+ :: forall aenv sh e. (Shape sh, Elt e)+ => Gamma aenv+ -> IRExp Native aenv e+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e, Array sh e))+mkScan'Fill aenv seed =+ Safe.coerce <$> (mkScanFill aenv seed :: CodeGen (IROpenAcc Native aenv (Array sh e)))+++-- A single thread sequentially scans along an entire innermost dimension. For+-- inclusive scans we can assume that the innermost-dimension is at least one+-- element.+--+-- Note that we can use this both when there is a single thread, or in parallel+-- where threads are scheduled over the outer dimensions (segments).+--+mkScanS+ :: forall aenv sh e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e))+mkScanS dir aenv combine mseed IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array (sh:.Int) e))+ paramEnv = envParam aenv+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ in+ makeOpenAcc "scanS" (paramGang ++ paramOut ++ paramEnv) $ do++ sz <- indexHead <$> delayedExtent+ szp1 <- A.add numType sz (lift 1)+ szm1 <- A.sub numType sz (lift 1)++ -- loop over each lower-dimensional index (segment)+ imapFromTo start end $ \seg -> do++ -- index i* is the index that we will read data from. Recall that the+ -- supremum index is exclusive+ i0 <- case dir of+ L -> A.mul numType sz seg+ R -> do x <- A.mul numType sz seg+ y <- A.add numType szm1 x+ return y++ -- index j* is the index that we write to. Recall that for exclusive scans+ -- the output array inner dimension is one larger than the input.+ j0 <- case mseed of+ Nothing -> return i0 -- merge 'i' and 'j' indices whenever we can+ Just{} -> case dir of+ L -> A.mul numType szp1 seg+ R -> do x <- A.mul numType szp1 seg+ y <- A.add numType x sz+ return y++ -- Evaluate or read the initial element. Update the read-from index+ -- appropriately.+ (v0,i1) <- case mseed of+ Just seed -> (,) <$> seed <*> pure i0+ Nothing -> (,) <$> app1 delayedLinearIndex i0 <*> next i0++ -- Write first element, then continue looping through the rest+ writeArray arrOut j0 v0+ j1 <- next j0++ iz <- case dir of+ L -> A.add numType i0 sz+ R -> A.sub numType i0 sz++ let cont i = case dir of+ L -> A.lt scalarType i iz+ R -> A.gt scalarType i iz++ void $ while (cont . A.fst3)+ (\(A.untrip -> (i,j,v)) -> do+ u <- app1 delayedLinearIndex i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ writeArray arrOut j v'+ A.trip <$> next i <*> next j <*> pure v')+ (A.trip i1 j1 v0)++ return_+++mkScan'S+ :: forall aenv sh e. (Shape sh, Elt e)+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Array (sh:.Int) e)+ -> CodeGen (IROpenAcc Native aenv (Array (sh:.Int) e, Array sh e))+mkScan'S dir aenv combine seed IRDelayed{..} =+ let+ (start, end, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Array (sh:.Int) e))+ (arrSum, paramSum) = mutableArray ("sum" :: Name (Array sh e))+ paramEnv = envParam aenv+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ in+ makeOpenAcc "scanS" (paramGang ++ paramOut ++ paramSum ++ paramEnv) $ do++ sz <- indexHead <$> delayedExtent+ szm1 <- A.sub numType sz (lift 1)++ -- iterate over each lower-dimensional index (segment)+ imapFromTo start end $ \seg -> do++ -- index to read data from+ i0 <- case dir of+ L -> A.mul numType seg sz+ R -> do x <- A.mul numType sz seg+ y <- A.add numType x szm1+ return y++ -- initial element+ v0 <- seed++ iz <- case dir of+ L -> A.add numType i0 sz+ R -> A.sub numType i0 sz++ let cont i = case dir of+ L -> A.lt scalarType i iz+ R -> A.gt scalarType i iz++ -- Loop through the input. Only at the top of the loop to we write the+ -- carry-in value (i.e. value from the last loop iteration) to the output+ -- array. This ensures correct behaviour if the input array was empty.+ r <- while (cont . A.fst)+ (\(A.unpair -> (i,v)) -> do+ writeArray arrOut i v++ u <- app1 delayedLinearIndex i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ i' <- next i+ return $ A.pair i' v')+ (A.pair i0 v0)++ -- write final reduction result+ writeArray arrSum seg (A.snd r)++ return_+++mkScanP+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Vector e)+ -> CodeGen (IROpenAcc Native aenv (Vector e))+mkScanP dir aenv combine mseed arr =+ foldr1 (+++) <$> sequence [ mkScanP1 dir aenv combine mseed arr+ , mkScanP2 dir aenv combine+ , mkScanP3 dir aenv combine mseed+ ]++-- Parallel scan, step 1.+--+-- Threads scan a stripe of the input into a temporary array, incorporating the+-- initial element and any fused functions on the way. The final reduction+-- result of this chunk is written to a separate array.+--+mkScanP1+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> IRDelayed Native aenv (Vector e)+ -> CodeGen (IROpenAcc Native aenv (Vector e))+mkScanP1 dir aenv combine mseed IRDelayed{..} =+ let+ (chunk, _, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Vector e))+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ paramEnv = envParam aenv+ --+ steps = local scalarType ("ix.steps" :: Name Int)+ paramSteps = scalarParameter scalarType ("ix.steps" :: Name Int)+ stride = local scalarType ("ix.stride" :: Name Int)+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ firstChunk = case dir of+ L -> lift 0+ R -> steps+ in+ makeOpenAcc "scanP1" (paramGang ++ paramStride : paramSteps : paramOut ++ paramTmp ++ paramEnv) $ do++ len <- indexHead <$> delayedExtent++ -- A thread scans a non-empty stripe of the input, storing the final+ -- reduction result into a separate array.+ --+ -- For exclusive scans the first chunk must incorporate the initial element+ -- into the input and output, while all other chunks increment their output+ -- index by one.+ inf <- A.mul numType chunk stride+ a <- A.add numType inf stride+ sup <- A.min scalarType a len++ -- index i* is the index that we read data from. Recall that the supremum+ -- index is exclusive+ i0 <- case dir of+ L -> return inf+ R -> next sup++ -- index j* is the index that we write to. Recall that for exclusive scan+ -- the output array is one larger than the input; the first chunk uses+ -- this spot to write the initial element, all other chunks shift by one.+ j0 <- case mseed of+ Nothing -> return i0+ Just _ -> case dir of+ L -> if A.eq scalarType chunk firstChunk+ then return i0+ else next i0+ R -> if A.eq scalarType chunk firstChunk+ then return sup+ else return i0++ -- Evaluate/read the initial element for this chunk. Update the read-from+ -- index appropriately+ (v0,i1) <- A.unpair <$> case mseed of+ Just seed -> if A.eq scalarType chunk firstChunk+ then A.pair <$> seed <*> pure i0+ else A.pair <$> app1 delayedLinearIndex i0 <*> next i0+ Nothing -> A.pair <$> app1 delayedLinearIndex i0 <*> next i0++ -- Write first element+ writeArray arrOut j0 v0+ j1 <- next j0++ -- Continue looping through the rest of the input+ let cont i =+ case dir of+ L -> A.lt scalarType i sup+ R -> A.gte scalarType i inf++ r <- while (cont . A.fst3)+ (\(A.untrip -> (i,j,v)) -> do+ u <- app1 delayedLinearIndex i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ writeArray arrOut j v'+ A.trip <$> next i <*> next j <*> pure v')+ (A.trip i1 j1 v0)++ -- Final reduction result of this chunk+ writeArray arrTmp chunk (A.thd3 r)++ return_+++-- Parallel scan, step 2.+--+-- A single thread performs an in-place inclusive scan of the partial block+-- sums. This forms the carry-in value which are added to the stripe partial+-- results in the final step.+--+mkScanP2+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> CodeGen (IROpenAcc Native aenv (Vector e))+mkScanP2 dir aenv combine =+ let+ (start, end, paramGang) = gangParam+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ paramEnv = envParam aenv+ --+ cont i = case dir of+ L -> A.lt scalarType i end+ R -> A.gte scalarType i start++ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ in+ makeOpenAcc "scanP2" (paramGang ++ paramTmp ++ paramEnv) $ do++ i0 <- case dir of+ L -> return start+ R -> next end++ v0 <- readArray arrTmp i0+ i1 <- next i0++ void $ while (cont . A.fst)+ (\(A.unpair -> (i,v)) -> do+ u <- readArray arrTmp i+ i' <- next i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ writeArray arrTmp i v'+ return $ A.pair i' v')+ (A.pair i1 v0)++ return_+++-- Parallel scan, step 3.+--+-- Threads combine every element of the partial block results with the carry-in+-- value computed from step 2.+--+-- Note that we launch (chunks-1) threads, because the first chunk does not need+-- extra processing (has no carry-in value).+--+mkScanP3+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> Maybe (IRExp Native aenv e)+ -> CodeGen (IROpenAcc Native aenv (Vector e))+mkScanP3 dir aenv combine mseed =+ let+ (chunk, _, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Vector e))+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ paramEnv = envParam aenv+ --+ stride = local scalarType ("ix.stride" :: Name Int)+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ prev i = case dir of+ L -> A.sub numType i (lift 1)+ R -> A.add numType i (lift 1)+ in+ makeOpenAcc "scanP3" (paramGang ++ paramStride : paramOut ++ paramTmp ++ paramEnv) $ do++ -- Determine which chunk will be carrying in values for. Compute appropriate+ -- start and end indices.+ a <- case dir of+ L -> next chunk+ R -> pure chunk++ b <- A.mul numType a stride+ c <- A.add numType b stride+ d <- A.min scalarType c (indexHead (irArrayShape arrOut))++ (inf,sup) <- case (dir,mseed) of+ (L,Just _) -> (,) <$> next b <*> next d+ _ -> (,) <$> pure b <*> pure d++ -- Carry in value from the previous chunk+ e <- case dir of+ L -> pure chunk+ R -> prev chunk+ carry <- readArray arrTmp e++ imapFromTo inf sup $ \i -> do+ x <- readArray arrOut i+ y <- case dir of+ L -> app2 combine carry x+ R -> app2 combine x carry+ writeArray arrOut i y++ return_+++mkScan'P+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Vector e)+ -> CodeGen (IROpenAcc Native aenv (Vector e, Scalar e))+mkScan'P dir aenv combine seed arr =+ foldr1 (+++) <$> sequence [ mkScan'P1 dir aenv combine seed arr+ , mkScan'P2 dir aenv combine+ , mkScan'P3 dir aenv combine+ ]++-- Parallel scan', step 1+--+-- Threads scan a stripe of the input into a temporary array. Similar to+-- exclusive scan, but since the size of the output array is the same as the+-- input, input and output indices are shifted by one.+--+mkScan'P1+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> IRExp Native aenv e+ -> IRDelayed Native aenv (Vector e)+ -> CodeGen (IROpenAcc Native aenv (Vector e, Scalar e))+mkScan'P1 dir aenv combine seed IRDelayed{..} =+ let+ (chunk, _, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Vector e))+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ paramEnv = envParam aenv+ --+ steps = local scalarType ("ix.steps" :: Name Int)+ paramSteps = scalarParameter scalarType ("ix.steps" :: Name Int)+ stride = local scalarType ("ix.stride" :: Name Int)+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)++ firstChunk = case dir of+ L -> lift 0+ R -> steps+ in+ makeOpenAcc "scanP1" (paramGang ++ paramStride : paramSteps : paramOut ++ paramTmp ++ paramEnv) $ do++ -- Compute the start and end indices for this non-empty chunk of the input.+ --+ len <- indexHead <$> delayedExtent+ inf <- A.mul numType chunk stride+ a <- A.add numType inf stride+ sup <- A.min scalarType a len++ -- index i* is the index that we pull data from.+ i0 <- case dir of+ L -> return inf+ R -> next sup++ -- index j* is the index that we write results to. The first chunk needs to+ -- include the initial element, and all other chunks shift their results+ -- across by one to make space.+ j0 <- if A.eq scalarType chunk firstChunk+ then pure i0+ else next i0++ -- Evaluate/read the initial element. Update the read-from index+ -- appropriately.+ (v0,i1) <- A.unpair <$> if A.eq scalarType chunk firstChunk+ then A.pair <$> seed <*> pure i0+ else A.pair <$> app1 delayedLinearIndex i0 <*> pure j0++ -- Write the first element+ writeArray arrOut j0 v0+ j1 <- next j0++ -- Continue looping through the rest of the input+ let cont i =+ case dir of+ L -> A.lt scalarType i sup+ R -> A.gte scalarType i inf++ r <- while (cont . A.fst3)+ (\(A.untrip-> (i,j,v)) -> do+ u <- app1 delayedLinearIndex i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ writeArray arrOut j v'+ A.trip <$> next i <*> next j <*> pure v')+ (A.trip i1 j1 v0)++ -- Write the final reduction result of this chunk+ writeArray arrTmp chunk (A.thd3 r)++ return_+++-- Parallel scan', step 2+--+-- Identical to mkScanP2, except we store the total scan result into a separate+-- array (rather than discard it).+--+mkScan'P2+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> CodeGen (IROpenAcc Native aenv (Vector e, Scalar e))+mkScan'P2 dir aenv combine =+ let+ (start, end, paramGang) = gangParam+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ (arrSum, paramSum) = mutableArray ("sum" :: Name (Scalar e))+ paramEnv = envParam aenv+ --+ cont i = case dir of+ L -> A.lt scalarType i end+ R -> A.gte scalarType i start++ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ in+ makeOpenAcc "scanP2" (paramGang ++ paramSum ++ paramTmp ++ paramEnv) $ do++ i0 <- case dir of+ L -> return start+ R -> next end++ v0 <- readArray arrTmp i0+ i1 <- next i0++ r <- while (cont . A.fst)+ (\(A.unpair -> (i,v)) -> do+ u <- readArray arrTmp i+ i' <- next i+ v' <- case dir of+ L -> app2 combine v u+ R -> app2 combine u v+ writeArray arrTmp i v'+ return $ A.pair i' v')+ (A.pair i1 v0)++ writeArray arrSum (lift 0 :: IR Int) (A.snd r)++ return_+++-- Parallel scan', step 3+--+-- Similar to mkScanP3, except that indices are shifted by one since the output+-- array is the same size as the input (despite being an exclusive scan).+--+-- Launch (chunks-1) threads, because the first chunk does not need extra+-- processing.+--+mkScan'P3+ :: forall aenv e. Elt e+ => Direction+ -> Gamma aenv+ -> IRFun2 Native aenv (e -> e -> e)+ -> CodeGen (IROpenAcc Native aenv (Vector e, Scalar e))+mkScan'P3 dir aenv combine =+ let+ (chunk, _, paramGang) = gangParam+ (arrOut, paramOut) = mutableArray ("out" :: Name (Vector e))+ (arrTmp, paramTmp) = mutableArray ("tmp" :: Name (Vector e))+ paramEnv = envParam aenv+ --+ stride = local scalarType ("ix.stride" :: Name Int)+ paramStride = scalarParameter scalarType ("ix.stride" :: Name Int)+ --+ next i = case dir of+ L -> A.add numType i (lift 1)+ R -> A.sub numType i (lift 1)+ prev i = case dir of+ L -> A.sub numType i (lift 1)+ R -> A.add numType i (lift 1)+ in+ makeOpenAcc "scanP3" (paramGang ++ paramStride : paramOut ++ paramTmp ++ paramEnv) $ do++ -- Determine which chunk we will be carrying in the values of, and compute+ -- the appropriate start and end indices+ a <- case dir of+ L -> next chunk+ R -> pure chunk++ b <- A.mul numType a stride+ c <- A.add numType b stride+ d <- A.min scalarType c (indexHead (irArrayShape arrOut))++ inf <- next b+ sup <- next d++ -- Carry-value from the previous chunk+ e <- case dir of+ L -> pure chunk+ R -> prev chunk++ carry <- readArray arrTmp e++ imapFromTo inf sup $ \i -> do+ x <- readArray arrOut i+ y <- case dir of+ L -> app2 combine carry x+ R -> app2 combine x carry+ writeArray arrOut i y++ return_+
+ Data/Array/Accelerate/LLVM/Native/Compile.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Compile+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Compile (++ module Data.Array.Accelerate.LLVM.Compile,+ module Data.Array.Accelerate.LLVM.Native.Compile.Module,+ ExecutableR(..),++) where++-- llvm-general+import LLVM.AST hiding ( Module )+import LLVM.Module as LLVM hiding ( Module )+import LLVM.Context+import LLVM.Target+import LLVM.ExecutionEngine++-- accelerate+import Data.Array.Accelerate.Error ( internalError )+import Data.Array.Accelerate.Trafo ( DelayedOpenAcc )++import Data.Array.Accelerate.LLVM.CodeGen+import Data.Array.Accelerate.LLVM.Compile+import Data.Array.Accelerate.LLVM.State+import Data.Array.Accelerate.LLVM.CodeGen.Environment ( Gamma )+import Data.Array.Accelerate.LLVM.CodeGen.Module ( unModule )++import Data.Array.Accelerate.LLVM.Native.Compile.Link+import Data.Array.Accelerate.LLVM.Native.Compile.Module+import Data.Array.Accelerate.LLVM.Native.Compile.Optimise++import Data.Array.Accelerate.LLVM.Native.CodeGen ( )+import Data.Array.Accelerate.LLVM.Native.Foreign ( )+import Data.Array.Accelerate.LLVM.Native.Target+import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug++-- standard library+import Control.Monad.Except ( runExceptT )+import Control.Monad.State+import Data.Maybe+++instance Compile Native where+ data ExecutableR Native = NativeR { executableR :: Module }+ compileForTarget = compileForNativeTarget++instance Intrinsic Native+++-- Compile an Accelerate expression for the native CPU target.+--+compileForNativeTarget :: DelayedOpenAcc aenv a -> Gamma aenv -> LLVM Native (ExecutableR Native)+compileForNativeTarget acc aenv = do+ target <- gets llvmTarget++ -- Generate code for this Acc operation+ --+ let ast = unModule (llvmOfOpenAcc target acc aenv)+ triple = fromMaybe "" (moduleTargetTriple ast)+ datalayout = moduleDataLayout ast++ -- Lower the generated LLVM to an executable function(s)+ --+ mdl <- liftIO .+ compileModule $ \k ->+ withContext $ \ctx ->+ runExcept $ withModuleFromAST ctx ast $ \mdl ->+ runExcept $ withNativeTargetMachine $ \machine ->+ withTargetLibraryInfo triple $ \libinfo -> do+ optimiseModule datalayout (Just machine) (Just libinfo) mdl++ Debug.when Debug.verbose $ do+ Debug.traceIO Debug.dump_cc =<< moduleLLVMAssembly mdl+ Debug.traceIO Debug.dump_asm =<< runExcept (moduleTargetAssembly machine mdl)++ withMCJIT ctx opt model ptrelim fast $ \mcjit -> do+ withModuleInEngine mcjit mdl $ \exe -> do+ k =<< getGlobalFunctions ast exe++ return $ NativeR mdl++ where+ runExcept = either ($internalError "compileForNativeTarget") return <=< runExceptT++ opt = Just 3 -- optimisation level+ model = Nothing -- code model?+ ptrelim = Nothing -- True to disable frame pointer elimination+ fast = Just True -- True to enable fast instruction selection+
+ Data/Array/Accelerate/LLVM/Native/Compile/Link.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Compile.Link+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Compile.Link+ where++-- llvm-hs+import LLVM.AST+import LLVM.AST.Global+import LLVM.ExecutionEngine++-- accelerate+import Data.Array.Accelerate.Error++-- standard library+import Data.Maybe+++-- | Return function pointers to all of the global function definitions in the+-- given executable module.+--+getGlobalFunctions+ :: ExecutionEngine e f+ => Module+ -> ExecutableModule e+ -> IO [(String, f)]+getGlobalFunctions ast exe+ = mapM (\f -> (f,) `fmap` link f)+ $ globalFunctions (moduleDefinitions ast)+ where+ link f = fromMaybe ($internalError "link" "function not found") `fmap` getFunction exe (Name f)+++-- | Extract the names of the function definitions from a module+--+-- TLM: move this somewhere it can be shared between Native/NVVM backend+--+globalFunctions :: [Definition] -> [String]+globalFunctions defs =+ [ n | GlobalDefinition Function{..} <- defs+ , not (null basicBlocks)+ , let Name n = name+ ]+
+ Data/Array/Accelerate/LLVM/Native/Compile/Module.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Compile.Module+-- Copyright : [2014..2017] 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.LLVM.Native.Compile.Module (++ Module,+ compileModule,+ execute, executeMain,+ nm,++) where++-- accelerate+import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Lifetime+import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug++-- library+import Control.Exception+import Control.Concurrent+import Data.List+import Foreign.LibFFI+import Foreign.Ptr+import Text.Printf+++-- | An encapsulation of the callable functions resulting from compiling+-- a module.+--+data Module = Module {-# UNPACK #-} !(Lifetime FunctionTable)++data FunctionTable = FunctionTable { functionTable :: [Function] }+type Function = (String, FunPtr ())++instance Show Module where+ showsPrec p (Module m)+ = showsPrec p (unsafeGetValue m)++instance Show FunctionTable where+ showsPrec _ f+ = showString "<<"+ . showString (intercalate "," [ n | (n,_) <- functionTable f ])+ . showString ">>"+++-- | Execute a named function that was defined in the module. An error is thrown+-- if the requested function is not define in the module.+--+-- The final argument is a continuation to which we pass a function you can call+-- to actually execute the foreign function.+--+{-# INLINEABLE execute #-}+execute+ :: Module+ -> String+ -> ((String, [Arg] -> IO ()) -> IO a)+ -> IO a+execute mdl@(Module ft) name k =+ withLifetime ft $ \FunctionTable{..} ->+ case lookup name functionTable of+ Just f -> k (name, \argv -> callFFI f retVoid argv)+ Nothing -> $internalError "execute" (printf "function '%s' not found in module: %s\n" name (show mdl))+++-- | Execute the 'main' function of a module, which is just the first function+-- defined in the module.+--+{-# INLINEABLE executeMain #-}+executeMain+ :: Module+ -> ((String, [Arg] -> IO ()) -> IO a)+ -> IO a+executeMain (Module ft) k =+ withLifetime ft $ \FunctionTable{..} ->+ case functionTable of+ [] -> $internalError "executeMain" "no functions defined in module"+ (name,f):_ -> k (name, \argv -> callFFI f retVoid argv)+++-- | Display the global (external) symbol table for this module.+--+nm :: Module -> IO [String]+nm (Module ft) =+ withLifetime ft $ \FunctionTable{..} ->+ return $ map fst functionTable+++-- Compile a given module into executable code.+--+-- Note: [Executing JIT-compiled functions]+--+-- We have the problem that the llvm-general functions dealing with the FFI are+-- exposed as bracketed 'with*' operations, rather than as separate+-- 'create*'/'destroy*' pairs. This is a good design that guarantees that+-- functions clean up their resources on exit, but also means that we can't+-- return a function pointer to the compiled code from within the bracketed+-- expression, because it will no longer be valid once we get around to+-- executing it, as it has already been deallocated!+--+-- This function provides a wrapper that does the compilation step (first+-- argument) in a separate thread, returns the compiled functions, then waits+-- until they are no longer needed before allowing the finalisation routines to+-- proceed.+--+compileModule :: (([Function] -> IO ()) -> IO ()) -> IO Module+compileModule compile = mask $ \restore -> do+ main <- myThreadId+ mfuns <- newEmptyMVar+ mdone <- newEmptyMVar+ _ <- forkIO . reflectExceptionsTo main . restore . compile $ \funs -> do+ putMVar mfuns funs+ takeMVar mdone -- thread blocks, keeping 'funs' alive+ message "worker thread shutting down" -- we better have a matching message from 'finalise'+ --+ funs <- takeMVar mfuns+ ftab <- newLifetime (FunctionTable funs)+ addFinalizer ftab (finalise mdone)+ return (Module ftab)++reflectExceptionsTo :: ThreadId -> IO () -> IO ()+reflectExceptionsTo tid action =+ catchNonThreadKilled action (throwTo tid)++catchNonThreadKilled :: IO a -> (SomeException -> IO a) -> IO a+catchNonThreadKilled action handler =+ action `catch` \e ->+ case fromException e of+ Just ThreadKilled -> throwIO e+ _ -> handler e++finalise :: MVar () -> IO ()+finalise done = do+ message "finalising function table"+ putMVar done ()+++-- Debug+-- -----++{-# INLINE message #-}+message :: String -> IO ()+message msg = Debug.traceIO Debug.dump_exec ("exec: " ++ msg)+
+ Data/Array/Accelerate/LLVM/Native/Compile/Optimise.hs view
@@ -0,0 +1,143 @@+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Compile.Optimise+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Compile.Optimise (++ optimiseModule++) where++-- llvm-hs+import LLVM.AST.DataLayout+import LLVM.Module+import LLVM.PassManager+import LLVM.Target++-- accelerate+import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug++-- standard library+import Text.Printf+++-- | Run the standard optimisations on the given module when targeting a+-- specific machine and data layout. Specifically, this will run the+-- optimisation passes such that LLVM has the necessary information to+-- automatically vectorise loops (whenever it deems beneficial to do so).+--+optimiseModule+ :: Maybe DataLayout+ -> Maybe TargetMachine+ -> Maybe TargetLibraryInfo+ -> Module+ -> IO ()+optimiseModule datalayout machine libinfo mdl = do++ let p1 = defaultCuratedPassSetSpec+ { optLevel = Just 3+ , dataLayout = datalayout+ , targetMachine = machine+ , targetLibraryInfo = libinfo+ , loopVectorize = Just True+ , superwordLevelParallelismVectorize = Just True+ }+ b1 <- withPassManager p1 $ \pm -> runPassManager pm mdl++ Debug.traceIO Debug.dump_cc $+ printf "llvm: optimisation did work? %s" (show b1)++{--+-- The first gentle optimisation pass. I think this is usually done when loading+-- the module?+--+-- This is the first section of output running 'opt -O3 -debug-pass=Arguments'+--+-- Pass Arguments:+-- -datalayout -notti -basictti -x86tti -no-aa -tbaa -targetlibinfo -basicaa+-- -preverify -domtree -verify -simplifycfg -domtree -sroa -early-cse+-- -lower-expect+--+prepass :: [Pass]+prepass =+ [ SimplifyControlFlowGraph+ , ScalarReplacementOfAggregates { requiresDominatorTree = True }+ , EarlyCommonSubexpressionElimination+ , LowerExpectIntrinsic+ ]++-- The main optimisation pipeline. This mostly matches the process of running+-- 'opt -O3 -debug-pass=Arguments'. We are missing dead argument elimination and+-- in particular, slp-vectorizer (super-word level parallelism).+--+-- Pass Arguments:+-- -targetlibinfo -datalayout -notti -basictti -x86tti -no-aa -tbaa -basicaa+-- -globalopt -ipsccp -deadargelim -instcombine -simplifycfg -basiccg -prune-eh+-- -inline-cost -inline -functionattrs -argpromotion -sroa -domtree -early-cse+-- -lazy-value-info -jump-threading -correlated-propagation -simplifycfg+-- -instcombine -tailcallelim -simplifycfg -reassociate -domtree -loops+-- -loop-simplify -lcssa -loop-rotate -licm -lcssa -loop-unswitch -instcombine+-- -scalar-evolution -loop-simplify -lcssa -indvars -loop-idiom -loop-deletion+-- -loop-unroll -memdep -gvn -memdep -memcpyopt -sccp -instcombine+-- -lazy-value-info -jump-threading -correlated-propagation -domtree -memdep -dse+-- -loops -scalar-evolution -slp-vectorizer -adce -simplifycfg -instcombine+-- -barrier -domtree -loops -loop-simplify -lcssa -scalar-evolution+-- -loop-simplify -lcssa -loop-vectorize -instcombine -simplifycfg+-- -strip-dead-prototypes -globaldce -constmerge -preverify -domtree -verify+--+optpass :: [Pass]+optpass =+ [+ InterproceduralSparseConditionalConstantPropagation -- ipsccp+ , InstructionCombining+ , SimplifyControlFlowGraph+ , PruneExceptionHandling+ , FunctionInlining { functionInliningThreshold = 275 } -- -O2 => 275+ , FunctionAttributes+ , ArgumentPromotion -- not needed?+ , ScalarReplacementOfAggregates { requiresDominatorTree = True } -- false?+ , EarlyCommonSubexpressionElimination+ , JumpThreading+ , CorrelatedValuePropagation+ , SimplifyControlFlowGraph+ , InstructionCombining+ , TailCallElimination+ , SimplifyControlFlowGraph+ , Reassociate+ , LoopRotate+ , LoopInvariantCodeMotion+ , LoopClosedSingleStaticAssignment+ , LoopUnswitch { optimizeForSize = False }+ , LoopInstructionSimplify+ , InstructionCombining+ , InductionVariableSimplify+ , LoopIdiom+ , LoopDeletion+ , LoopUnroll { loopUnrollThreshold = Nothing+ , count = Nothing+ , allowPartial = Nothing }+ , GlobalValueNumbering { noLoads = False } -- True to add memory dependency analysis+ , SparseConditionalConstantPropagation+ , InstructionCombining+ , JumpThreading+ , CorrelatedValuePropagation+ , DeadStoreElimination+ , defaultVectorizeBasicBlocks -- instead of slp-vectorizer?+ , AggressiveDeadCodeElimination+ , SimplifyControlFlowGraph+ , InstructionCombining+ , LoopVectorize+ , InstructionCombining+ , SimplifyControlFlowGraph+ , GlobalDeadCodeElimination+ , ConstantMerge+ ]+--}+
+ Data/Array/Accelerate/LLVM/Native/Debug.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Debug+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Debug (++ module Data.Array.Accelerate.Debug,+ module Data.Array.Accelerate.LLVM.Native.Debug,++) where++import Data.Array.Accelerate.Debug hiding ( elapsed )+import qualified Data.Array.Accelerate.Debug as Debug++import Text.Printf+++-- | Display elapsed wall and CPU time, together with speedup fraction+--+{-# INLINEABLE elapsedP #-}+elapsedP :: Double -> Double -> String+elapsedP wallTime cpuTime =+ printf "%s (wall), %s (cpu), %.2f x speedup"+ (showFFloatSIBase (Just 3) 1000 wallTime "s")+ (showFFloatSIBase (Just 3) 1000 cpuTime "s")+ (cpuTime / wallTime)++-- | Display elapsed wall and CPU time+--+{-# INLINEABLE elapsedS #-}+elapsedS :: Double -> Double -> String+elapsedS = Debug.elapsed+
+ Data/Array/Accelerate/LLVM/Native/Execute.hs view
@@ -0,0 +1,517 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Execute+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Execute (++ executeAcc, executeAfun1,++) where++-- accelerate+import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Analysis.Match++import Data.Array.Accelerate.LLVM.Analysis.Match+import Data.Array.Accelerate.LLVM.Execute+import Data.Array.Accelerate.LLVM.State++import Data.Array.Accelerate.LLVM.Native.Array.Data+import Data.Array.Accelerate.LLVM.Native.Compile+import Data.Array.Accelerate.LLVM.Native.Execute.Async+import Data.Array.Accelerate.LLVM.Native.Execute.Environment+import Data.Array.Accelerate.LLVM.Native.Execute.Marshal+import Data.Array.Accelerate.LLVM.Native.Target+import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug++-- Use work-stealing scheduler+import Data.Range.Range ( Range(..) )+import Control.Parallel.Meta ( Executable(..) )+import Data.Array.Accelerate.LLVM.Native.Execute.LBS++-- library+import Data.Word ( Word8 )+import Control.Monad.State ( gets )+import Control.Monad.Trans ( liftIO )+import Prelude hiding ( map, sum, scanl, scanr, init )+import qualified Prelude as P++import Foreign.C+import Foreign.LibFFI ( Arg )+import Foreign.Ptr+++-- 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, we return a reference to the array data. Even though+-- we execute with multiple cores, we assume a shared memory multiprocessor+-- machine.+--+-- 2. If it is a non-skeleton node, such as a let binding or shape conversion,+-- then execute directly by updating the environment or similar.+--+-- 3. If it is a skeleton node, then we need to execute the generated LLVM+-- code.+--+instance Execute Native where+ map = simpleOp+ generate = simpleOp+ transform = simpleOp+ backpermute = simpleOp+ fold = foldOp+ fold1 = fold1Op+ foldSeg = foldSegOp+ fold1Seg = foldSegOp+ scanl = scanOp+ scanl1 = scan1Op+ scanl' = scan'Op+ scanr = scanOp+ scanr1 = scan1Op+ scanr' = scan'Op+ permute = permuteOp+ stencil1 = stencil1Op+ stencil2 = stencil2Op+++-- Skeleton implementation+-- -----------------------++-- Simple kernels just needs to know the shape of the output array.+--+simpleOp+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh+ -> LLVM Native (Array sh e)+simpleOp NativeR{..} gamma aenv () sh = do+ Native{..} <- gets llvmTarget+ liftIO $ do+ out <- allocateArray sh+ executeMain executableR $ \f ->+ executeOp defaultLargePPT fillP f gamma aenv (IE 0 (size sh)) out+ return out++simpleNamed+ :: (Shape sh, Elt e)+ => String+ -> ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh+ -> LLVM Native (Array sh e)+simpleNamed fun NativeR{..} gamma aenv () sh = do+ Native{..} <- gets llvmTarget+ liftIO $ do+ out <- allocateArray sh+ execute executableR fun $ \f ->+ executeOp defaultLargePPT fillP f gamma aenv (IE 0 (size sh)) out+ return out+++-- Note: [Reductions]+--+-- There are two flavours of reduction:+--+-- 1. If we are collapsing to a single value, then threads reduce strips of+-- the input in parallel, and then a single thread reduces the partial+-- reductions to a single value. Load balancing occurs over the input+-- stripes.+--+-- 2. If this is a multidimensional reduction, then each inner dimension is+-- handled by a single thread. Load balancing occurs over the outer+-- dimension indices.+--+-- The entry points to executing the reduction are 'foldOp' and 'fold1Op', for+-- exclusive and inclusive reductions respectively. These functions handle+-- whether the input array is empty. If the input and output arrays are+-- non-empty, we then further dispatch (via 'foldCore') to 'foldAllOp' or+-- 'foldDimOp' for single or multidimensional reductions, respectively.+-- 'foldAllOp' in particular must execute specially whether the gang has+-- multiple worker threads which can process the array in parallel.+--++fold1Op+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> (sh :. Int)+ -> LLVM Native (Array sh e)+fold1Op kernel gamma aenv stream sh@(sx :. sz)+ = $boundsCheck "fold1" "empty array" (sz > 0)+ $ case size sh of+ 0 -> liftIO $ allocateArray sx -- empty, but possibly with non-zero dimensions+ _ -> foldCore kernel gamma aenv stream sh++foldOp+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> (sh :. Int)+ -> LLVM Native (Array sh e)+foldOp kernel gamma aenv stream sh@(sx :. _) =+ case size sh of+ 0 -> simpleNamed "generate" kernel gamma aenv stream (listToShape (P.map (max 1) (shapeToList sx)))+ _ -> foldCore kernel gamma aenv stream sh++foldCore+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> (sh :. Int)+ -> LLVM Native (Array sh e)+foldCore kernel gamma aenv stream sh+ | Just Refl <- matchShapeType sh (undefined::DIM1)+ = foldAllOp kernel gamma aenv stream sh+ --+ | otherwise+ = foldDimOp kernel gamma aenv stream sh++foldAllOp+ :: forall aenv e. Elt e+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> DIM1+ -> LLVM Native (Scalar e)+foldAllOp NativeR{..} gamma aenv () (Z :. sz) = do+ Native{..} <- gets llvmTarget+ let+ ncpu = gangSize+ stride = defaultLargePPT `min` ((sz + ncpu - 1) `quot` ncpu)+ steps = (sz + stride - 1) `quot` stride+ --+ if ncpu == 1 || sz <= defaultLargePPT+ then liftIO $ do+ -- Sequential reduction+ out <- allocateArray Z+ execute executableR "foldAllS" $ \f ->+ executeOp 1 fillS f gamma aenv (IE 0 sz) out+ return out++ else liftIO $ do+ -- Parallel reduction+ out <- allocateArray Z+ tmp <- allocateArray (Z :. steps) :: IO (Vector e)+ --+ execute executableR "foldAllP1" $ \f1 -> do+ execute executableR "foldAllP2" $ \f2 -> do+ executeOp 1 fillP f1 gamma aenv (IE 0 steps) (sz, stride, tmp)+ executeOp 1 fillS f2 gamma aenv (IE 0 steps) (tmp, out)+ --+ return out++foldDimOp+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> (sh :. Int)+ -> LLVM Native (Array sh e)+foldDimOp NativeR{..} gamma aenv () (sh :. sz) = do+ Native{..} <- gets llvmTarget+ let ppt = defaultSmallPPT `max` (defaultLargePPT `quot` (max 1 sz))+ liftIO $ do+ out <- allocateArray sh+ executeMain executableR $ \f ->+ executeOp ppt fillP f gamma aenv (IE 0 (size sh)) (sz, out)+ return out++foldSegOp+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> (sh :. Int)+ -> (Z :. Int)+ -> LLVM Native (Array (sh :. Int) e)+foldSegOp NativeR{..} gamma aenv () (sh :. _) (Z :. ss) = do+ Native{..} <- gets llvmTarget+ let+ ncpu = gangSize+ kernel | ncpu == 1 = "foldSegS"+ | otherwise = "foldSegP"+ n | ncpu == 1 = ss+ | otherwise = ss - 1 -- segments array has been 'scanl (+) 0'`ed+ ppt = n -- for 1D distribute evenly over threads; otherwise+ -- -- compute all segments on an innermost dimension+ liftIO $ do+ out <- allocateArray (sh :. n)+ execute executableR kernel $ \f ->+ executeOp ppt fillP f gamma aenv (IE 0 (size (sh :. n))) out+ return out+++scanOp+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh :. Int+ -> LLVM Native (Array (sh:.Int) e)+scanOp kernel gamma aenv stream (sz :. n) =+ case n of+ 0 -> simpleNamed "generate" kernel gamma aenv stream (sz :. 1)+ _ -> scanCore kernel gamma aenv stream sz n (n+1)++scan1Op+ :: (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh :. Int+ -> LLVM Native (Array (sh:.Int) e)+scan1Op kernel gamma aenv stream (sz :. n)+ = $boundsCheck "scan1" "empty array" (n > 0)+ $ scanCore kernel gamma aenv stream sz n n++scanCore+ :: forall aenv sh e. (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh+ -> Int+ -> Int+ -> LLVM Native (Array (sh:.Int) e)+scanCore NativeR{..} gamma aenv () sz n m = do+ Native{..} <- gets llvmTarget+ let+ ncpu = gangSize+ stride = defaultLargePPT `min` ((n + ncpu - 1) `quot` ncpu)+ steps = (n + stride - 1) `quot` stride+ steps' = steps - 1+ --+ if ncpu == 1 || rank sz > 0 || n <= 2 * defaultLargePPT+ then liftIO $ do+ -- Either:+ --+ -- 1. Sequential scan of an array of any rank+ --+ -- 2. Parallel scan of multidimensional array: threads scan along the+ -- length of the innermost dimension. Threads are scheduled over the+ -- inner dimensions.+ --+ -- 3. Small 1D array. Since parallel scan requires ~4n data transfer+ -- compared to ~2n in the sequential case, it is only worthwhile if+ -- the extra cores can offset the increased bandwidth requirements.+ --+ out <- allocateArray (sz :. m)+ execute executableR "scanS" $ \f ->+ executeOp 1 fillP f gamma aenv (IE 0 (size sz)) out+ return out++ else liftIO $ do+ -- parallel one-dimensional scan+ out <- allocateArray (sz :. m)+ tmp <- allocateArray (Z :. steps) :: IO (Vector e)+ --+ execute executableR "scanP1" $ \f1 -> do+ execute executableR "scanP2" $ \f2 -> do+ execute executableR "scanP3" $ \f3 -> do+ executeOp 1 fillP f1 gamma aenv (IE 0 steps) (stride, steps', out, tmp)+ executeOp 1 fillS f2 gamma aenv (IE 0 steps) tmp+ executeOp 1 fillP f3 gamma aenv (IE 0 steps') (stride, out, tmp)+ --+ return out+++scan'Op+ :: forall aenv sh e. (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh :. Int+ -> LLVM Native (Array (sh:.Int) e, Array sh e)+scan'Op native gamma aenv stream sh@(sz :. n) =+ case n of+ 0 -> do+ out <- liftIO $ allocateArray (sz :. 0)+ sum <- simpleNamed "generate" native gamma aenv stream sz+ return (out, sum)+ --+ _ -> scan'Core native gamma aenv stream sh++scan'Core+ :: forall aenv sh e. (Shape sh, Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> sh :. Int+ -> LLVM Native (Array (sh:.Int) e, Array sh e)+scan'Core NativeR{..} gamma aenv () sh@(sz :. n) = do+ Native{..} <- gets llvmTarget+ let+ ncpu = gangSize+ stride = defaultLargePPT `min` ((n + ncpu - 1) `quot` ncpu)+ steps = (n + stride - 1) `quot` stride+ steps' = steps - 1+ --+ if ncpu == 1 || rank sz > 0 || n <= 2 * defaultLargePPT+ then liftIO $ do+ out <- allocateArray sh+ sum <- allocateArray sz+ execute executableR "scanS" $ \f ->+ executeOp 1 fillP f gamma aenv (IE 0 (size sz)) (out,sum)+ return (out,sum)++ else liftIO $ do+ tmp <- allocateArray (Z :. steps) :: IO (Vector e)+ out <- allocateArray sh+ sum <- allocateArray sz++ execute executableR "scanP1" $ \f1 -> do+ execute executableR "scanP2" $ \f2 -> do+ execute executableR "scanP3" $ \f3 -> do+ executeOp 1 fillP f1 gamma aenv (IE 0 steps) (stride, steps', out, tmp)+ executeOp 1 fillS f2 gamma aenv (IE 0 steps) (sum, tmp)+ executeOp 1 fillP f3 gamma aenv (IE 0 steps') (stride, out, tmp)++ return (out,sum)+++-- Forward permutation, specified by an indexing mapping into an array and a+-- combination function to combine elements.+--+permuteOp+ :: (Shape sh, Shape sh', Elt e)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> Bool+ -> sh+ -> Array sh' e+ -> LLVM Native (Array sh' e)+permuteOp NativeR{..} gamma aenv () inplace shIn dfs = do+ Native{..} <- gets llvmTarget+ out <- if inplace+ then return dfs+ else cloneArray dfs+ let+ ncpu = gangSize+ n = size shIn+ m = size (shape out)+ --+ if ncpu == 1 || n <= defaultLargePPT+ then liftIO $ do+ -- sequential permutation+ execute executableR "permuteS" $ \f ->+ executeOp 1 fillS f gamma aenv (IE 0 n) out++ else liftIO $ do+ -- parallel permutation+ symbols <- nm executableR+ if "permuteP_rmw" `elem` symbols+ then do+ execute executableR "permuteP_rmw" $ \f ->+ executeOp defaultLargePPT fillP f gamma aenv (IE 0 n) out++ else do+ barrier@(Array _ adb) <- allocateArray (Z :. m) :: IO (Vector Word8)+ memset (ptrsOfArrayData adb) 0 m+ execute executableR "permuteP_mutex" $ \f ->+ executeOp defaultLargePPT fillP f gamma aenv (IE 0 n) (out, barrier)++ return out+++stencil1Op+ :: (Shape sh, Elt b)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> Array sh a+ -> LLVM Native (Array sh b)+stencil1Op kernel gamma aenv stream arr =+ simpleOp kernel gamma aenv stream (shape arr)++stencil2Op+ :: (Shape sh, Elt c)+ => ExecutableR Native+ -> Gamma aenv+ -> Aval aenv+ -> Stream+ -> Array sh a+ -> Array sh b+ -> LLVM Native (Array sh c)+stencil2Op kernel gamma aenv stream arr brr =+ simpleOp kernel gamma aenv stream (shape arr `intersect` shape brr)+++-- Skeleton execution+-- ------------------++-- Execute the given function distributed over the available threads.+--+executeOp+ :: Marshalable args+ => Int+ -> Executable+ -> (String, [Arg] -> IO ())+ -> Gamma aenv+ -> Aval aenv+ -> Range+ -> args+ -> IO ()+executeOp ppt exe (name, f) gamma aenv r args =+ runExecutable exe name ppt r $ \start end _tid ->+ monitorProcTime $+ f =<< marshal (undefined::Native) () (start, end, args, (gamma, aenv))+++-- Standard C functions+-- --------------------++memset :: Ptr Word8 -> Word8 -> Int -> IO ()+memset p w s = c_memset p (fromIntegral w) (fromIntegral s) >> return ()++foreign import ccall unsafe "string.h memset" c_memset+ :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)+++-- Debugging+-- ---------++monitorProcTime :: IO a -> IO a+monitorProcTime = Debug.withProcessor Debug.Native+
+ Data/Array/Accelerate/LLVM/Native/Execute/Async.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Execute.Async+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Execute.Async (++ Async, Stream, Event,+ module Data.Array.Accelerate.LLVM.Execute.Async,++) where++-- accelerate+import Data.Array.Accelerate.LLVM.Execute.Async hiding ( Async )+import qualified Data.Array.Accelerate.LLVM.Execute.Async as A++import Data.Array.Accelerate.LLVM.Native.Target+++type Async a = A.AsyncR Native a+type Stream = A.StreamR Native+type Event = A.EventR Native++-- The native backend does everything synchronously.+--+instance A.Async Native where+ type StreamR Native = ()+ type EventR Native = ()++ {-# INLINE fork #-}+ fork = return ()++ {-# INLINE join #-}+ join () = return ()++ {-# INLINE checkpoint #-}+ checkpoint () = return ()++ {-# INLINE after #-}+ after () () = return ()++ {-# INLINE block #-}+ block () = return ()+
+ Data/Array/Accelerate/LLVM/Native/Execute/Environment.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Execute.Environment+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Execute.Environment (++ Aval, aprj++) where++-- accelerate+import Data.Array.Accelerate.LLVM.Native.Target+import Data.Array.Accelerate.LLVM.Execute.Environment++type Aval = AvalR Native+
+ Data/Array/Accelerate/LLVM/Native/Execute/LBS.hs view
@@ -0,0 +1,34 @@+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Execute.LBS+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Execute.LBS+ where++-- Some default values for the profitable parallelism threshold (PPT). These are+-- chosen as to reduce the frequency of deque checks. Since a deque check also+-- requires returning from the foreign LLVM function back to the scheduler code,+-- it is important to combine fine-grained iterations via the PPT.+--+-- The large PPT is meant for operations such as @map@ and @generate@, where the+-- input length equates the total number of elements to process. The small PPT+-- is meant for operations such as multidimensional reduction, where each input+-- index corresponds to a non-unit amount of work.+--+-- These should really be dynamic values based on how long it took to execute+-- the last chunk, increase or decrease the chunk size to ensure quick+-- turnaround and also low scheduler overhead.+--+defaultLargePPT :: Int+defaultLargePPT = 4096++defaultSmallPPT :: Int+defaultSmallPPT = 64+
+ Data/Array/Accelerate/LLVM/Native/Execute/Marshal.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ <= 708+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}+#endif+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Execute.Marshal+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Execute.Marshal (++ Marshalable, M.marshal++) where++-- accelerate+import Data.Array.Accelerate.LLVM.CodeGen.Environment ( Gamma, Idx'(..) )+import qualified Data.Array.Accelerate.LLVM.Execute.Marshal as M++import Data.Array.Accelerate.LLVM.Native.Array.Data+import Data.Array.Accelerate.LLVM.Native.Execute.Async+import Data.Array.Accelerate.LLVM.Native.Execute.Environment+import Data.Array.Accelerate.LLVM.Native.Target++-- libraries+import Data.DList ( DList )+import qualified Data.DList as DL+import qualified Data.IntMap as IM+import qualified Foreign.LibFFI as FFI+++-- Instances for the Native backend+--+type Marshalable args = M.Marshalable Native args+type instance M.ArgR Native = FFI.Arg+++-- Instances for handling concrete types in this backend, namely shapes and+-- array data.+--+instance M.Marshalable Native Int where+ marshal' _ _ x = return $ DL.singleton (FFI.argInt x)++instance {-# OVERLAPS #-} M.Marshalable Native (Gamma aenv, Aval aenv) where+ marshal' t s (gamma, aenv)+ = fmap DL.concat+ $ mapM (\(_, Idx' idx) -> M.marshal' t s (sync (aprj idx aenv))) (IM.elems gamma)+ where+ sync (AsyncR () a) = a++instance ArrayElt e => M.Marshalable Native (ArrayData e) where+ marshal' _ _ adata = return $ marshalR arrayElt adata+ where+ marshalR :: ArrayEltR e' -> ArrayData e' -> DList FFI.Arg+ marshalR ArrayEltRunit _ = DL.empty+ marshalR (ArrayEltRpair aeR1 aeR2) ad =+ marshalR aeR1 (fstArrayData ad) `DL.append`+ marshalR aeR2 (sndArrayData ad)+ --+ marshalR ArrayEltRint ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRint8 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRint16 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRint32 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRint64 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRword ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRword8 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRword16 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRword32 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRword64 ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRfloat ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRdouble ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRchar ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcshort ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcushort ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcint ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcuint ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRclong ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRculong ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcllong ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcullong ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcchar ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcschar ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcuchar ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcfloat ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRcdouble ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+ marshalR ArrayEltRbool ad = DL.singleton $ FFI.argPtr (ptrsOfArrayData ad)+
+ Data/Array/Accelerate/LLVM/Native/Foreign.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Foreign+-- Copyright : [2016..2017] 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.LLVM.Native.Foreign (++ -- Foreign functions+ ForeignAcc(..),+ ForeignExp(..),++ -- useful re-exports+ LLVM,+ Native,+ liftIO,+ module Data.Array.Accelerate.LLVM.Native.Array.Data,++) where++import qualified Data.Array.Accelerate.Array.Sugar as S++import Data.Array.Accelerate.LLVM.State+import Data.Array.Accelerate.LLVM.CodeGen.Sugar++import Data.Array.Accelerate.LLVM.Foreign+import Data.Array.Accelerate.LLVM.Native.Array.Data+import Data.Array.Accelerate.LLVM.Native.Target++import Control.Monad.State+import Data.Typeable+++instance Foreign Native where+ foreignAcc _ (ff :: asm (a -> b))+ | Just (ForeignAcc _ asm :: ForeignAcc (a -> b)) <- cast ff = Just (const asm)+ | otherwise = Nothing++ foreignExp _ (ff :: asm (x -> y))+ | Just (ForeignExp _ asm :: ForeignExp (x -> y)) <- cast ff = Just asm+ | otherwise = Nothing+++instance S.Foreign ForeignAcc where+ strForeign (ForeignAcc s _) = s++instance S.Foreign ForeignExp where+ strForeign (ForeignExp s _) = s+++-- Foreign functions in the Native backend.+--+-- This is just some arbitrary monadic computation.+--+data ForeignAcc f where+ ForeignAcc :: String+ -> (a -> LLVM Native b)+ -> ForeignAcc (a -> b)++-- Foreign expressions in the Native backend.+--+-- I'm not sure how useful this is; perhaps we want a way to splice in an+-- arbitrary llvm-general term, which would give us access to instructions not+-- currently encoded in Accelerate (i.e. SIMD operations, struct types, etc.)+--+data ForeignExp f where+ ForeignExp :: String+ -> IRFun1 Native () (x -> y)+ -> ForeignExp (x -> y)++deriving instance Typeable ForeignAcc+deriving instance Typeable ForeignExp+
+ Data/Array/Accelerate/LLVM/Native/State.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE CPP #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.State+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.State (++ evalNative,+ createTarget, defaultTarget,++ Strategy,+ balancedParIO, unbalancedParIO,++) where++-- accelerate+import Control.Parallel.Meta+import Control.Parallel.Meta.Worker+import qualified Control.Parallel.Meta.Trans.LBS as LBS+import qualified Control.Parallel.Meta.Resource.SMP as SMP+import qualified Control.Parallel.Meta.Resource.Single as Single+import qualified Control.Parallel.Meta.Resource.Backoff as Backoff++import Data.Array.Accelerate.LLVM.State+import Data.Array.Accelerate.LLVM.Native.Target++import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug++-- library+import Data.Monoid+import System.IO.Unsafe+import Text.Printf++import GHC.Conc+++-- | Execute a computation in the Native backend+--+evalNative :: Native -> LLVM Native a -> IO a+evalNative = evalLLVM+++-- | Create a Native execution target by spawning a worker thread on each of the+-- given capabilities, and using the given strategy to load balance the workers+-- when executing parallel operations.+--+createTarget+ :: [Int] -- ^ CPU IDs to launch worker threads on+ -> Strategy -- ^ Strategy to balance parallel workloads+ -> IO Native+createTarget caps parallelIO = do+ gang <- forkGangOn caps+ return $! Native (length caps) (sequentialIO gang) (parallelIO gang)+++-- | The strategy for balancing work amongst the available worker threads.+--+type Strategy = Gang -> Executable+++-- | Execute an operation sequentially on a single thread+--+sequentialIO :: Strategy+sequentialIO gang =+ Executable $ \name _ppt range fill ->+ timed name $ runSeqIO gang range fill+++-- | Execute a computation without load balancing. Each thread computes an+-- equally sized chunk of the input. No work stealing occurs.+--+unbalancedParIO :: Strategy+unbalancedParIO gang =+ Executable $ \name _ppt range fill ->+ timed name $ runParIO Single.mkResource gang range fill+++-- | Execute a computation where threads use work stealing (based on lazy+-- splitting of work stealing queues and exponential backoff) in order to+-- automatically balance the workload amongst themselves.+--+balancedParIO+ :: Int -- ^ number of steal attempts before backing off+ -> Strategy+balancedParIO retries gang =+ Executable $ \name ppt range fill ->+ -- TLM: A suitable PPT should be chosen when invoking the continuation in+ -- order to balance scheduler overhead with fine-grained function calls+ --+ let resource = LBS.mkResource ppt (SMP.mkResource retries <> Backoff.mkResource)+ in timed name $ runParIO resource gang range fill+++-- Top-level mutable state+-- -----------------------+--+-- It is important to keep some information alive for the entire run of the+-- program, not just a single execution. These tokens use 'unsafePerformIO' to+-- ensure they are executed only once, and reused for subsequent invocations.+--++-- | Initialise the gang of threads that will be used to execute computations.+-- This spawns one worker on each capability, which can be set via +RTS -Nn.+--+-- This globally shared thread gang is auto-initialised on startup and shared by+-- all computations (unless the user chooses to 'run' with a different gang).+--+-- In a data parallel setting, it does not help to have multiple gangs running+-- at the same time. This is because a single data parallel computation should+-- already be able to keep all threads busy. If we had multiple gangs running at+-- the same time, then the system as a whole would run slower as the gangs+-- contend for cache and thrash the scheduler.+--+{-# NOINLINE defaultTarget #-}+defaultTarget :: Native+defaultTarget = unsafePerformIO $ do+ Debug.traceIO Debug.dump_gc (printf "gc: initialise native target with %d CPUs" numCapabilities)+ case numCapabilities of+ 1 -> createTarget [0] sequentialIO+ n -> createTarget [0 .. n-1] (balancedParIO n)+++-- Debugging+-- ---------++{-# INLINE timed #-}+timed :: String -> IO a -> IO a+timed name f = Debug.timed Debug.dump_exec (elapsed name) f++{-# INLINE elapsed #-}+elapsed :: String -> Double -> Double -> String+elapsed name x y = printf "exec: %s %s" name (Debug.elapsedP x y)+
+ Data/Array/Accelerate/LLVM/Native/Target.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Array.Accelerate.LLVM.Native.Target+-- Copyright : [2014..2017] Trevor L. McDonell+-- [2014..2014] Vinod Grover (NVIDIA Corporation)+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.LLVM.Native.Target (++ module Data.Array.Accelerate.LLVM.Target,+ module Data.Array.Accelerate.LLVM.Native.Target++) where++-- llvm-general+import LLVM.Target hiding ( Target )+import LLVM.AST.DataLayout ( DataLayout )++-- accelerate+import Data.Array.Accelerate.Error ( internalError )++import Data.Array.Accelerate.LLVM.Target ( Target(..) )+import Control.Parallel.Meta ( Executable )++-- standard library+import Control.Monad.Except+import System.IO.Unsafe+++-- | Native machine code JIT execution target+--+data Native = Native {+ gangSize :: {-# UNPACK #-} !Int+ , fillS :: {-# UNPACK #-} !Executable+ , fillP :: {-# UNPACK #-} !Executable+ }++instance Target Native where+ targetTriple _ = Just nativeTargetTriple+ targetDataLayout _ = Just nativeDataLayout+++-- | String that describes the native target+--+{-# NOINLINE nativeTargetTriple #-}+nativeTargetTriple :: String+nativeTargetTriple = unsafePerformIO $+ -- A target triple suitable for loading code into the current process+ getProcessTargetTriple++-- | A description of the various data layout properties that may be used during+-- optimisation.+--+{-# NOINLINE nativeDataLayout #-}+nativeDataLayout :: DataLayout+nativeDataLayout+ = unsafePerformIO+ $ fmap (either ($internalError "nativeDataLayout") id)+ $ runExceptT (withNativeTargetMachine getTargetMachineDataLayout)+++-- | Bracket the creation and destruction of a target machine for the native+-- backend running on this host.+--+withNativeTargetMachine+ :: (TargetMachine -> IO a)+ -> ExceptT String IO a+withNativeTargetMachine = withHostTargetMachine+
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) [2014..2017] 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,2 @@+import Distribution.Simple+main = defaultMain
+ accelerate-llvm-native.cabal view
@@ -0,0 +1,124 @@+name: accelerate-llvm-native+version: 1.0.0.0+cabal-version: >= 1.10+tested-with: GHC == 7.8.*+build-type: Simple++synopsis: Accelerate backend generating LLVM+description:+ This library implements a backend for the /Accelerate/ language which+ generates LLVM-IR targeting multicore CPUs. For further information, refer+ to the main /Accelerate/ package:+ <http://hackage.haskell.org/package/accelerate>++license: BSD3+license-file: LICENSE+author: Trevor L. McDonell+maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+bug-reports: https://github.com/AccelerateHS/accelerate/issues+category: Compilers/Interpreters, Concurrency, Data, Parallelism+++-- Configuration flags+-- -------------------++Flag debug+ Default: True+ Description:+ Enable debug tracing message flags. Note that 'debug' must be enabled in the+ base 'accelerate' package as well. See the 'accelerate' package for usage+ and available options.++Flag bounds-checks+ Default: True+ Description: Enable bounds checking++Flag unsafe-checks+ Default: True+ Description: Enable bounds checking in unsafe operations++Flag internal-checks+ Default: True+ Description: Enable internal consistency checks+++-- Build configuration+-- -------------------++Library+ exposed-modules:+ Data.Array.Accelerate.LLVM.Native+ Data.Array.Accelerate.LLVM.Native.Foreign++ other-modules:+ Data.Array.Accelerate.LLVM.Native.Array.Data+ Data.Array.Accelerate.LLVM.Native.Debug+ Data.Array.Accelerate.LLVM.Native.Execute+ Data.Array.Accelerate.LLVM.Native.State+ Data.Array.Accelerate.LLVM.Native.Target++ Data.Array.Accelerate.LLVM.Native.Compile+ Data.Array.Accelerate.LLVM.Native.Compile.Module+ Data.Array.Accelerate.LLVM.Native.Compile.Link+ Data.Array.Accelerate.LLVM.Native.Compile.Optimise++ Data.Array.Accelerate.LLVM.Native.CodeGen+ Data.Array.Accelerate.LLVM.Native.CodeGen.Base+ Data.Array.Accelerate.LLVM.Native.CodeGen.Fold+ Data.Array.Accelerate.LLVM.Native.CodeGen.FoldSeg+ Data.Array.Accelerate.LLVM.Native.CodeGen.Generate+ Data.Array.Accelerate.LLVM.Native.CodeGen.Loop+ Data.Array.Accelerate.LLVM.Native.CodeGen.Map+ Data.Array.Accelerate.LLVM.Native.CodeGen.Permute+ Data.Array.Accelerate.LLVM.Native.CodeGen.Scan++ Data.Array.Accelerate.LLVM.Native.Execute.Async+ Data.Array.Accelerate.LLVM.Native.Execute.Environment+ Data.Array.Accelerate.LLVM.Native.Execute.LBS+ Data.Array.Accelerate.LLVM.Native.Execute.Marshal++ build-depends:+ base >= 4.7 && < 4.10+ , accelerate == 1.0.*+ , accelerate-llvm == 1.0.*+ , containers >= 0.5 && < 0.6+ , directory >= 1.0+ , dlist >= 0.6+ , fclabels >= 2.0+ , libffi >= 0.1+ , llvm-hs >= 3.9+ , llvm-hs-pure >= 3.9+ , mtl >= 2.2.1+ , time >= 1.4++ default-language:+ Haskell2010++ ghc-options: -O2 -Wall -fwarn-tabs++ if impl(ghc >= 8.0)+ ghc-options: -Wmissed-specialisations++ 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+++source-repository head+ type: git+ location: https://github.com/AccelerateHS/accelerate-llvm.git++source-repository this+ type: git+ tag: 1.0.0.0+ location: https://github.com/AccelerateHS/accelerate-llvm.git++-- vim: nospell