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