module LlvmCodeGen.Base (
LlvmCmmTop, LlvmBasicBlock,
LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert,
funLookup, funInsert,
cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
llvmPtrBits, mkLlvmFunc, tysToParams,
strCLabel_llvm, genCmmLabelRef, genStringLabelRef
) where
#include "HsVersions.h"
import Llvm
import LlvmCodeGen.Regs
import CLabel
import CgUtils ( activeStgRegs )
import Cmm
import Constants
import FastString
import qualified Outputable as Outp
import UniqFM
import Unique
type LlvmCmmTop = GenCmmTop LlvmData [CmmStatic] (ListGraph LlvmStatement)
type LlvmBasicBlock = GenBasicBlock LlvmStatement
type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
type LlvmData = ([LMGlobal], [LlvmType])
type UnresLabel = CmmLit
type UnresStatic = Either UnresLabel LlvmStatic
cmmToLlvmType :: CmmType -> LlvmType
cmmToLlvmType ty | isFloatType ty = widthToLlvmFloat $ typeWidth ty
| otherwise = widthToLlvmInt $ typeWidth ty
widthToLlvmFloat :: Width -> LlvmType
widthToLlvmFloat W32 = LMFloat
widthToLlvmFloat W64 = LMDouble
widthToLlvmFloat W80 = LMFloat80
widthToLlvmFloat W128 = LMFloat128
widthToLlvmFloat w = panic $ "widthToLlvmFloat: Bad float size: " ++ show w
widthToLlvmInt :: Width -> LlvmType
widthToLlvmInt w = LMInt $ widthInBits w
llvmGhcCC :: LlvmCallConvention
llvmGhcCC = CC_Ncc 10
llvmFunTy :: LlvmType
llvmFunTy = LMFunction $ llvmFunSig' (fsLit "a") ExternallyVisible
llvmFunSig :: CLabel -> LlvmLinkageType -> LlvmFunctionDecl
llvmFunSig lbl link = llvmFunSig' (strCLabel_llvm lbl) link
llvmFunSig' :: LMString -> LlvmLinkageType -> LlvmFunctionDecl
llvmFunSig' lbl link
= let toParams x | isPointer x = (x, [NoAlias, NoCapture])
| otherwise = (x, [])
in LlvmFunctionDecl lbl link llvmGhcCC LMVoid FixedArgs
(map (toParams . getVarType) llvmFunArgs) llvmFunAlign
mkLlvmFunc :: CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
-> LlvmFunction
mkLlvmFunc lbl link sec blks
= let funDec = llvmFunSig lbl link
funArgs = map (fsLit . getPlainName) llvmFunArgs
in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
llvmFunAlign :: LMAlign
llvmFunAlign = Just wORD_SIZE
llvmInfAlign :: LMAlign
llvmInfAlign = Just wORD_SIZE
llvmFunArgs :: [LlvmVar]
llvmFunArgs = map lmGlobalRegArg activeStgRegs
llvmStdFunAttrs :: [LlvmFuncAttr]
llvmStdFunAttrs = [NoUnwind]
tysToParams :: [LlvmType] -> [LlvmParameter]
tysToParams = map (\ty -> (ty, []))
llvmPtrBits :: Int
llvmPtrBits = widthInBits $ typeWidth gcWord
type LlvmEnvMap = UniqFM LlvmType
type LlvmEnv = (LlvmEnvMap, LlvmEnvMap)
initLlvmEnv :: LlvmEnv
initLlvmEnv = (emptyUFM, emptyUFM)
clearVars :: LlvmEnv -> LlvmEnv
clearVars (e1, _) = (e1, emptyUFM)
varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
varInsert s t (e1, e2) = (e1, addToUFM e2 s t)
funInsert s t (e1, e2) = (addToUFM e1 s t, e2)
varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
varLookup s (_, e2) = lookupUFM e2 s
funLookup s (e1, _) = lookupUFM e1 s
strCLabel_llvm :: CLabel -> LMString
strCLabel_llvm l = (fsLit . show . llvmSDoc . pprCLabel) l
genCmmLabelRef :: CLabel -> LMGlobal
genCmmLabelRef = genStringLabelRef . strCLabel_llvm
genStringLabelRef :: LMString -> LMGlobal
genStringLabelRef cl
= let ty = LMPointer $ LMArray 0 llvmWord
in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
panic :: String -> a
panic s = Outp.panic $ "LlvmCodeGen.Base." ++ s