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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{-# LANGUAGE CPP #-}
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--
module LlvmCodeGen.Ppr (
pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf
) where
#include "HsVersions.h"
import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.Data
import CLabel
import Cmm
import Platform
import FastString
import Outputable
import Unique
-- ----------------------------------------------------------------------------
-- * Top level
--
-- | Header code for LLVM modules
pprLlvmHeader :: SDoc
pprLlvmHeader = moduleLayout
-- | LLVM module layout description for the host target
moduleLayout :: SDoc
moduleLayout = sdocWithPlatform $ \platform ->
case platform of
Platform { platformArch = ArchX86, platformOS = OSDarwin } ->
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\""
$+$ text "target triple = \"i386-apple-darwin9.8\""
Platform { platformArch = ArchX86, platformOS = OSMinGW32 } ->
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\""
$+$ text "target triple = \"i686-pc-win32\""
Platform { platformArch = ArchX86, platformOS = OSLinux } ->
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\""
$+$ text "target triple = \"i386-pc-linux-gnu\""
Platform { platformArch = ArchX86_64, platformOS = OSDarwin } ->
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\""
$+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
Platform { platformArch = ArchX86_64, platformOS = OSLinux } ->
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\""
$+$ text "target triple = \"x86_64-linux-gnu\""
Platform { platformArch = ArchARM {}, platformOS = OSLinux } ->
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\""
$+$ text "target triple = \"arm-unknown-linux-gnueabi\""
Platform { platformArch = ArchARM {}, platformOS = OSAndroid } ->
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\""
$+$ text "target triple = \"arm-unknown-linux-androideabi\""
Platform { platformArch = ArchARM {}, platformOS = OSQNXNTO } ->
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\""
$+$ text "target triple = \"arm-unknown-nto-qnx8.0.0eabi\""
Platform { platformArch = ArchARM {}, platformOS = OSiOS } ->
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\""
$+$ text "target triple = \"arm-apple-darwin10\""
Platform { platformArch = ArchX86, platformOS = OSiOS } ->
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\""
$+$ text "target triple = \"i386-apple-darwin11\""
Platform { platformArch = ArchARM64, platformOS = OSiOS } ->
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-n32:64-S128\""
$+$ text "target triple = \"arm64-apple-ios7.0.0\""
_ ->
-- FIX: Other targets
empty
-- | Pretty print LLVM data code
pprLlvmData :: LlvmData -> SDoc
pprLlvmData (globals, types) =
let ppLlvmTys (LMAlias a) = ppLlvmAlias a
ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
ppLlvmTys _other = empty
types' = vcat $ map ppLlvmTys types
globals' = ppLlvmGlobals globals
in types' $+$ globals'
-- | Pretty print LLVM code
pprLlvmCmmDecl :: Int -> LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl _ (CmmData _ lmdata)
= return (vcat $ map pprLlvmData lmdata, [])
pprLlvmCmmDecl count (CmmProc mb_info entry_lbl live (ListGraph blks))
= do (idoc, ivar) <- case mb_info of
Nothing -> return (empty, [])
Just (Statics info_lbl dat)
-> pprInfoTable count info_lbl (Statics entry_lbl dat)
let sec = mkLayoutSection (count + 1)
(lbl',sec') = case mb_info of
Nothing -> (entry_lbl, Nothing)
Just (Statics info_lbl _) -> (info_lbl, sec)
link = if externallyVisibleCLabel lbl'
then ExternallyVisible
else Internal
lmblocks = map (\(BasicBlock id stmts) ->
LlvmBlock (getUnique id) stmts) blks
fun <- mkLlvmFunc live lbl' link sec' lmblocks
let name = decName $ funcDecl fun
defName = name `appendFS` fsLit "$def"
funcDecl' = (funcDecl fun) { decName = defName }
fun' = fun { funcDecl = funcDecl' }
funTy = LMFunction funcDecl'
funVar = LMGlobalVar name
(LMPointer funTy)
link
Nothing
Nothing
Alias
defVar = LMGlobalVar defName
(LMPointer funTy)
(funcLinkage funcDecl')
(funcSect fun)
(funcAlign funcDecl')
Alias
alias = LMGlobal funVar
(Just $ LMBitc (LMStaticPointer defVar)
(LMPointer $ LMInt 8))
return (ppLlvmGlobal alias $+$ idoc $+$ ppLlvmFunction fun', ivar)
-- | Pretty print CmmStatic
pprInfoTable :: Int -> CLabel -> CmmStatics -> LlvmM (SDoc, [LlvmVar])
pprInfoTable count info_lbl stat
= do (ldata, ltypes) <- genLlvmData (Text, stat)
dflags <- getDynFlags
platform <- getLlvmPlatform
let setSection :: LMGlobal -> LlvmM (LMGlobal, [LlvmVar])
setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d) = do
lbl <- strCLabel_llvm info_lbl
let sec = mkLayoutSection count
ilabel = lbl `appendFS` fsLit iTableSuf
gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
-- See Note [Subsections Via Symbols]
v = if (platformHasSubsectionsViaSymbols platform
&& l == ExternallyVisible)
|| l == Internal
then [gv]
else []
funInsert ilabel ty
return (LMGlobal gv d, v)
setSection v = return (v,[])
(ldata', llvmUsed) <- unzip `fmap` mapM setSection ldata
ldata'' <- mapM aliasify ldata'
let modUsedLabel (LMGlobalVar name ty link sect align const) =
LMGlobalVar (name `appendFS` fsLit "$def") ty link sect align const
modUsedLabel v = v
llvmUsed' = map modUsedLabel $ concat llvmUsed
return (pprLlvmData (concat ldata'', ltypes), llvmUsed')
-- | We generate labels for info tables by converting them to the same label
-- as for the entry code but adding this string as a suffix.
iTableSuf :: String
iTableSuf = "_itable"
-- | Create a specially crafted section declaration that encodes the order this
-- section should be in the final object code.
--
-- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
-- this section declaration to do its processing.
mkLayoutSection :: Int -> LMSection
mkLayoutSection n
= Just (fsLit $ infoSection ++ show n)
-- | The section we are putting info tables and their entry code into, should
-- be unique since we process the assembly pattern matching this.
infoSection :: String
infoSection = "X98A__STRIP,__me"
|
