X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvm%2FTypes.hs;h=3637c864673ebd74f51c01f2ee3960ed3bc7cc1e;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hp=19a441f1b3a10fab5e1b80f09c22b86bcd47a7d2;hpb=9e58a660bd80277669ef7a367ff6367fda51a8a4;p=ghc-hetmet.git diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 19a441f..3637c86 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -5,7 +5,6 @@ module Llvm.Types where #include "HsVersions.h" -#include "ghcconfig.h" import Data.Char import Numeric @@ -22,24 +21,26 @@ import PprBase -- -- | A global mutable variable. Maybe defined or external -type LMGlobal = (LlvmVar, Maybe LlvmStatic) +type LMGlobal = (LlvmVar, Maybe LlvmStatic) -- | A String in LLVM -type LMString = FastString +type LMString = FastString +-- | A type alias +type LlvmAlias = (LMString, LlvmType) --- | Llvm Types. +-- | Llvm Types data LlvmType - = LMInt Int -- ^ An integer with a given width in bits. - | LMFloat -- ^ 32 bit floating point - | LMDouble -- ^ 64 bit floating point - | LMFloat80 -- ^ 80 bit (x86 only) floating point - | LMFloat128 -- ^ 128 bit floating point - | LMPointer LlvmType -- ^ A pointer to a 'LlvmType' - | LMArray Int LlvmType -- ^ An array of 'LlvmType' - | LMLabel -- ^ A 'LlvmVar' can represent a label (address) - | LMVoid -- ^ Void type - | LMStruct [LlvmType] -- ^ Structure type - | LMAlias LMString LlvmType -- ^ A type alias + = LMInt Int -- ^ An integer with a given width in bits. + | LMFloat -- ^ 32 bit floating point + | LMDouble -- ^ 64 bit floating point + | LMFloat80 -- ^ 80 bit (x86 only) floating point + | LMFloat128 -- ^ 128 bit floating point + | LMPointer LlvmType -- ^ A pointer to a 'LlvmType' + | LMArray Int LlvmType -- ^ An array of 'LlvmType' + | LMLabel -- ^ A 'LlvmVar' can represent a label (address) + | LMVoid -- ^ Void type + | LMStruct [LlvmType] -- ^ Structure type + | LMAlias LlvmAlias -- ^ A type alias -- | Function type, used to create pointers to functions | LMFunction LlvmFunctionDecl @@ -55,16 +56,20 @@ instance Show LlvmType where show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]" show (LMLabel ) = "label" show (LMVoid ) = "void" - show (LMStruct tys ) = "{" ++ (commaCat tys) ++ "}" + show (LMStruct tys ) = "<{" ++ (commaCat tys) ++ "}>" - show (LMFunction (LlvmFunctionDecl _ _ _ r VarArgs p _)) - = show r ++ " (" ++ (either commaCat commaCat p) ++ ", ...)" - show (LMFunction (LlvmFunctionDecl _ _ _ r FixedArgs p _)) - = show r ++ " (" ++ (either commaCat commaCat p) ++ ")" + show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _)) + = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists + map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p + varg' = case varg of + VarArgs | not (null args) -> ", ..." + | otherwise -> "..." + _otherwise -> "" + in show r ++ " (" ++ args ++ varg' ++ ")" - show (LMAlias s _ ) = "%" ++ unpackFS s + show (LMAlias (s,_)) = "%" ++ unpackFS s --- | An LLVM section defenition. If Nothing then let LLVM decide the section +-- | An LLVM section definition. If Nothing then let LLVM decide the section type LMSection = Maybe LMString type LMAlign = Maybe Int type LMConst = Bool -- ^ is a variable constant or not @@ -95,6 +100,10 @@ data LlvmLit = LMIntLit Integer LlvmType -- | Floating point literal | LMFloatLit Double LlvmType + -- | Literal NULL, only applicable to pointer types + | LMNullLit LlvmType + -- | Undefined value, random bit pattern. Useful for optimisations. + | LMUndefLit LlvmType deriving (Eq) instance Show LlvmLit where @@ -136,9 +145,9 @@ instance Show LlvmStatic where show (LMStaticStruc d t) = let struc = case d of - [] -> "{}" - ts -> "{" ++ show (head ts) ++ - concat (map (\x -> "," ++ show x) (tail ts)) ++ "}" + [] -> "<{}>" + ts -> "<{" ++ show (head ts) ++ + concat (map (\x -> "," ++ show x) (tail ts)) ++ "}>" in show t ++ " " ++ struc show (LMStaticPointer v) = show v @@ -151,14 +160,16 @@ instance Show LlvmStatic where show (LMAdd s1 s2) = let ty1 = getStatType s1 + op = if isFloat ty1 then " fadd (" else " add (" in if ty1 == getStatType s2 - then show ty1 ++ " add (" ++ show s1 ++ "," ++ show s2 ++ ")" + then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")" else error $ "LMAdd with different types! s1: " ++ show s1 ++ ", s2: " ++ show s2 show (LMSub s1 s2) = let ty1 = getStatType s1 + op = if isFloat ty1 then " fsub (" else " sub (" in if ty1 == getStatType s2 - then show ty1 ++ " sub (" ++ show s1 ++ "," ++ show s2 ++ ")" + then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")" else error $ "LMSub with different types! s1: " ++ show s1 ++ ", s2: " ++ show s2 @@ -168,6 +179,11 @@ commaCat :: Show a => [a] -> String commaCat [] = "" commaCat x = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x)) +-- | Concatenate an array together, separated by commas +spaceCat :: Show a => [a] -> String +spaceCat [] = "" +spaceCat x = show (head x) ++ (concat $ map (\y -> " " ++ show y) (tail x)) + -- ----------------------------------------------------------------------------- -- ** Operations on LLVM Basic Types and Variables -- @@ -184,7 +200,8 @@ getName v@(LMLitVar _ ) = getPlainName v -- in a plain textual representation (e.g. @x@, @y@ or @42@). getPlainName :: LlvmVar -> String getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x -getPlainName (LMLocalVar x _ ) = show x +getPlainName (LMLocalVar x LMLabel ) = show x +getPlainName (LMLocalVar x _ ) = "l" ++ show x getPlainName (LMNLocalVar x _ ) = unpackFS x getPlainName (LMLitVar x ) = getLit x @@ -194,6 +211,8 @@ getLit (LMIntLit i _) = show ((fromInteger i)::Int) getLit (LMFloatLit r LMFloat ) = fToStr $ realToFrac r getLit (LMFloatLit r LMDouble) = dToStr r getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f +getLit (LMNullLit _) = "null" +getLit (LMUndefLit _) = "undef" -- | Return the 'LlvmType' of the 'LlvmVar' getVarType :: LlvmVar -> LlvmType @@ -206,6 +225,8 @@ getVarType (LMLitVar l ) = getLitType l getLitType :: LlvmLit -> LlvmType getLitType (LMIntLit _ t) = t getLitType (LMFloatLit _ t) = t +getLitType (LMNullLit t) = t +getLitType (LMUndefLit t) = t -- | Return the 'LlvmType' of the 'LlvmStatic' getStatType :: LlvmStatic -> LlvmType @@ -299,7 +320,7 @@ llvmWidthInBits LMLabel = 0 llvmWidthInBits LMVoid = 0 llvmWidthInBits (LMStruct tys) = sum $ map llvmWidthInBits tys llvmWidthInBits (LMFunction _) = 0 -llvmWidthInBits (LMAlias _ t) = llvmWidthInBits t +llvmWidthInBits (LMAlias (_,t)) = llvmWidthInBits t -- ----------------------------------------------------------------------------- @@ -326,19 +347,18 @@ llvmWordPtr = pLift llvmWord -- | An LLVM Function data LlvmFunctionDecl = LlvmFunctionDecl { - -- | Unique identifier of the function. + -- | Unique identifier of the function decName :: LMString, - -- | LinkageType of the function. + -- | LinkageType of the function funcLinkage :: LlvmLinkageType, - -- | The calling convention of the function. + -- | The calling convention of the function funcCc :: LlvmCallConvention, -- | Type of the returned value decReturnType :: LlvmType, -- | Indicates if this function uses varargs decVarargs :: LlvmParameterListType, - -- | Signature of the parameters, can be just types or full vars - -- if parameter names are required. - decParams :: Either [LlvmType] [LlvmVar], + -- | Parameter types and attributes + decParams :: [LlvmParameter], -- | Function align value, must be power of 2 funcAlign :: LMAlign } @@ -346,15 +366,66 @@ data LlvmFunctionDecl = LlvmFunctionDecl { instance Show LlvmFunctionDecl where show (LlvmFunctionDecl n l c r varg p a) - = let varg' = if varg == VarArgs then ", ..." else "" + = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists + map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p + varg' = case varg of + VarArgs | not (null args) -> ", ..." + | otherwise -> "..." + _otherwise -> "" align = case a of Just a' -> " align " ++ show a' Nothing -> "" - in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++ - "(" ++ (either commaCat commaCat p) ++ varg' ++ ")" ++ align + in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++ + "(" ++ args ++ varg' ++ ")" ++ align type LlvmFunctionDecls = [LlvmFunctionDecl] +type LlvmParameter = (LlvmType, [LlvmParamAttr]) + +-- | LLVM Parameter Attributes. +-- +-- Parameter attributes are used to communicate additional information about +-- the result or parameters of a function +data LlvmParamAttr + -- | This indicates to the code generator that the parameter or return value + -- should be zero-extended to a 32-bit value by the caller (for a parameter) + -- or the callee (for a return value). + = ZeroExt + -- | This indicates to the code generator that the parameter or return value + -- should be sign-extended to a 32-bit value by the caller (for a parameter) + -- or the callee (for a return value). + | SignExt + -- | This indicates that this parameter or return value should be treated in + -- a special target-dependent fashion during while emitting code for a + -- function call or return (usually, by putting it in a register as opposed + -- to memory). + | InReg + -- | This indicates that the pointer parameter should really be passed by + -- value to the function. + | ByVal + -- | This indicates that the pointer parameter specifies the address of a + -- structure that is the return value of the function in the source program. + | SRet + -- | This indicates that the pointer does not alias any global or any other + -- parameter. + | NoAlias + -- | This indicates that the callee does not make any copies of the pointer + -- that outlive the callee itself + | NoCapture + -- | This indicates that the pointer parameter can be excised using the + -- trampoline intrinsics. + | Nest + deriving (Eq) + +instance Show LlvmParamAttr where + show ZeroExt = "zeroext" + show SignExt = "signext" + show InReg = "inreg" + show ByVal = "byval" + show SRet = "sret" + show NoAlias = "noalias" + show NoCapture = "nocapture" + show Nest = "nest" -- | Llvm Function Attributes. -- @@ -577,10 +648,14 @@ data LlvmMachOp | LM_MO_Mul -- ^ multiply .. | LM_MO_UDiv -- ^ unsigned integer or vector division. | LM_MO_SDiv -- ^ signed integer .. - | LM_MO_FDiv -- ^ floating point .. | LM_MO_URem -- ^ unsigned integer or vector remainder (mod) | LM_MO_SRem -- ^ signed ... - | LM_MO_FRem -- ^ floating point ... + + | LM_MO_FAdd -- ^ add two floating point or vector values. + | LM_MO_FSub -- ^ subtract two ... + | LM_MO_FMul -- ^ multiply ... + | LM_MO_FDiv -- ^ divide ... + | LM_MO_FRem -- ^ remainder ... -- | Left shift | LM_MO_Shl @@ -603,9 +678,12 @@ instance Show LlvmMachOp where show LM_MO_Mul = "mul" show LM_MO_UDiv = "udiv" show LM_MO_SDiv = "sdiv" - show LM_MO_FDiv = "fdiv" show LM_MO_URem = "urem" show LM_MO_SRem = "srem" + show LM_MO_FAdd = "fadd" + show LM_MO_FSub = "fsub" + show LM_MO_FMul = "fmul" + show LM_MO_FDiv = "fdiv" show LM_MO_FRem = "frem" show LM_MO_Shl = "shl" show LM_MO_LShr = "lshr"