/
Compile.hs
112 lines (92 loc) · 4.15 KB
/
Compile.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
{-# 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,
ObjectR(..),
) where
-- llvm-hs
import LLVM.AST hiding ( Module )
import LLVM.Module as LLVM hiding ( Module )
import LLVM.Context
import LLVM.Target
-- accelerate
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
-- standard library
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 :: {- LAZY -} [ShortByteString]
, objData :: {- LAZY -} ByteString
}
compileForTarget = compile
instance Intrinsic Native
-- | Compile an Accelerate expression to object code
--
compile :: DelayedOpenAcc aenv a -> Gamma aenv -> LLVM Native (ObjectR Native)
compile acc aenv = do
target <- gets llvmTarget
(uid, cacheFile) <- cacheOfOpenAcc acc
-- Generate code for this Acc operation
--
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 ]
-- Lower the generated LLVM and produce an object file.
--
-- The 'objData' field is only lazy evaluated since the object code might
-- already have been loaded into memory from a different function, in which
-- case it will be found in the linker cache.
--
obj <- liftIO . unsafeInterleaveIO $ do
exists <- doesFileExist cacheFile
recomp <- if Debug.debuggingIsEnabled then Debug.getFlag Debug.force_recomp else return False
if exists && not 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