Fold ghc-prim.git into ghc.git (re #8545)
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Data.hs
1 -- ----------------------------------------------------------------------------
2 -- | Handle conversion of CmmData to LLVM code.
3 --
4
5 module LlvmCodeGen.Data (
6 genLlvmData
7 ) where
8
9 #include "HsVersions.h"
10
11 import Llvm
12 import LlvmCodeGen.Base
13
14 import BlockId
15 import CLabel
16 import Cmm
17
18 import FastString
19 import qualified Outputable
20
21 -- ----------------------------------------------------------------------------
22 -- * Constants
23 --
24
25 -- | The string appended to a variable name to create its structure type alias
26 structStr :: LMString
27 structStr = fsLit "_struct"
28
29 -- ----------------------------------------------------------------------------
30 -- * Top level
31 --
32
33 -- | Pass a CmmStatic section to an equivalent Llvm code.
34 genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
35 genLlvmData (sec, Statics lbl xs) = do
36 label <- strCLabel_llvm lbl
37 static <- mapM genData xs
38 let types = map getStatType static
39
40 strucTy = LMStruct types
41 alias = LMAlias ((label `appendFS` structStr), strucTy)
42
43 struct = Just $ LMStaticStruc static alias
44 link = if (externallyVisibleCLabel lbl)
45 then ExternallyVisible else Internal
46 const = if isSecConstant sec then Constant else Global
47 glob = LMGlobalVar label alias link Nothing Nothing const
48
49 return ([LMGlobal glob struct], [alias])
50
51 -- | Should a data in this section be considered constant
52 isSecConstant :: Section -> Bool
53 isSecConstant Text = True
54 isSecConstant ReadOnlyData = True
55 isSecConstant RelocatableReadOnlyData = True
56 isSecConstant ReadOnlyData16 = True
57 isSecConstant Data = False
58 isSecConstant UninitialisedData = False
59 isSecConstant (OtherSection _) = False
60
61
62 -- ----------------------------------------------------------------------------
63 -- * Generate static data
64 --
65
66 -- | Handle static data
67 genData :: CmmStatic -> LlvmM LlvmStatic
68
69 genData (CmmString str) = do
70 let v = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
71 ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
72 return $ LMStaticArray ve (LMArray (length ve) i8)
73
74 genData (CmmUninitialised bytes)
75 = return $ LMUninitType (LMArray bytes i8)
76
77 genData (CmmStaticLit lit)
78 = genStaticLit lit
79
80 -- | Generate Llvm code for a static literal.
81 --
82 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
83 -- which isn't yet known.
84 genStaticLit :: CmmLit -> LlvmM LlvmStatic
85 genStaticLit (CmmInt i w)
86 = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
87
88 genStaticLit (CmmFloat r w)
89 = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
90
91 genStaticLit (CmmVec ls)
92 = do sls <- mapM toLlvmLit ls
93 return $ LMStaticLit (LMVectorLit sls)
94 where
95 toLlvmLit :: CmmLit -> LlvmM LlvmLit
96 toLlvmLit lit = do
97 slit <- genStaticLit lit
98 case slit of
99 LMStaticLit llvmLit -> return llvmLit
100 _ -> panic "genStaticLit"
101
102 -- Leave unresolved, will fix later
103 genStaticLit cmm@(CmmLabel l) = do
104 var <- getGlobalPtr =<< strCLabel_llvm l
105 dflags <- getDynFlags
106 let ptr = LMStaticPointer var
107 lmty = cmmToLlvmType $ cmmLitType dflags cmm
108 return $ LMPtoI ptr lmty
109
110 genStaticLit (CmmLabelOff label off) = do
111 dflags <- getDynFlags
112 var <- genStaticLit (CmmLabel label)
113 let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
114 return $ LMAdd var offset
115
116 genStaticLit (CmmLabelDiffOff l1 l2 off) = do
117 dflags <- getDynFlags
118 var1 <- genStaticLit (CmmLabel l1)
119 var2 <- genStaticLit (CmmLabel l2)
120 let var = LMSub var1 var2
121 offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
122 return $ LMAdd var offset
123
124 genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
125
126 genStaticLit (CmmHighStackMark)
127 = panic "genStaticLit: CmmHighStackMark unsupported!"
128
129 -- -----------------------------------------------------------------------------
130 -- * Misc
131 --
132
133 -- | Error Function
134 panic :: String -> a
135 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
136