never executed always true always false
1
2 -- ----------------------------------------------------------------------------
3 -- | Handle conversion of CmmData to LLVM code.
4 --
5
6 module GHC.CmmToLlvm.Data (
7 genLlvmData, genData
8 ) where
9
10 import GHC.Prelude
11
12 import GHC.Llvm
13 import GHC.CmmToLlvm.Base
14
15 import GHC.Cmm.BlockId
16 import GHC.Cmm.CLabel
17 import GHC.Cmm
18 import GHC.Platform
19
20 import GHC.Data.FastString
21 import GHC.Utils.Panic
22 import qualified Data.ByteString as BS
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 -- | The LLVM visibility of the label
33 linkage :: CLabel -> LlvmLinkageType
34 linkage lbl = if externallyVisibleCLabel lbl
35 then ExternallyVisible else Internal
36
37 -- ----------------------------------------------------------------------------
38 -- * Top level
39 --
40
41 -- | Pass a CmmStatic section to an equivalent Llvm code.
42 genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
43 -- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
44 genLlvmData (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
45 | lbl == mkIndStaticInfoLabel
46 , let labelInd (CmmLabelOff l _) = Just l
47 labelInd (CmmLabel l) = Just l
48 labelInd _ = Nothing
49 , Just ind' <- labelInd ind
50 , alias `mayRedirectTo` ind' = do
51 label <- strCLabel_llvm alias
52 label' <- strCLabel_llvm ind'
53 let link = linkage alias
54 link' = linkage ind'
55 -- the LLVM type we give the alias is an empty struct type
56 -- but it doesn't really matter, as the pointer is only
57 -- used for (bit/int)casting.
58 tyAlias = LMAlias (label `appendFS` structStr, LMStructU [])
59
60 aliasDef = LMGlobalVar label tyAlias link Nothing Nothing Alias
61 -- we don't know the type of the indirectee here
62 indType = panic "will be filled by 'aliasify', later"
63 orig = LMStaticPointer $ LMGlobalVar label' indType link' Nothing Nothing Alias
64
65 pure ([LMGlobal aliasDef $ Just orig], [tyAlias])
66
67 genLlvmData (sec, CmmStaticsRaw lbl xs) = do
68 label <- strCLabel_llvm lbl
69 static <- mapM genData xs
70 lmsec <- llvmSection sec
71 platform <- getPlatform
72 let types = map getStatType static
73
74 strucTy = LMStruct types
75 tyAlias = LMAlias (label `appendFS` structStr, strucTy)
76
77 struct = Just $ LMStaticStruc static tyAlias
78 link = linkage lbl
79 align = case sec of
80 Section CString _ -> if (platformArch platform == ArchS390X)
81 then Just 2 else Just 1
82 _ -> Nothing
83 const = if sectionProtection sec == ReadOnlySection
84 then Constant else Global
85 varDef = LMGlobalVar label tyAlias link lmsec align const
86 globDef = LMGlobal varDef struct
87
88 return ([globDef], [tyAlias])
89
90 -- | Format the section type part of a Cmm Section
91 llvmSectionType :: Platform -> SectionType -> FastString
92 llvmSectionType p t = case t of
93 Text -> fsLit ".text"
94 ReadOnlyData -> case platformOS p of
95 OSMinGW32 -> fsLit ".rdata"
96 _ -> fsLit ".rodata"
97 RelocatableReadOnlyData -> case platformOS p of
98 OSMinGW32 -> fsLit ".rdata$rel.ro"
99 _ -> fsLit ".data.rel.ro"
100 ReadOnlyData16 -> case platformOS p of
101 OSMinGW32 -> fsLit ".rdata$cst16"
102 _ -> fsLit ".rodata.cst16"
103 Data -> fsLit ".data"
104 UninitialisedData -> fsLit ".bss"
105 CString -> case platformOS p of
106 OSMinGW32 -> fsLit ".rdata$str"
107 _ -> fsLit ".rodata.str"
108 (OtherSection _) -> panic "llvmSectionType: unknown section type"
109
110 -- | Format a Cmm Section into a LLVM section name
111 llvmSection :: Section -> LlvmM LMSection
112 llvmSection (Section t suffix) = do
113 opts <- getLlvmOpts
114 let splitSect = llvmOptsSplitSections opts
115 platform = llvmOptsPlatform opts
116 if not splitSect
117 then return Nothing
118 else do
119 lmsuffix <- strCLabel_llvm suffix
120 let result sep = Just (concatFS [llvmSectionType platform t
121 , fsLit sep, lmsuffix])
122 case platformOS platform of
123 OSMinGW32 -> return (result "$")
124 _ -> return (result ".")
125
126 -- ----------------------------------------------------------------------------
127 -- * Generate static data
128 --
129
130 -- | Handle static data
131 genData :: CmmStatic -> LlvmM LlvmStatic
132
133 genData (CmmFileEmbed {}) = panic "Unexpected CmmFileEmbed literal"
134 genData (CmmString str) = do
135 let v = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8)
136 (BS.unpack str)
137 ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
138 return $ LMStaticArray ve (LMArray (length ve) i8)
139
140 genData (CmmUninitialised bytes)
141 = return $ LMUninitType (LMArray bytes i8)
142
143 genData (CmmStaticLit lit)
144 = genStaticLit lit
145
146 -- | Generate Llvm code for a static literal.
147 --
148 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
149 -- which isn't yet known.
150 genStaticLit :: CmmLit -> LlvmM LlvmStatic
151 genStaticLit (CmmInt i w)
152 = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
153
154 genStaticLit (CmmFloat r w)
155 = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
156
157 genStaticLit (CmmVec ls)
158 = do sls <- mapM toLlvmLit ls
159 return $ LMStaticLit (LMVectorLit sls)
160 where
161 toLlvmLit :: CmmLit -> LlvmM LlvmLit
162 toLlvmLit lit = do
163 slit <- genStaticLit lit
164 case slit of
165 LMStaticLit llvmLit -> return llvmLit
166 _ -> panic "genStaticLit"
167
168 -- Leave unresolved, will fix later
169 genStaticLit cmm@(CmmLabel l) = do
170 var <- getGlobalPtr =<< strCLabel_llvm l
171 platform <- getPlatform
172 let ptr = LMStaticPointer var
173 lmty = cmmToLlvmType $ cmmLitType platform cmm
174 return $ LMPtoI ptr lmty
175
176 genStaticLit (CmmLabelOff label off) = do
177 platform <- getPlatform
178 var <- genStaticLit (CmmLabel label)
179 let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord platform)
180 return $ LMAdd var offset
181
182 genStaticLit (CmmLabelDiffOff l1 l2 off w) = do
183 platform <- getPlatform
184 var1 <- genStaticLit (CmmLabel l1)
185 var2 <- genStaticLit (CmmLabel l2)
186 let var
187 | w == wordWidth platform = LMSub var1 var2
188 | otherwise = LMTrunc (LMSub var1 var2) (widthToLlvmInt w)
189 offset = LMStaticLit $ LMIntLit (toInteger off) (LMInt $ widthInBits w)
190 return $ LMAdd var offset
191
192 genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
193
194 genStaticLit (CmmHighStackMark)
195 = panic "genStaticLit: CmmHighStackMark unsupported!"