Reduce the number of passes over the cmm in llvm BE
[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 :: [CmmStatic] -> LlvmUnresData
41 genLlvmData (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, alias, static)
52
53 genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
54
55 resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData]
56 -> (LlvmEnv, [LlvmData])
57 resolveLlvmDatas env [] ldata
58 = (env, ldata)
59
60 resolveLlvmDatas env (udata : rest) ldata
61 = let (env', ndata) = resolveLlvmData env udata
62 in resolveLlvmDatas env' rest (ldata ++ [ndata])
63
64 -- | Fix up CLabel references now that we should have passed all CmmData.
65 resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
66 resolveLlvmData env (lbl, alias, unres) =
67 let (env', static, refs) = resDatas env unres ([], [])
68 refs' = catMaybes refs
69 struct = Just $ LMStaticStruc static alias
70 label = strCLabel_llvm lbl
71 link = if (externallyVisibleCLabel lbl)
72 then ExternallyVisible else Internal
73 glob = LMGlobalVar label alias link Nothing Nothing
74 in (env', (refs' ++ [(glob, struct)], [alias]))
75
76
77 -- ----------------------------------------------------------------------------
78 -- ** Resolve Data/CLabel references
79 --
80
81 -- | Resolve data list
82 resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
83 -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
84
85 resDatas env [] (stat, glob)
86 = (env, stat, glob)
87
88 resDatas env (cmm : rest) (stats, globs)
89 = let (env', nstat, nglob) = resData env cmm
90 in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
91
92 -- | Resolve an individual static label if it needs to be.
93 --
94 -- We check the 'LlvmEnv' to see if the reference has been defined in this
95 -- module. If it has we can retrieve its type and make a pointer, otherwise
96 -- we introduce a generic external defenition for the referenced label and
97 -- then make a pointer.
98 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
99
100 resData env (Right stat) = (env, stat, [Nothing])
101
102 resData env (Left cmm@(CmmLabel l)) =
103 let label = strCLabel_llvm l
104 ty = funLookup label env
105 lmty = cmmToLlvmType $ cmmLitType cmm
106 in case ty of
107 -- Make generic external label defenition and then pointer to it
108 Nothing ->
109 let glob@(var, _) = genStringLabelRef label
110 env' = funInsert label (pLower $ getVarType var) env
111 ptr = LMStaticPointer var
112 in (env', LMPtoI ptr lmty, [Just glob])
113 -- Referenced data exists in this module, retrieve type and make
114 -- pointer to it.
115 Just ty' ->
116 let var = LMGlobalVar label (LMPointer ty')
117 ExternallyVisible Nothing Nothing
118 ptr = LMStaticPointer var
119 in (env, LMPtoI ptr lmty, [Nothing])
120
121 resData env (Left (CmmLabelOff label off)) =
122 let (env', var, glob) = resData env (Left (CmmLabel label))
123 offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
124 in (env', LMAdd var offset, glob)
125
126 resData env (Left (CmmLabelDiffOff l1 l2 off)) =
127 let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
128 (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
129 var = LMSub var1 var2
130 offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
131 in (env2, LMAdd var offset, glob1 ++ glob2)
132
133 resData _ _ = panic "resData: Non CLabel expr as left type!"
134
135 -- ----------------------------------------------------------------------------
136 -- * Generate static data
137 --
138
139 -- | Handle static data
140 -- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
141 genData :: CmmStatic -> UnresStatic
142
143 genData (CmmString str) =
144 let v = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
145 ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
146 in Right $ LMStaticArray ve (LMArray (length ve) i8)
147
148 genData (CmmUninitialised bytes)
149 = Right $ LMUninitType (LMArray bytes i8)
150
151 genData (CmmStaticLit lit)
152 = genStaticLit lit
153
154 genData (CmmAlign _)
155 = panic "genData: Can't handle CmmAlign!"
156
157 genData (CmmDataLabel _)
158 = panic "genData: Can't handle data labels not at top of data!"
159
160
161 -- | Generate Llvm code for a static literal.
162 --
163 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
164 -- which isn't yet known.
165 genStaticLit :: CmmLit -> UnresStatic
166 genStaticLit (CmmInt i w)
167 = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
168
169 genStaticLit (CmmFloat r w)
170 = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
171
172 -- Leave unresolved, will fix later
173 genStaticLit c@(CmmLabel _ ) = Left $ c
174 genStaticLit c@(CmmLabelOff _ _) = Left $ c
175 genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
176
177 genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
178
179 genStaticLit (CmmHighStackMark)
180 = panic "genStaticLit: CmmHighStackMark unsupported!"
181
182
183 -- -----------------------------------------------------------------------------
184 -- * Misc
185 --
186
187 -- | Error Function
188 panic :: String -> a
189 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
190