{-# LANGUAGE ScopedTypeVariables #-}
module Data.Array.Accelerate.LLVM.PTX.Analysis.Device
where
import Control.Exception
import Data.Function
import Data.List
import Data.Ord
import Foreign.CUDA.Analysis.Device
import Foreign.CUDA.Driver.Context ( Context )
import Foreign.CUDA.Driver.Device
import Foreign.CUDA.Driver.Error
import qualified Foreign.CUDA.Driver as CUDA
selectBestDevice :: IO (Device, DeviceProperties, Context)
selectBestDevice = select =<< enumerateDevices
where
select :: [(Device, DeviceProperties)] -> IO (Device, DeviceProperties, Context)
select [] = cudaErrorIO "No CUDA-capable devices are available"
select ((dev,prp):rest) = do
r <- try $ CUDA.create dev [CUDA.SchedAuto]
case r of
Right ctx -> return (dev,prp,ctx)
Left (_::CUDAException) -> select rest
enumerateDevices :: IO [(Device, DeviceProperties)]
enumerateDevices = do
devs <- mapM CUDA.device . enumFromTo 0 . subtract 1 =<< CUDA.count
prps <- mapM CUDA.props devs
return $ sortBy (flip compareDevices `on` snd) (zip devs prps)
compareDevices :: DeviceProperties -> DeviceProperties -> Ordering
compareDevices = cmp
where
compute = computeCapability
flops d = multiProcessorCount d * coresPerMultiProcessor d * clockRate d
cmp x y
| compute x == compute y = comparing flops x y
| otherwise = comparing compute x y
coresPerMultiProcessor :: DeviceProperties -> Int
coresPerMultiProcessor = coresPerMP . deviceResources