{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Accelerate.LLVM.Native.Compile (
module Data.Array.Accelerate.LLVM.Compile,
ObjectR(..),
) where
import LLVM.AST hiding ( Module )
import LLVM.Module as LLVM hiding ( Module )
import LLVM.Context
import LLVM.Target
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 ( Module(..) )
import Data.Array.Accelerate.LLVM.Native.CodeGen ( )
import Data.Array.Accelerate.LLVM.Native.Compile.Cache
import Data.Array.Accelerate.LLVM.Native.Compile.Optimise
import Data.Array.Accelerate.LLVM.Native.Foreign ( )
import Data.Array.Accelerate.LLVM.Native.Target
import qualified Data.Array.Accelerate.LLVM.Native.Debug as Debug
import Control.Monad.State
import Data.ByteString ( ByteString )
import Data.ByteString.Short ( ShortByteString )
import Data.Maybe
import System.Directory
import System.IO.Unsafe
import Text.Printf
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Short as BS
import qualified Data.Map as Map
instance Compile Native where
data ObjectR Native = ObjectR { objId :: {-# UNPACK #-} !UID
, objSyms :: [ShortByteString]
, objData :: ByteString
}
compileForTarget = compile
instance Intrinsic Native
compile :: DelayedOpenAcc aenv a -> Gamma aenv -> LLVM Native (ObjectR Native)
compile acc aenv = do
target <- gets llvmTarget
(uid, cacheFile) <- cacheOfOpenAcc acc
let Module ast md = llvmOfOpenAcc target uid acc aenv
triple = fromMaybe BS.empty (moduleTargetTriple ast)
datalayout = moduleDataLayout ast
nms = [ f | Name f <- Map.keys md ]
obj <- liftIO . unsafeInterleaveIO $ do
exists <- doesFileExist cacheFile
recomp <- Debug.queryFlag Debug.force_recomp
if exists && not (fromMaybe False recomp)
then do
Debug.traceIO Debug.dump_cc (printf "cc: found cached object code %016x" uid)
B.readFile cacheFile
else
withContext $ \ctx ->
withModuleFromAST ctx ast $ \mdl ->
withNativeTargetMachine $ \machine ->
withTargetLibraryInfo triple $ \libinfo -> do
optimiseModule datalayout (Just machine) (Just libinfo) mdl
Debug.when Debug.verbose $ do
Debug.traceIO Debug.dump_cc . B8.unpack =<< moduleLLVMAssembly mdl
Debug.traceIO Debug.dump_asm . B8.unpack =<< moduleTargetAssembly machine mdl
obj <- moduleObject machine mdl
B.writeFile cacheFile obj
return obj
return $! ObjectR uid nms obj