Implement function-sections for Haskell code, #8405
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Data.hs
1 {-# LANGUAGE CPP #-}
2 -- ----------------------------------------------------------------------------
3 -- | Handle conversion of CmmData to LLVM code.
4 --
5
6 module LlvmCodeGen.Data (
7 genLlvmData, genData
8 ) where
9
10 #include "HsVersions.h"
11
12 import Llvm
13 import LlvmCodeGen.Base
14
15 import BlockId
16 import CLabel
17 import Cmm
18 import DynFlags
19
20 import FastString
21 import Outputable
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.
36 genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
37 genLlvmData (sec, Statics lbl xs) = do
38 label <- strCLabel_llvm lbl
39 static <- mapM genData xs
40 lmsec <- llvmSection sec
41 let types = map getStatType static
42
43 strucTy = LMStruct types
44 tyAlias = LMAlias ((label `appendFS` structStr), strucTy)
45
46 struct = Just $ LMStaticStruc static tyAlias
47 link = if (externallyVisibleCLabel lbl)
48 then ExternallyVisible else Internal
49 const = if isSecConstant sec then Constant else Global
50 varDef = LMGlobalVar label tyAlias link lmsec Nothing const
51 globDef = LMGlobal varDef struct
52
53 return ([globDef], [tyAlias])
54
55 -- | Should a data in this section be considered constant
56 isSecConstant :: Section -> Bool
57 isSecConstant (Section t _) = case t of
58 Text -> True
59 ReadOnlyData -> True
60 RelocatableReadOnlyData -> True
61 ReadOnlyData16 -> True
62 Data -> False
63 UninitialisedData -> False
64 (OtherSection _) -> False
65
66 -- | Format the section type part of a Cmm Section
67 llvmSectionType :: SectionType -> FastString
68 llvmSectionType t = case t of
69 Text -> fsLit ".text"
70 ReadOnlyData -> fsLit ".rodata"
71 RelocatableReadOnlyData -> fsLit ".data.rel.ro"
72 ReadOnlyData16 -> fsLit ".rodata.cst16"
73 Data -> fsLit ".data"
74 UninitialisedData -> fsLit ".bss"
75 (OtherSection _) -> panic "llvmSectionType: unknown section type"
76
77 -- | Format a Cmm Section into a LLVM section name
78 llvmSection :: Section -> LlvmM LMSection
79 llvmSection (Section t suffix) = do
80 dflags <- getDynFlags
81 let splitSect = gopt Opt_SplitSections dflags
82 if not splitSect
83 then return Nothing
84 else do
85 lmsuffix <- strCLabel_llvm suffix
86 return (Just (concatFS [llvmSectionType t, fsLit ".", lmsuffix]))
87
88 -- ----------------------------------------------------------------------------
89 -- * Generate static data
90 --
91
92 -- | Handle static data
93 genData :: CmmStatic -> LlvmM LlvmStatic
94
95 genData (CmmString str) = do
96 let v = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
97 ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
98 return $ LMStaticArray ve (LMArray (length ve) i8)
99
100 genData (CmmUninitialised bytes)
101 = return $ LMUninitType (LMArray bytes i8)
102
103 genData (CmmStaticLit lit)
104 = genStaticLit lit
105
106 -- | Generate Llvm code for a static literal.
107 --
108 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
109 -- which isn't yet known.
110 genStaticLit :: CmmLit -> LlvmM LlvmStatic
111 genStaticLit (CmmInt i w)
112 = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
113
114 genStaticLit (CmmFloat r w)
115 = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
116
117 genStaticLit (CmmVec ls)
118 = do sls <- mapM toLlvmLit ls
119 return $ LMStaticLit (LMVectorLit sls)
120 where
121 toLlvmLit :: CmmLit -> LlvmM LlvmLit
122 toLlvmLit lit = do
123 slit <- genStaticLit lit
124 case slit of
125 LMStaticLit llvmLit -> return llvmLit
126 _ -> panic "genStaticLit"
127
128 -- Leave unresolved, will fix later
129 genStaticLit cmm@(CmmLabel l) = do
130 var <- getGlobalPtr =<< strCLabel_llvm l
131 dflags <- getDynFlags
132 let ptr = LMStaticPointer var
133 lmty = cmmToLlvmType $ cmmLitType dflags cmm
134 return $ LMPtoI ptr lmty
135
136 genStaticLit (CmmLabelOff label off) = do
137 dflags <- getDynFlags
138 var <- genStaticLit (CmmLabel label)
139 let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
140 return $ LMAdd var offset
141
142 genStaticLit (CmmLabelDiffOff l1 l2 off) = do
143 dflags <- getDynFlags
144 var1 <- genStaticLit (CmmLabel l1)
145 var2 <- genStaticLit (CmmLabel l2)
146 let var = LMSub var1 var2
147 offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
148 return $ LMAdd var offset
149
150 genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
151
152 genStaticLit (CmmHighStackMark)
153 = panic "genStaticLit: CmmHighStackMark unsupported!"