diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,20 @@ +# Change Log + +Notable changes to the project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/) and the +project adheres to the [Haskell Package Versioning +Policy (PVP)](https://pvp.haskell.org) + +## [1.1.0.0] - 2017-09-21 + * [#5]: fix to ignore `sh` parameter in inverse mode + * Drop support for (deprecated) `accelerate-cuda` backend + * Build against FFTW and CUFFT foreign implementations by default + + +## 1.0.0.0 - 2017-03-31 + +[1.1.0.0]: https://github.com/AccelerateHS/accelerate-fft/compare/1.0.0.0...1.1.0.0 + +[#5]: https://github.com/AccelerateHS/accelerate-fft/pull/5 + diff --git a/Data/Array/Accelerate/Math/FFT.hs b/Data/Array/Accelerate/Math/FFT.hs --- a/Data/Array/Accelerate/Math/FFT.hs +++ b/Data/Array/Accelerate/Math/FFT.hs @@ -27,9 +27,9 @@ -- a power-of-two in each dimension. -- -- For performance, compile against the foreign library bindings (using any --- number of '-fcuda', '-fllvm-gpu', and '-fllvm-cpu' for the accelerate-cuda, --- accelerate-llvm-ptx, and accelerate-llvm-native backends respectively), which --- have none of the above restrictions. +-- number of '-fllvm-ptx', and '-fllvm-cpu' for the accelerate-llvm-ptx, and +-- accelerate-llvm-native backends, respectively), which have none of the above +-- restrictions. -- module Data.Array.Accelerate.Math.FFT ( @@ -54,9 +54,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND import qualified Data.Array.Accelerate.Math.FFT.LLVM.PTX as PTX #endif -#ifdef ACCELERATE_CUDA_BACKEND -import qualified Data.Array.Accelerate.Math.FFT.CUDA as CUDA -#endif import Data.Bits import Text.Printf @@ -97,7 +94,7 @@ -> Acc (Array DIM1 (Complex e)) fft1D' mode (Z :. len) arr = let sign = signOfMode mode :: e - scale = P.fromIntegral len + scale = A.fromIntegral (A.length arr) go = #ifdef ACCELERATE_LLVM_NATIVE_BACKEND foreignAcc (Native.fft1D mode) $ @@ -105,9 +102,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND foreignAcc (PTX.fft1D mode) $ #endif -#ifdef ACCELERATE_CUDA_BACKEND - foreignAcc (CUDA.fft1D mode) $ -#endif fft sign Z len in case mode of @@ -144,7 +138,7 @@ -> Acc (Array DIM2 (Complex e)) fft2D' mode (Z :. height :. width) arr = let sign = signOfMode mode :: e - scale = P.fromIntegral (width * height) + scale = A.fromIntegral (A.size arr) go = #ifdef ACCELERATE_LLVM_NATIVE_BACKEND foreignAcc (Native.fft2D mode) $ @@ -152,9 +146,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND foreignAcc (PTX.fft2D mode) $ #endif -#ifdef ACCELERATE_CUDA_BACKEND - foreignAcc (CUDA.fft2D mode) $ -#endif fft' fft' a = A.transpose . fft sign (Z:.height) width @@ -195,7 +186,7 @@ -> Acc (Array DIM3 (Complex e)) fft3D' mode (Z :. depth :. height :. width) arr = let sign = signOfMode mode :: e - scale = P.fromIntegral (width * height * depth) + scale = A.fromIntegral (A.size arr) go = #ifdef ACCELERATE_LLVM_NATIVE_BACKEND foreignAcc (Native.fft3D mode) $ @@ -203,9 +194,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND foreignAcc (PTX.fft3D mode) $ #endif -#ifdef ACCELERATE_CUDA_BACKEND - foreignAcc (CUDA.fft3D mode) $ -#endif fft' fft' a = rotate3D . fft sign (Z:.depth :.height) width @@ -305,4 +293,6 @@ isPow2 0 = True isPow2 1 = False isPow2 x = x .&. (x-1) P.== 0 + + diff --git a/Data/Array/Accelerate/Math/FFT/CUDA.hs b/Data/Array/Accelerate/Math/FFT/CUDA.hs deleted file mode 100644 --- a/Data/Array/Accelerate/Math/FFT/CUDA.hs +++ /dev/null @@ -1,249 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} --- | --- Module : Data.Array.Accelerate.Math.FFT.CUDA --- Copyright : [2017] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- - -module Data.Array.Accelerate.Math.FFT.CUDA ( - - fft1D, - fft2D, - fft3D, - -) where - -import Data.Array.Accelerate.Math.FFT.Mode -import Data.Array.Accelerate.Math.FFT.Twine -import Data.Array.Accelerate.Data.Complex - -import Data.Array.Accelerate.CUDA.Foreign -import Data.Array.Accelerate.Array.Sugar as S hiding ( allocateArray ) -import Data.Array.Accelerate.Type - -import Foreign.Storable -import Foreign.CUDA.Analysis -import qualified Foreign.CUDA.FFT as FFT -import qualified Foreign.CUDA.Driver as CUDA hiding ( device ) -import qualified Foreign.CUDA.Driver.Context as CUDA ( device ) - -import Control.Concurrent.MVar -import Control.Exception -import Control.Monad -import Data.Maybe -import System.IO.Unsafe - - -fft1D :: IsFloating e - => Mode - -> CUDAForeignAcc (Vector (Complex e) -> (Vector (Complex e))) -fft1D mode = CUDAForeignAcc "fft1D" $ liftAtoC (cuFFT mode) - -fft2D :: IsFloating e - => Mode - -> CUDAForeignAcc (Array DIM2 (Complex e) -> (Array DIM2 (Complex e))) -fft2D mode = CUDAForeignAcc "fft2D" $ liftAtoC (cuFFT mode) - -fft3D :: IsFloating e - => Mode - -> CUDAForeignAcc (Array DIM3 (Complex e) -> (Array DIM3 (Complex e))) -fft3D mode = CUDAForeignAcc "fft3D" $ liftAtoC (cuFFT mode) - - -liftAtoC - :: forall sh e. (Shape sh, IsFloating e) - => (Stream -> Array (sh:.Int) e -> CIO (Array (sh:.Int) e)) - -> Stream - -> Array (sh:.Int) (Complex e) - -> CIO (Array (sh:.Int) (Complex e)) -liftAtoC f s = - case floatingType :: FloatingType e of - TypeFloat{} -> c2a s <=< f s <=< a2c s - TypeDouble{} -> c2a s <=< f s <=< a2c s - TypeCFloat{} -> c2a s <=< f s <=< a2c s - TypeCDouble{} -> c2a s <=< f s <=< a2c s - - --- | Call the cuFFT library to execute the FFT (inplace) --- -cuFFT :: forall sh e. (Shape sh, IsFloating e) - => Mode - -> Stream - -> Array (sh:.Int) e - -> CIO (Array (sh:.Int) e) -cuFFT mode st arr = - withScalarArrayPtr arr st $ \d_arr -> liftIO $ do - let sh :. sz = shape arr - p <- plan (sh :. sz `quot` 2) (undefined::e) -- recall this is an array of packed (Vec2 e) - FFT.setStream p st - case floatingType :: FloatingType e of - TypeFloat{} -> FFT.execC2C p d_arr d_arr (signOfMode mode) >> return arr - TypeDouble{} -> FFT.execZ2Z p d_arr d_arr (signOfMode mode) >> return arr - TypeCFloat{} -> FFT.execC2C p d_arr d_arr (signOfMode mode) >> return arr - TypeCDouble{} -> FFT.execZ2Z p d_arr d_arr (signOfMode mode) >> return arr - - --- | Convert an unzipped Accelerate array of complex numbers into a (new) packed --- array suitable for use with CUFFT. --- -a2c :: forall sh e. (Shape sh, Elt e, IsFloating e, Storable (DevicePtrs e)) - => Stream - -> Array (sh:.Int) (Complex e) - -> CIO (Array (sh:.Int) e) -- this is really a packed array of (Vec2 e) type -a2c st arr | FloatingDict <- floatingDict (floatingType :: FloatingType e) = do - let - sh :. sz = shape arr - n = size sh * sz - -- - cs <- allocateArray (sh :. 2*sz) - withComplexArrayPtrs arr st $ \d_re d_im -> do - withScalarArrayPtr cs st $ \d_cs -> liftIO $ do - mdl <- twine (sizeOf (undefined::e)) - pack <- CUDA.getFun mdl "interleave" - dev <- CUDA.device - prp <- CUDA.props dev - regs <- CUDA.requires pack CUDA.NumRegs - let - blockSize = 256 - sharedMem = 0 - maxBlocks = maxResidentBlocks prp blockSize regs sharedMem - numBlocks = maxBlocks `min` ((n + blockSize - 1) `div` blockSize) - -- - CUDA.launchKernel pack (numBlocks,1,1) (blockSize,1,1) sharedMem (Just st) - [ CUDA.VArg d_cs, CUDA.VArg d_re, CUDA.VArg d_im, CUDA.IArg (fromIntegral n) ] - return cs - - --- | Convert a packed array of complex numbers into a (new) unzipped Accelerate --- array. --- -c2a :: forall sh e. (Shape sh, Elt e, IsFloating e, Storable (DevicePtrs e)) - => Stream - -> Array (sh:.Int) e - -> CIO (Array (sh:.Int) (Complex e)) -c2a st cs | FloatingDict <- floatingDict (floatingType :: FloatingType e) = do - let - sh :. sz2 = shape cs - sz = sz2 `quot` 2 - n = size sh * sz - -- - arr <- allocateArray (sh :. sz) - withComplexArrayPtrs arr st $ \d_re d_im -> do - withScalarArrayPtr cs st $ \d_cs -> liftIO $ do - mdl <- twine (sizeOf (undefined::e)) - unpack <- CUDA.getFun mdl "deinterleave" - dev <- CUDA.device - prp <- CUDA.props dev - regs <- CUDA.requires unpack CUDA.NumRegs - let - blockSize = 256 - sharedMem = 0 - maxBlocks = maxResidentBlocks prp blockSize regs sharedMem - numBlocks = maxBlocks `min` ((n + blockSize - 1) `div` blockSize) - -- - CUDA.launchKernel unpack (numBlocks,1,1) (blockSize,1,1) sharedMem (Just st) - [ CUDA.VArg d_re, CUDA.VArg d_im, CUDA.VArg d_cs, CUDA.IArg (fromIntegral n) ] - return arr - - --- | Generate an execute plan for a given type and size of FFT. These plans are --- cached so that subsequent invocations are quicker. --- -plan :: forall sh e. (Shape sh, IsFloating e) => sh -> e -> IO FFT.Handle -plan (shapeToList -> sh) _ = - modifyMVar fft_plans $ \ps -> - case lookup (ty, sh) ps of - Just p -> return (ps, p) - Nothing -> do - p <- case sh of - [w] -> FFT.plan1D w ty 1 - [w,h] -> FFT.plan2D h w ty - [w,h,d] -> FFT.plan3D d h w ty - _ -> error "cuFFT only supports 1D, 2D, and 3D transforms" - return (((ty,sh),p) : ps, p) - where - ty = case floatingType :: FloatingType e of - TypeFloat{} -> FFT.C2C - TypeDouble{} -> FFT.Z2Z - TypeCFloat{} -> FFT.C2C - TypeCDouble{} -> FFT.Z2Z - - --- | Load the module to convert between SoA and AoS representation for the given --- type. This is cached for subsequent reuse. --- -twine :: Int -> IO CUDA.Module -twine bitsize = do - ctx <- fromMaybe (error "could not determine current CUDA context") `fmap` CUDA.get - modifyMVar ptx_twine_modules $ \ms -> do - case lookup (bitsize,ctx) ms of - Just m -> return (ms, m) - Nothing -> do - m <- CUDA.loadData $ case bitsize of - 4 -> ptx_twine_f32 - 8 -> ptx_twine_f64 - _ -> error "cuFFT only supports Float and Double" - return (((bitsize,ctx), m) : ms, m) - - --- | Dig out the two device pointers for an unzipped array of complex numbers. --- -withComplexArrayPtrs - :: forall sh e a. IsFloating e - => Array sh (Complex e) - -> Stream - -> (DevicePtrs e -> DevicePtrs e -> CIO a) - -> CIO a -withComplexArrayPtrs arr st k - = case floatingType :: FloatingType e of - TypeFloat{} -> withDevicePtrs arr (Just st) $ \(((),p1),p2) -> k p1 p2 - TypeDouble{} -> withDevicePtrs arr (Just st) $ \(((),p1),p2) -> k p1 p2 - TypeCDouble{} -> withDevicePtrs arr (Just st) $ \(((),p1),p2) -> k p1 p2 - TypeCFloat{} -> withDevicePtrs arr (Just st) $ \(((),p1),p2) -> k p1 p2 - --- | Dig out the device pointer for a scalar array --- -withScalarArrayPtr - :: forall sh e a. IsFloating e - => Array sh e - -> Stream - -> (DevicePtrs e -> CIO a) - -> CIO a -withScalarArrayPtr arr st k - = case floatingType :: FloatingType e of - TypeFloat{} -> withDevicePtrs arr (Just st) $ \p -> k p - TypeDouble{} -> withDevicePtrs arr (Just st) $ \p -> k p - TypeCDouble{} -> withDevicePtrs arr (Just st) $ \p -> k p - TypeCFloat{} -> withDevicePtrs arr (Just st) $ \p -> k p - - --- Cache the FFT planning step for faster repeat evaluations. -{-# NOINLINE fft_plans #-} -fft_plans :: MVar [((FFT.Type, [Int]), FFT.Handle)] -fft_plans = unsafePerformIO $ do - mv <- newMVar [] - _ <- mkWeakMVar mv - $ withMVar mv - $ mapM_ (\(_,p) -> FFT.destroy p) - return mv - --- Cache the functions which convert between SoA and AoS format. -{-# NOINLINE ptx_twine_modules #-} -ptx_twine_modules :: MVar [((Int, CUDA.Context), CUDA.Module)] -ptx_twine_modules = unsafePerformIO $ do - mv <- newMVar [] - _ <- mkWeakMVar mv - $ withMVar mv - $ mapM_ (\((_,ctx),mdl) -> bracket_ (CUDA.push ctx) CUDA.pop (CUDA.unload mdl)) - return mv - diff --git a/Data/Array/Accelerate/Math/FFT/Twine.hs b/Data/Array/Accelerate/Math/FFT/Twine.hs --- a/Data/Array/Accelerate/Math/FFT/Twine.hs +++ b/Data/Array/Accelerate/Math/FFT/Twine.hs @@ -18,7 +18,7 @@ import Data.Array.Accelerate as A import Data.Array.Accelerate.Data.Complex -#if defined(ACCELERATE_CUDA_BACKEND) || defined(ACCELERATE_LLVM_PTX_BACKEND) +#ifdef ACCELERATE_LLVM_PTX_BACKEND import Data.FileEmbed import Data.ByteString ( ByteString ) #endif @@ -65,7 +65,7 @@ #-} -#if defined(ACCELERATE_CUDA_BACKEND) || defined(ACCELERATE_LLVM_PTX_BACKEND) +#ifdef ACCELERATE_LLVM_PTX_BACKEND -- Embedded PTX code for interleave and deinterleave for 32- and 64-bit floating -- point numbers respectively. These can be loaded and executed by the CUDA diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,12 @@ +FFT Component for the Accelerate Array Language +=============================================== + +[![Build Status](https://travis-ci.org/tmcdonell/accelerate-fft.svg?branch=master)](https://travis-ci.org/tmcdonell/accelerate-fft) +[![Hackage](https://img.shields.io/hackage/v/accelerate-fft.svg)](https://hackage.haskell.org/package/accelerate-fft) + +FFT library for the embedded array language Accelerate. This will use optimised +backend implementations where available. For details on Accelerate, refer to the +[main repository][GitHub]. + + [GitHub]: https://github.com/AccelerateHS/accelerate + diff --git a/accelerate-fft.cabal b/accelerate-fft.cabal --- a/accelerate-fft.cabal +++ b/accelerate-fft.cabal @@ -1,7 +1,7 @@ Name: accelerate-fft -Version: 1.0.0.0 +Version: 1.1.0.0 Cabal-version: >= 1.6 -Tested-with: GHC >= 7.8 +Tested-with: GHC >= 7.10 Build-type: Simple Synopsis: FFT using the Accelerate library @@ -29,28 +29,26 @@ Stability: Experimental extra-source-files: + README.md + CHANGELOG.md cubits/twine_f32.ptx cubits/twine_f64.ptx cubits/twine_f32.cu cubits/twine_f64.cu -Flag cuda - Description: Use CUFFT-based implementation in the CUDA backend - Default: False - Flag llvm-ptx Description: Use CUFFT-based implementation in the LLVM.PTX backend - Default: False + Default: True Flag llvm-cpu Description: Use FFTW-based implementation in the LLVM.Native backend - Default: False + Default: True Library build-depends: - base >= 4.7 && < 4.10 - , accelerate == 1.0.* + base >= 4.7 && < 4.11 + , accelerate >= 1.0 && < 1.2 , bytestring >= 0.9 exposed-modules: @@ -65,22 +63,22 @@ ghc-options: -O2 -Wall -funbox-strict-fields - if flag(cuda) - cpp-options: -DACCELERATE_CUDA_BACKEND - build-depends: - accelerate-cuda >= 0.16 - , cuda >= 0.5 - , cufft >= 0.1.2 - , file-embed >= 0.0.10 - - other-modules: - Data.Array.Accelerate.Math.FFT.CUDA + -- if flag(cuda) + -- cpp-options: -DACCELERATE_CUDA_BACKEND + -- build-depends: + -- accelerate-cuda >= 0.16 + -- , cuda >= 0.5 + -- , cufft >= 0.1.2 + -- , file-embed >= 0.0.10 + -- + -- other-modules: + -- Data.Array.Accelerate.Math.FFT.CUDA if flag(llvm-cpu) cpp-options: -DACCELERATE_LLVM_NATIVE_BACKEND build-depends: - accelerate-llvm == 1.0.* - , accelerate-llvm-native == 1.0.* + accelerate-llvm >= 1.0 && < 1.2 + , accelerate-llvm-native >= 1.0 && < 1.2 , carray >= 0.1.5 , fft >= 0.1.8 , storable-complex >= 0.2 @@ -91,8 +89,8 @@ if flag(llvm-ptx) cpp-options: -DACCELERATE_LLVM_PTX_BACKEND build-depends: - accelerate-llvm == 1.0.* - , accelerate-llvm-ptx == 1.0.* + accelerate-llvm >= 1.0 && < 1.2 + , accelerate-llvm-ptx >= 1.0 && < 1.2 , cuda >= 0.5 , cufft >= 0.1.2 , file-embed >= 0.0.10 @@ -112,7 +110,7 @@ Source-repository this Type: git - Tag: 1.0.0.0 + Tag: 1.1.0.0 Location: git://github.com/AccelerateHS/accelerate-fft.git -- vim: nospell