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