1 -- ----------------------------------------------------------------------------
2 -- | Handle conversion of CmmData to LLVM code.
5 module LlvmCodeGen.Data (
6 genLlvmData, resolveLlvmDatas, resolveLlvmData
9 #include "HsVersions.h"
12 import LlvmCodeGen.Base
19 import qualified Outputable
24 -- ----------------------------------------------------------------------------
28 -- | The string appended to a variable name to create its structure type alias
30 structStr = fsLit "_struct"
32 -- ----------------------------------------------------------------------------
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
45 types = map getStatTypes static
46 getStatTypes (Left x) = cmmToLlvmType $ cmmLitType x
47 getStatTypes (Right x) = getStatType x
49 strucTy = LMStruct types
50 alias = LMAlias ((label `appendFS` structStr), strucTy)
51 in (lbl, sec, alias, static)
53 genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
56 resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData]
57 -> (LlvmEnv, [LlvmData])
58 resolveLlvmDatas env [] ldata
61 resolveLlvmDatas env (udata : rest) ldata
62 = let (env', ndata) = resolveLlvmData env udata
63 in resolveLlvmDatas env' rest (ldata ++ [ndata])
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]))
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
90 -- ----------------------------------------------------------------------------
91 -- ** Resolve Data/CLabel references
94 -- | Resolve data list
95 resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
96 -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
98 resDatas env [] (stat, glob)
101 resDatas env (cmm : rest) (stats, globs)
102 = let (env', nstat, nglob) = resData env cmm
103 in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
105 -- | Resolve an individual static label if it needs to be.
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 definition for the referenced label and
110 -- then make a pointer.
111 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
113 resData env (Right stat) = (env, stat, [Nothing])
115 resData env (Left cmm@(CmmLabel l)) =
116 let label = strCLabel_llvm l
117 ty = funLookup label env
118 lmty = cmmToLlvmType $ cmmLitType cmm
120 -- Make generic external label defenition and then pointer to it
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
129 let var = LMGlobalVar label (LMPointer ty')
130 ExternallyVisible Nothing Nothing False
131 ptr = LMStaticPointer var
132 in (env, LMPtoI ptr lmty, [Nothing])
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)
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)
146 resData _ _ = panic "resData: Non CLabel expr as left type!"
148 -- ----------------------------------------------------------------------------
149 -- * Generate static data
152 -- | Handle static data
153 -- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
154 genData :: CmmStatic -> UnresStatic
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)
161 genData (CmmUninitialised bytes)
162 = Right $ LMUninitType (LMArray bytes i8)
164 genData (CmmStaticLit lit)
168 = panic "genData: Can't handle CmmAlign!"
170 genData (CmmDataLabel _)
171 = panic "genData: Can't handle data labels not at top of data!"
174 -- | Generate Llvm code for a static literal.
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))
182 genStaticLit (CmmFloat r w)
183 = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
185 -- Leave unresolved, will fix later
186 genStaticLit c@(CmmLabel _ ) = Left $ c
187 genStaticLit c@(CmmLabelOff _ _) = Left $ c
188 genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
190 genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
192 genStaticLit (CmmHighStackMark)
193 = panic "genStaticLit: CmmHighStackMark unsupported!"
196 -- -----------------------------------------------------------------------------
202 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s