c699631e9c8b0d6c043fba8125a644d589e01f87
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Ppr.hs
1 -- ----------------------------------------------------------------------------
2 -- | Pretty print helpers for the LLVM Code generator.
3 --
4
5 module LlvmCodeGen.Ppr (
6 pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf
7 ) where
8
9 #include "HsVersions.h"
10
11 import Llvm
12 import LlvmCodeGen.Base
13 import LlvmCodeGen.Data
14 import LlvmCodeGen.Regs
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 = sdocWithDynFlags $ \dflags ->
32 moduleLayout
33 $+$ text ""
34 $+$ ppLlvmFunctionDecls (map snd (ghcInternalFunctions dflags))
35 $+$ ppLlvmMetas stgTBAA
36 $+$ text ""
37
38
39 -- | LLVM module layout description for the host target
40 moduleLayout :: SDoc
41 moduleLayout = sdocWithPlatform $ \platform ->
42 case platform of
43 Platform { platformArch = ArchX86, platformOS = OSDarwin } ->
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:128:128-n8:16:32\""
45 $+$ text "target triple = \"i386-apple-darwin9.8\""
46 Platform { platformArch = ArchX86, platformOS = OSMinGW32 } ->
47 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\""
48 $+$ text "target triple = \"i686-pc-win32\""
49 Platform { platformArch = ArchX86, platformOS = OSLinux } ->
50 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\""
51 $+$ text "target triple = \"i386-pc-linux-gnu\""
52 Platform { platformArch = ArchX86_64, platformOS = OSDarwin } ->
53 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\""
54 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
55 Platform { platformArch = ArchX86_64, platformOS = OSLinux } ->
56 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\""
57 $+$ text "target triple = \"x86_64-linux-gnu\""
58 Platform { platformArch = ArchARM {}, platformOS = OSLinux } ->
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-linux-gnueabi\""
61 Platform { platformArch = ArchARM {}, platformOS = OSAndroid } ->
62 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\""
63 $+$ text "target triple = \"arm-unknown-linux-androideabi\""
64 Platform { platformArch = ArchARM {}, platformOS = OSiOS } ->
65 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\""
66 $+$ text "target triple = \"arm-apple-darwin10\""
67 _ ->
68 -- FIX: Other targets
69 empty
70
71
72 -- | Pretty print LLVM data code
73 pprLlvmData :: LlvmData -> SDoc
74 pprLlvmData (globals, types) =
75 let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s)
76 tryConst g@(_, Nothing) = ppLlvmGlobal g
77
78 ppLlvmTys (LMAlias a) = ppLlvmAlias a
79 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
80 ppLlvmTys _other = empty
81
82 types' = vcat $ map ppLlvmTys types
83 globals' = vcat $ map tryConst globals
84 in types' $+$ globals'
85
86
87 -- | Pretty print LLVM code
88 pprLlvmCmmDecl :: LlvmEnv -> Int -> LlvmCmmDecl -> (SDoc, [LlvmVar])
89 pprLlvmCmmDecl _ _ (CmmData _ lmdata)
90 = (vcat $ map pprLlvmData lmdata, [])
91
92 pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl live (ListGraph blks))
93 = let (idoc, ivar) = case mb_info of
94 Nothing -> (empty, [])
95 Just (Statics info_lbl dat)
96 -> pprInfoTable env count info_lbl (Statics entry_lbl dat)
97 in (idoc $+$ (
98 let sec = mkLayoutSection (count + 1)
99 (lbl',sec') = case mb_info of
100 Nothing -> (entry_lbl, Nothing)
101 Just (Statics info_lbl _) -> (info_lbl, sec)
102 link = if externallyVisibleCLabel lbl'
103 then ExternallyVisible
104 else Internal
105 lmblocks = map (\(BasicBlock id stmts) ->
106 LlvmBlock (getUnique id) stmts) blks
107 fun = mkLlvmFunc env live lbl' link sec' lmblocks
108 in ppLlvmFunction fun
109 ), ivar)
110
111
112 -- | Pretty print CmmStatic
113 pprInfoTable :: LlvmEnv -> Int -> CLabel -> CmmStatics -> (SDoc, [LlvmVar])
114 pprInfoTable env count info_lbl stat
115 = let dflags = getDflags env
116 unres = genLlvmData env (Text, stat)
117 (_, (ldata, ltypes)) = resolveLlvmData env unres
118
119 setSection ((LMGlobalVar _ ty l _ _ c), d)
120 = let sec = mkLayoutSection count
121 ilabel = strCLabel_llvm env info_lbl
122 `appendFS` fsLit iTableSuf
123 gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
124 v = if l == Internal then [gv] else []
125 in ((gv, d), v)
126 setSection v = (v,[])
127
128 (ldata', llvmUsed) = setSection (last ldata)
129 in if length ldata /= 1
130 then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
131 else (pprLlvmData ([ldata'], ltypes), llvmUsed)
132
133
134 -- | We generate labels for info tables by converting them to the same label
135 -- as for the entry code but adding this string as a suffix.
136 iTableSuf :: String
137 iTableSuf = "_itable"
138
139
140 -- | Create a specially crafted section declaration that encodes the order this
141 -- section should be in the final object code.
142 --
143 -- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
144 -- this section declaration to do its processing.
145 mkLayoutSection :: Int -> LMSection
146 mkLayoutSection n
147 = Just (fsLit $ infoSection ++ show n)
148
149
150 -- | The section we are putting info tables and their entry code into, should
151 -- be unique since we process the assembly pattern matching this.
152 infoSection :: String
153 infoSection = "X98A__STRIP,__me"
154