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