funLookup, funInsert,
cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
- llvmFunSig, llvmStdFunAttrs, llvmPtrBits, llvmGhcCC,
+ llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
+ llvmPtrBits, mkLlvmFunc, tysToParams,
- strCLabel_llvm,
- genCmmLabelRef, genStringLabelRef
+ strCLabel_llvm, genCmmLabelRef, genStringLabelRef
) where
import Llvm
import LlvmCodeGen.Regs
-import CgUtils ( activeStgRegs )
import CLabel
-import Cmm
-
+import CgUtils ( activeStgRegs )
+import Constants
import FastString
+import OldCmm
import qualified Outputable as Outp
-import Unique
import UniqFM
+import Unique
-- ----------------------------------------------------------------------------
-- * Some Data Types
type LlvmBasicBlock = GenBasicBlock LlvmStatement
-- | Unresolved code.
--- Of the form: (data label, data type, unresovled data)
-type LlvmUnresData = (CLabel, LlvmType, [UnresStatic])
+-- Of the form: (data label, data type, unresolved data)
+type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
-- | Top level LLVM Data (globals and type aliases)
type LlvmData = ([LMGlobal], [LlvmType])
--
-- Labels are unresolved when we haven't yet determined if they are defined in
-- the module we are currently compiling, or an external one.
-type UnresLabel = CmmLit
+type UnresLabel = CmmLit
type UnresStatic = Either UnresLabel LlvmStatic
-- ----------------------------------------------------------------------------
-- | Llvm Function type for Cmm function
llvmFunTy :: LlvmType
-llvmFunTy
- = LMFunction $
- LlvmFunctionDecl (fsLit "a") ExternallyVisible llvmGhcCC LMVoid FixedArgs
- (Left $ map getVarType llvmFunArgs)
+llvmFunTy = LMFunction $ llvmFunSig' (fsLit "a") ExternallyVisible
-- | Llvm Function signature
llvmFunSig :: CLabel -> LlvmLinkageType -> LlvmFunctionDecl
-llvmFunSig lbl link
- = let n = strCLabel_llvm lbl
- in LlvmFunctionDecl n link llvmGhcCC LMVoid FixedArgs
- (Right llvmFunArgs)
+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
+
+-- | Create a Haskell function in LLVM.
+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
+
+-- | Alignment to use for functions
+llvmFunAlign :: LMAlign
+llvmFunAlign = Just wORD_SIZE
+
+-- | Alignment to use for into tables
+llvmInfAlign :: LMAlign
+llvmInfAlign = Just wORD_SIZE
-- | A Function's arguments
llvmFunArgs :: [LlvmVar]
llvmStdFunAttrs :: [LlvmFuncAttr]
llvmStdFunAttrs = [NoUnwind]
+-- | Convert a list of types to a list of function parameters
+-- (each with no parameter attributes)
+tysToParams :: [LlvmType] -> [LlvmParameter]
+tysToParams = map (\ty -> (ty, []))
+
-- | Pointer width
llvmPtrBits :: Int
llvmPtrBits = widthInBits $ typeWidth gcWord
-- | Create an external definition for a 'CLabel' defined in another module.
genCmmLabelRef :: CLabel -> LMGlobal
-genCmmLabelRef cl =
- let mcl = strCLabel_llvm cl
- in (LMGlobalVar mcl (LMPointer (LMArray 0 llvmWord)) External, Nothing)
+genCmmLabelRef = genStringLabelRef . strCLabel_llvm
-- | As above ('genCmmLabelRef') but taking a 'LMString', not 'CLabel'.
genStringLabelRef :: LMString -> LMGlobal
-genStringLabelRef cl =
- (LMGlobalVar cl (LMPointer (LMArray 0 llvmWord)) External, Nothing)
+genStringLabelRef cl
+ = let ty = LMPointer $ LMArray 0 llvmWord
+ in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
-- ----------------------------------------------------------------------------