3cf6cdac852f757d0e3feec0349e5791116b7ecd
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Data.hs
1 -- ----------------------------------------------------------------------------
2 -- | Handle conversion of CmmData to LLVM code.
3 --
4
5 module LlvmCodeGen.Data (
6 genLlvmData, resolveLlvmDatas, resolveLlvmData
7 ) where
8
9 #include "HsVersions.h"
10
11 import Llvm
12 import LlvmCodeGen.Base
13
14 import BlockId
15 import CLabel
16 import Cmm
17
18 import FastString
19 import qualified Outputable
20
21 import Data.Maybe
22
23
24 -- ----------------------------------------------------------------------------
25 -- * Constants
26 --
27
28 -- | The string appended to a variable name to create its structure type alias
29 structStr :: LMString
30 structStr = fsLit "_struct"
31
32 -- ----------------------------------------------------------------------------
33 -- * Top level
34 --
35
36 -- | Pass a CmmStatic section to an equivalent Llvm code. Can't
37 -- complete this completely though as we need to pass all CmmStatic
38 -- sections before all references can be resolved. This last step is
39 -- done by 'resolveLlvmData'.
40 genLlvmData :: (Section, [CmmStatic]) -> LlvmUnresData
41 genLlvmData (sec, CmmDataLabel lbl:xs) =
42 let static = map genData xs
43 label = strCLabel_llvm lbl
44
45 types = map getStatTypes static
46 getStatTypes (Left x) = cmmToLlvmType $ cmmLitType x
47 getStatTypes (Right x) = getStatType x
48
49 strucTy = LMStruct types
50 alias = LMAlias (label `appendFS` structStr) strucTy
51 in (lbl, sec, alias, static)
52
53 genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
54
55
56 resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData]
57 -> (LlvmEnv, [LlvmData])
58 resolveLlvmDatas env [] ldata
59 = (env, ldata)
60
61 resolveLlvmDatas env (udata : rest) ldata
62 = let (env', ndata) = resolveLlvmData env udata
63 in resolveLlvmDatas env' rest (ldata ++ [ndata])
64
65 -- | Fix up CLabel references now that we should have passed all CmmData.
66 resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
67 resolveLlvmData env (lbl, sec, alias, unres) =
68 let (env', static, refs) = resDatas env unres ([], [])
69 refs' = catMaybes refs
70 struct = Just $ LMStaticStruc static alias
71 label = strCLabel_llvm lbl
72 link = if (externallyVisibleCLabel lbl)
73 then ExternallyVisible else Internal
74 const = isSecConstant sec
75 glob = LMGlobalVar label alias link Nothing Nothing const
76 in (env', (refs' ++ [(glob, struct)], [alias]))
77
78
79 -- | Should a data in this section be considered constant
80 isSecConstant :: Section -> Bool
81 isSecConstant Text = True
82 isSecConstant Data = False
83 isSecConstant ReadOnlyData = True
84 isSecConstant RelocatableReadOnlyData = True
85 isSecConstant UninitialisedData = False
86 isSecConstant ReadOnlyData16 = True
87 isSecConstant (OtherSection _) = False
88
89
90 -- ----------------------------------------------------------------------------
91 -- ** Resolve Data/CLabel references
92 --
93
94 -- | Resolve data list
95 resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
96 -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
97
98 resDatas env [] (stat, glob)
99 = (env, stat, glob)
100
101 resDatas env (cmm : rest) (stats, globs)
102 = let (env', nstat, nglob) = resData env cmm
103 in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
104
105 -- | Resolve an individual static label if it needs to be.
106 --
107 -- We check the 'LlvmEnv' to see if the reference has been defined in this
108 -- module. If it has we can retrieve its type and make a pointer, otherwise
109 -- we introduce a generic external defenition for the referenced label and
110 -- then make a pointer.
111 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
112
113 resData env (Right stat) = (env, stat, [Nothing])
114
115 resData env (Left cmm@(CmmLabel l)) =
116 let label = strCLabel_llvm l
117 ty = funLookup label env
118 lmty = cmmToLlvmType $ cmmLitType cmm
119 in case ty of
120 -- Make generic external label defenition and then pointer to it
121 Nothing ->
122 let glob@(var, _) = genStringLabelRef label
123 env' = funInsert label (pLower $ getVarType var) env
124 ptr = LMStaticPointer var
125 in (env', LMPtoI ptr lmty, [Just glob])
126 -- Referenced data exists in this module, retrieve type and make
127 -- pointer to it.
128 Just ty' ->
129 let var = LMGlobalVar label (LMPointer ty')
130 ExternallyVisible Nothing Nothing False
131 ptr = LMStaticPointer var
132 in (env, LMPtoI ptr lmty, [Nothing])
133
134 resData env (Left (CmmLabelOff label off)) =
135 let (env', var, glob) = resData env (Left (CmmLabel label))
136 offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
137 in (env', LMAdd var offset, glob)
138
139 resData env (Left (CmmLabelDiffOff l1 l2 off)) =
140 let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
141 (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
142 var = LMSub var1 var2
143 offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
144 in (env2, LMAdd var offset, glob1 ++ glob2)
145
146 resData _ _ = panic "resData: Non CLabel expr as left type!"
147
148 -- ----------------------------------------------------------------------------
149 -- * Generate static data
150 --
151
152 -- | Handle static data
153 -- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
154 genData :: CmmStatic -> UnresStatic
155
156 genData (CmmString str) =
157 let v = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
158 ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
159 in Right $ LMStaticArray ve (LMArray (length ve) i8)
160
161 genData (CmmUninitialised bytes)
162 = Right $ LMUninitType (LMArray bytes i8)
163
164 genData (CmmStaticLit lit)
165 = genStaticLit lit
166
167 genData (CmmAlign _)
168 = panic "genData: Can't handle CmmAlign!"
169
170 genData (CmmDataLabel _)
171 = panic "genData: Can't handle data labels not at top of data!"
172
173
174 -- | Generate Llvm code for a static literal.
175 --
176 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
177 -- which isn't yet known.
178 genStaticLit :: CmmLit -> UnresStatic
179 genStaticLit (CmmInt i w)
180 = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
181
182 genStaticLit (CmmFloat r w)
183 = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
184
185 -- Leave unresolved, will fix later
186 genStaticLit c@(CmmLabel _ ) = Left $ c
187 genStaticLit c@(CmmLabelOff _ _) = Left $ c
188 genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
189
190 genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
191
192 genStaticLit (CmmHighStackMark)
193 = panic "genStaticLit: CmmHighStackMark unsupported!"
194
195
196 -- -----------------------------------------------------------------------------
197 -- * Misc
198 --
199
200 -- | Error Function
201 panic :: String -> a
202 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
203