compiler/llvmGen/LlvmCodeGen/Base.hs

   1 -- ----------------------------------------------------------------------------
   2 -- | Base LLVM Code Generation module
   3 --
   4 -- Contains functions useful through out the code generator.
   5 --
   6
   7 module LlvmCodeGen.Base (
   8
   9         LlvmCmmTop, LlvmBasicBlock,
  10         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
  11
  12         LlvmVersion, defaultLlvmVersion,
  13
  14         LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert,
  15         funLookup, funInsert, getLlvmVer, setLlvmVer,
  16
  17         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
  18         llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
  19         llvmPtrBits, mkLlvmFunc, tysToParams,
  20
  21         strCLabel_llvm, genCmmLabelRef, genStringLabelRef
  22
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27 import Llvm
  28 import LlvmCodeGen.Regs
  29
  30 import CLabel
  31 import CgUtils ( activeStgRegs )
  32 import Constants
  33 import FastString
  34 import OldCmm
  35 import qualified Outputable as Outp
  36 import UniqFM
  37 import Unique
  38
  39 -- ----------------------------------------------------------------------------
  40 -- * Some Data Types
  41 --
  42
  43 type LlvmCmmTop = GenCmmTop LlvmData [CmmStatic] (ListGraph LlvmStatement)
  44 type LlvmBasicBlock = GenBasicBlock LlvmStatement
  45
  46 -- | Unresolved code.
  47 -- Of the form: (data label, data type, unresolved data)
  48 type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
  49
  50 -- | Top level LLVM Data (globals and type aliases)
  51 type LlvmData = ([LMGlobal], [LlvmType])
  52
  53 -- | An unresolved Label.
  54 --
  55 -- Labels are unresolved when we haven't yet determined if they are defined in
  56 -- the module we are currently compiling, or an external one.
  57 type UnresLabel  = CmmLit
  58 type UnresStatic = Either UnresLabel LlvmStatic
  59
  60 -- ----------------------------------------------------------------------------
  61 -- * Type translations
  62 --
  63
  64 -- | Translate a basic CmmType to an LlvmType.
  65 cmmToLlvmType :: CmmType -> LlvmType
  66 cmmToLlvmType ty | isFloatType ty = widthToLlvmFloat $ typeWidth ty
  67                  | otherwise      = widthToLlvmInt   $ typeWidth ty
  68
  69 -- | Translate a Cmm Float Width to a LlvmType.
  70 widthToLlvmFloat :: Width -> LlvmType
  71 widthToLlvmFloat W32  = LMFloat
  72 widthToLlvmFloat W64  = LMDouble
  73 widthToLlvmFloat W80  = LMFloat80
  74 widthToLlvmFloat W128 = LMFloat128
  75 widthToLlvmFloat w    = panic $ "widthToLlvmFloat: Bad float size: " ++ show w
  76
  77 -- | Translate a Cmm Bit Width to a LlvmType.
  78 widthToLlvmInt :: Width -> LlvmType
  79 widthToLlvmInt w = LMInt $ widthInBits w
  80
  81 -- | GHC Call Convention for LLVM
  82 llvmGhcCC :: LlvmCallConvention
  83 llvmGhcCC = CC_Ncc 10
  84
  85 -- | Llvm Function type for Cmm function
  86 llvmFunTy :: LlvmType
  87 llvmFunTy = LMFunction $ llvmFunSig' (fsLit "a") ExternallyVisible
  88
  89 -- | Llvm Function signature
  90 llvmFunSig :: CLabel -> LlvmLinkageType -> LlvmFunctionDecl
  91 llvmFunSig lbl link = llvmFunSig' (strCLabel_llvm lbl) link
  92
  93 llvmFunSig' :: LMString -> LlvmLinkageType -> LlvmFunctionDecl
  94 llvmFunSig' lbl link
  95   = let toParams x | isPointer x = (x, [NoAlias, NoCapture])
  96                    | otherwise   = (x, [])
  97     in LlvmFunctionDecl lbl link llvmGhcCC LMVoid FixedArgs
  98                         (map (toParams . getVarType) llvmFunArgs) llvmFunAlign
  99
 100 -- | Create a Haskell function in LLVM.
 101 mkLlvmFunc :: CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
 102            -> LlvmFunction
 103 mkLlvmFunc lbl link sec blks
 104   = let funDec = llvmFunSig lbl link
 105         funArgs = map (fsLit . getPlainName) llvmFunArgs
 106     in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
 107
 108 -- | Alignment to use for functions
 109 llvmFunAlign :: LMAlign
 110 llvmFunAlign = Just wORD_SIZE
 111
 112 -- | Alignment to use for into tables
 113 llvmInfAlign :: LMAlign
 114 llvmInfAlign = Just wORD_SIZE
 115
 116 -- | A Function's arguments
 117 llvmFunArgs :: [LlvmVar]
 118 llvmFunArgs = map lmGlobalRegArg activeStgRegs
 119
 120 -- | Llvm standard fun attributes
 121 llvmStdFunAttrs :: [LlvmFuncAttr]
 122 llvmStdFunAttrs = [NoUnwind]
 123
 124 -- | Convert a list of types to a list of function parameters
 125 -- (each with no parameter attributes)
 126 tysToParams :: [LlvmType] -> [LlvmParameter]
 127 tysToParams = map (\ty -> (ty, []))
 128
 129 -- | Pointer width
 130 llvmPtrBits :: Int
 131 llvmPtrBits = widthInBits $ typeWidth gcWord
 132
 133 -- ----------------------------------------------------------------------------
 134 -- * Llvm Version
 135 --
 136
 137 -- | LLVM Version Number
 138 type LlvmVersion = Int
 139
 140 -- | The LLVM Version we assume if we don't know
 141 defaultLlvmVersion :: LlvmVersion
 142 defaultLlvmVersion = 28
 143
 144 -- ----------------------------------------------------------------------------
 145 -- * Environment Handling
 146 --
 147
 148 -- two maps, one for functions and one for local vars.
 149 newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion)
 150 type LlvmEnvMap = UniqFM LlvmType
 151
 152 -- | Get initial Llvm environment.
 153 initLlvmEnv :: LlvmEnv
 154 initLlvmEnv = LlvmEnv (emptyUFM, emptyUFM, defaultLlvmVersion)
 155
 156 -- | Clear variables from the environment.
 157 clearVars :: LlvmEnv -> LlvmEnv
 158 clearVars (LlvmEnv (e1, _, n)) = LlvmEnv (e1, emptyUFM, n)
 159
 160 -- | Insert functions into the environment.
 161 varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
 162 varInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (e1, addToUFM e2 s t, n)
 163 funInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (addToUFM e1 s t, e2, n)
 164
 165 -- | Lookup functions in the environment.
 166 varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
 167 varLookup s (LlvmEnv (_, e2, _)) = lookupUFM e2 s
 168 funLookup s (LlvmEnv (e1, _, _)) = lookupUFM e1 s
 169
 170 -- | Get the LLVM version we are generating code for
 171 getLlvmVer :: LlvmEnv -> LlvmVersion
 172 getLlvmVer (LlvmEnv (_, _, n)) = n
 173
 174 -- | Set the LLVM version we are generating code for
 175 setLlvmVer :: LlvmVersion -> LlvmEnv -> LlvmEnv
 176 setLlvmVer n (LlvmEnv (e1, e2, _)) = LlvmEnv (e1, e2, n)
 177
 178 -- ----------------------------------------------------------------------------
 179 -- * Label handling
 180 --
 181
 182 -- | Pretty print a 'CLabel'.
 183 strCLabel_llvm :: CLabel -> LMString
 184 strCLabel_llvm l = (fsLit . show . llvmSDoc . pprCLabel) l
 185
 186 -- | Create an external definition for a 'CLabel' defined in another module.
 187 genCmmLabelRef :: CLabel -> LMGlobal
 188 genCmmLabelRef = genStringLabelRef . strCLabel_llvm
 189
 190 -- | As above ('genCmmLabelRef') but taking a 'LMString', not 'CLabel'.
 191 genStringLabelRef :: LMString -> LMGlobal
 192 genStringLabelRef cl
 193   = let ty = LMPointer $ LMArray 0 llvmWord
 194     in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
 195
 196
 197 -- ----------------------------------------------------------------------------
 198 -- * Misc
 199 --
 200
 201 -- | Error function
 202 panic :: String -> a
 203 panic s = Outp.panic $ "LlvmCodeGen.Base." ++ s
 204