8614084f0cbe5437e3ea0ee62de0047eac304297
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Ppr.hs
1 {-# LANGUAGE CPP #-}
2
3 -- ----------------------------------------------------------------------------
4 -- | Pretty print helpers for the LLVM Code generator.
5 --
6 module LlvmCodeGen.Ppr (
7 pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection
8 ) where
9
10 #include "HsVersions.h"
11
12 import Llvm
13 import LlvmCodeGen.Base
14 import LlvmCodeGen.Data
15
16 import CLabel
17 import Cmm
18 import Platform
19
20 import FastString
21 import Outputable
22 import Unique
23
24 -- ----------------------------------------------------------------------------
25 -- * Top level
26 --
27
28 -- | Header code for LLVM modules
29 pprLlvmHeader :: SDoc
30 pprLlvmHeader = moduleLayout
31
32
33 -- | LLVM module layout description for the host target
34 moduleLayout :: SDoc
35 moduleLayout = sdocWithPlatform $ \platform ->
36 case platform of
37 Platform { platformArch = ArchX86, platformOS = OSDarwin } ->
38 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\""
39 $+$ text "target triple = \"i386-apple-darwin9.8\""
40 Platform { platformArch = ArchX86, platformOS = OSMinGW32 } ->
41 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32\""
42 $+$ text "target triple = \"i686-pc-win32\""
43 Platform { platformArch = ArchX86, platformOS = OSLinux } ->
44 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32\""
45 $+$ text "target triple = \"i386-pc-linux-gnu\""
46 Platform { platformArch = ArchX86_64, platformOS = OSDarwin } ->
47 text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\""
48 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
49 Platform { platformArch = ArchX86_64, platformOS = OSLinux } ->
50 text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\""
51 $+$ text "target triple = \"x86_64-linux-gnu\""
52 Platform { platformArch = ArchARM {}, platformOS = OSLinux } ->
53 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32\""
54 $+$ text "target triple = \"armv6-unknown-linux-gnueabihf\""
55 Platform { platformArch = ArchARM {}, platformOS = OSAndroid } ->
56 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32\""
57 $+$ text "target triple = \"arm-unknown-linux-androideabi\""
58 Platform { platformArch = ArchARM {}, platformOS = OSQNXNTO } ->
59 text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32\""
60 $+$ text "target triple = \"arm-unknown-nto-qnx8.0.0eabi\""
61 Platform { platformArch = ArchARM {}, platformOS = OSiOS } ->
62 text "target datalayout = \"e-m:o-p:32:32-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32\""
63 $+$ text "target triple = \"thumbv7-apple-ios7.0.0\""
64 Platform { platformArch = ArchARM64, platformOS = OSiOS } ->
65 text "target datalayout = \"e-m:o-i64:64-i128:128-n32:64-S128\""
66 $+$ text "target triple = \"arm64-apple-ios7.0.0\""
67 Platform { platformArch = ArchX86, platformOS = OSiOS } ->
68 text "target datalayout = \"e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128\""
69 $+$ text "target triple = \"i386-apple-ios7.0.0\""
70 Platform { platformArch = ArchX86_64, platformOS = OSiOS } ->
71 text "target datalayout = \"e-m:o-i64:64-f80:128-n8:16:32:64-S128\""
72 $+$ text "target triple = \"x86_64-apple-ios7.0.0\""
73 Platform { platformArch = ArchARM64, platformOS = OSLinux } ->
74 text "target datalayout = \"e-m:e-i64:64-i128:128-n32:64-S128\""
75 $+$ text "target triple = \"aarch64-unknown-linux-gnu\""
76 _ ->
77 if platformIsCrossCompiling platform
78 then panic "LlvmCodeGen.Ppr: Cross compiling without valid target info."
79 else empty
80 -- If you see the above panic, GHC is missing the required target datalayout
81 -- and triple information. You can obtain this info by compiling a simple
82 -- 'hello world' C program with the clang C compiler eg:
83 -- clang -S hello.c -emit-llvm -o -
84 -- and the first two lines of hello.ll should provide the 'target datalayout'
85 -- and 'target triple' lines required.
86
87
88 -- | Pretty print LLVM data code
89 pprLlvmData :: LlvmData -> SDoc
90 pprLlvmData (globals, types) =
91 let ppLlvmTys (LMAlias a) = ppLlvmAlias a
92 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
93 ppLlvmTys _other = empty
94
95 types' = vcat $ map ppLlvmTys types
96 globals' = ppLlvmGlobals globals
97 in types' $+$ globals'
98
99
100 -- | Pretty print LLVM code
101 pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
102 pprLlvmCmmDecl (CmmData _ lmdata)
103 = return (vcat $ map pprLlvmData lmdata, [])
104
105 pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
106 = do let lbl = case mb_info of
107 Nothing -> entry_lbl
108 Just (Statics info_lbl _) -> info_lbl
109 link = if externallyVisibleCLabel lbl
110 then ExternallyVisible
111 else Internal
112 lmblocks = map (\(BasicBlock id stmts) ->
113 LlvmBlock (getUnique id) stmts) blks
114
115 funDec <- llvmFunSig live lbl link
116 dflags <- getDynFlags
117 let buildArg = fsLit . showSDoc dflags . ppPlainName
118 funArgs = map buildArg (llvmFunArgs dflags live)
119 funSect = llvmFunSection dflags (decName funDec)
120
121 -- generate the info table
122 prefix <- case mb_info of
123 Nothing -> return Nothing
124 Just (Statics _ statics) -> do
125 infoStatics <- mapM genData statics
126 let infoTy = LMStruct $ map getStatType infoStatics
127 return $ Just $ LMStaticStruc infoStatics infoTy
128
129
130 let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
131 prefix lmblocks
132 name = decName $ funcDecl fun
133 defName = name `appendFS` fsLit "$def"
134 funcDecl' = (funcDecl fun) { decName = defName }
135 fun' = fun { funcDecl = funcDecl' }
136 funTy = LMFunction funcDecl'
137 funVar = LMGlobalVar name
138 (LMPointer funTy)
139 link
140 Nothing
141 Nothing
142 Alias
143 defVar = LMGlobalVar defName
144 (LMPointer funTy)
145 (funcLinkage funcDecl')
146 (funcSect fun)
147 (funcAlign funcDecl')
148 Alias
149 alias = LMGlobal funVar
150 (Just $ LMBitc (LMStaticPointer defVar)
151 (LMPointer $ LMInt 8))
152
153 return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', [])
154
155
156 -- | The section we are putting info tables and their entry code into, should
157 -- be unique since we process the assembly pattern matching this.
158 infoSection :: String
159 infoSection = "X98A__STRIP,__me"