1 -- ----------------------------------------------------------------------------
2 -- | Base LLVM Code Generation module
4 -- Contains functions useful through out the code generator.
7 module LlvmCodeGen.Base (
9 LlvmCmmTop, LlvmBasicBlock,
10 LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
12 LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert,
15 cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
16 llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
17 llvmPtrBits, llvmGhcCC,
19 strCLabel_llvm, genCmmLabelRef, genStringLabelRef
23 #include "HsVersions.h"
26 import LlvmCodeGen.Regs
28 import CgUtils ( activeStgRegs )
33 import qualified Outputable as Outp
37 -- ----------------------------------------------------------------------------
41 type LlvmCmmTop = GenCmmTop LlvmData [CmmStatic] (ListGraph LlvmStatement)
42 type LlvmBasicBlock = GenBasicBlock LlvmStatement
45 -- Of the form: (data label, data type, unresovled data)
46 type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
48 -- | Top level LLVM Data (globals and type aliases)
49 type LlvmData = ([LMGlobal], [LlvmType])
51 -- | An unresolved Label.
53 -- Labels are unresolved when we haven't yet determined if they are defined in
54 -- the module we are currently compiling, or an external one.
55 type UnresLabel = CmmLit
56 type UnresStatic = Either UnresLabel LlvmStatic
58 -- ----------------------------------------------------------------------------
59 -- * Type translations
62 -- | Translate a basic CmmType to an LlvmType.
63 cmmToLlvmType :: CmmType -> LlvmType
64 cmmToLlvmType ty | isFloatType ty = widthToLlvmFloat $ typeWidth ty
65 | otherwise = widthToLlvmInt $ typeWidth ty
67 -- | Translate a Cmm Float Width to a LlvmType.
68 widthToLlvmFloat :: Width -> LlvmType
69 widthToLlvmFloat W32 = LMFloat
70 widthToLlvmFloat W64 = LMDouble
71 widthToLlvmFloat W80 = LMFloat80
72 widthToLlvmFloat W128 = LMFloat128
73 widthToLlvmFloat w = panic $ "widthToLlvmFloat: Bad float size: " ++ show w
75 -- | Translate a Cmm Bit Width to a LlvmType.
76 widthToLlvmInt :: Width -> LlvmType
77 widthToLlvmInt w = LMInt $ widthInBits w
79 -- | GHC Call Convention for LLVM
80 llvmGhcCC :: LlvmCallConvention
83 -- | Llvm Function type for Cmm function
87 LlvmFunctionDecl (fsLit "a") ExternallyVisible llvmGhcCC LMVoid FixedArgs
88 (Left $ map getVarType llvmFunArgs) llvmFunAlign
90 -- | Llvm Function signature
91 llvmFunSig :: CLabel -> LlvmLinkageType -> LlvmFunctionDecl
93 = let n = strCLabel_llvm lbl
94 in LlvmFunctionDecl n link llvmGhcCC LMVoid FixedArgs
95 (Right llvmFunArgs) llvmFunAlign
97 -- | Alignment to use for functions
98 llvmFunAlign :: LMAlign
101 -- | Alignment to use for into tables
102 llvmInfAlign :: LMAlign
103 llvmInfAlign = Just 4
105 -- | A Function's arguments
106 llvmFunArgs :: [LlvmVar]
107 llvmFunArgs = map lmGlobalRegArg activeStgRegs
109 -- | Llvm standard fun attributes
110 llvmStdFunAttrs :: [LlvmFuncAttr]
111 llvmStdFunAttrs = [NoUnwind]
115 llvmPtrBits = widthInBits $ typeWidth gcWord
118 -- ----------------------------------------------------------------------------
119 -- * Environment Handling
122 type LlvmEnvMap = UniqFM LlvmType
123 -- two maps, one for functions and one for local vars.
124 type LlvmEnv = (LlvmEnvMap, LlvmEnvMap)
126 -- | Get initial Llvm environment.
127 initLlvmEnv :: LlvmEnv
128 initLlvmEnv = (emptyUFM, emptyUFM)
130 -- | Clear variables from the environment.
131 clearVars :: LlvmEnv -> LlvmEnv
132 clearVars (e1, _) = (e1, emptyUFM)
134 -- | Insert functions into the environment.
135 varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
136 varInsert s t (e1, e2) = (e1, addToUFM e2 s t)
137 funInsert s t (e1, e2) = (addToUFM e1 s t, e2)
139 -- | Lookup functions in the environment.
140 varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
141 varLookup s (_, e2) = lookupUFM e2 s
142 funLookup s (e1, _) = lookupUFM e1 s
145 -- ----------------------------------------------------------------------------
149 -- | Pretty print a 'CLabel'.
150 strCLabel_llvm :: CLabel -> LMString
151 strCLabel_llvm l = (fsLit . show . llvmSDoc . pprCLabel) l
153 -- | Create an external definition for a 'CLabel' defined in another module.
154 genCmmLabelRef :: CLabel -> LMGlobal
155 genCmmLabelRef = genStringLabelRef . strCLabel_llvm
157 -- | As above ('genCmmLabelRef') but taking a 'LMString', not 'CLabel'.
158 genStringLabelRef :: LMString -> LMGlobal
160 = let ty = LMPointer $ LMArray 0 llvmWord
161 in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
164 -- ----------------------------------------------------------------------------
170 panic s = Outp.panic $ "LlvmCodeGen.Base." ++ s