Allow -dead_strip linking on platforms with .subsections_via_symbols
[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, iTableSuf
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 -- ----------------------------------------------------------------------------
26 -- * Top level
27 --
28
29 -- | Header code for LLVM modules
30 pprLlvmHeader :: SDoc
31 pprLlvmHeader = moduleLayout
32
33
34 -- | LLVM module layout description for the host target
35 moduleLayout :: SDoc
36 moduleLayout = sdocWithPlatform $ \platform ->
37 case platform of
38 Platform { platformArch = ArchX86, platformOS = OSDarwin } ->
39 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\""
40 $+$ text "target triple = \"i386-apple-darwin9.8\""
41 Platform { platformArch = ArchX86, platformOS = OSMinGW32 } ->
42 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\""
43 $+$ text "target triple = \"i686-pc-win32\""
44 Platform { platformArch = ArchX86, platformOS = OSLinux } ->
45 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\""
46 $+$ text "target triple = \"i386-pc-linux-gnu\""
47 Platform { platformArch = ArchX86_64, platformOS = OSDarwin } ->
48 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\""
49 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
50 Platform { platformArch = ArchX86_64, platformOS = OSLinux } ->
51 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\""
52 $+$ text "target triple = \"x86_64-linux-gnu\""
53 Platform { platformArch = ArchARM {}, platformOS = OSLinux } ->
54 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\""
55 $+$ text "target triple = \"arm-unknown-linux-gnueabi\""
56 Platform { platformArch = ArchARM {}, platformOS = OSAndroid } ->
57 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\""
58 $+$ text "target triple = \"arm-unknown-linux-androideabi\""
59 Platform { platformArch = ArchARM {}, platformOS = OSQNXNTO } ->
60 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\""
61 $+$ text "target triple = \"arm-unknown-nto-qnx8.0.0eabi\""
62 Platform { platformArch = ArchARM {}, platformOS = OSiOS } ->
63 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\""
64 $+$ text "target triple = \"arm-apple-darwin10\""
65 Platform { platformArch = ArchX86, platformOS = OSiOS } ->
66 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\""
67 $+$ text "target triple = \"i386-apple-darwin11\""
68 _ ->
69 -- FIX: Other targets
70 empty
71
72
73 -- | Pretty print LLVM data code
74 pprLlvmData :: LlvmData -> SDoc
75 pprLlvmData (globals, types) =
76 let ppLlvmTys (LMAlias a) = ppLlvmAlias a
77 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
78 ppLlvmTys _other = empty
79
80 types' = vcat $ map ppLlvmTys types
81 globals' = ppLlvmGlobals globals
82 in types' $+$ globals'
83
84
85 -- | Pretty print LLVM code
86 pprLlvmCmmDecl :: Int -> LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
87 pprLlvmCmmDecl _ (CmmData _ lmdata)
88 = return (vcat $ map pprLlvmData lmdata, [])
89
90 pprLlvmCmmDecl count (CmmProc mb_info entry_lbl live (ListGraph blks))
91 = do (idoc, ivar) <- case mb_info of
92 Nothing -> return (empty, [])
93 Just (Statics info_lbl dat)
94 -> pprInfoTable count info_lbl (Statics entry_lbl dat)
95
96 let sec = mkLayoutSection (count + 1)
97 (lbl',sec') = case mb_info of
98 Nothing -> (entry_lbl, Nothing)
99 Just (Statics info_lbl _) -> (info_lbl, sec)
100 link = if externallyVisibleCLabel lbl'
101 then ExternallyVisible
102 else Internal
103 lmblocks = map (\(BasicBlock id stmts) ->
104 LlvmBlock (getUnique id) stmts) blks
105
106 fun <- mkLlvmFunc live lbl' link sec' lmblocks
107
108 return (idoc $+$ ppLlvmFunction fun, ivar)
109
110
111 -- | Pretty print CmmStatic
112 pprInfoTable :: Int -> CLabel -> CmmStatics -> LlvmM (SDoc, [LlvmVar])
113 pprInfoTable count info_lbl stat
114 = do (ldata, ltypes) <- genLlvmData (Text, stat)
115
116 dflags <- getDynFlags
117 platform <- getLlvmPlatform
118 let setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d) = do
119 lbl <- strCLabel_llvm info_lbl
120 let sec = mkLayoutSection count
121 ilabel = lbl `appendFS` fsLit iTableSuf
122 gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
123 -- See Note [Subsections Via Symbols]
124 v = if (platformHasSubsectionsViaSymbols platform
125 && l == ExternallyVisible)
126 || l == Internal
127 then [gv]
128 else []
129 funInsert ilabel ty
130 return (LMGlobal gv d, v)
131 setSection v = return (v,[])
132
133 (ldata', llvmUsed) <- setSection (last ldata)
134 if length ldata /= 1
135 then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
136 else return (pprLlvmData ([ldata'], ltypes), llvmUsed)
137
138
139 -- | We generate labels for info tables by converting them to the same label
140 -- as for the entry code but adding this string as a suffix.
141 iTableSuf :: String
142 iTableSuf = "_itable"
143
144
145 -- | Create a specially crafted section declaration that encodes the order this
146 -- section should be in the final object code.
147 --
148 -- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
149 -- this section declaration to do its processing.
150 mkLayoutSection :: Int -> LMSection
151 mkLayoutSection n
152 = Just (fsLit $ infoSection ++ show n)
153
154
155 -- | The section we are putting info tables and their entry code into, should
156 -- be unique since we process the assembly pattern matching this.
157 infoSection :: String
158 infoSection = "X98A__STRIP,__me"