X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvm%2FTypes.hs;h=3637c864673ebd74f51c01f2ee3960ed3bc7cc1e;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hp=4956d8d5afb4ae6bb3c32f2f310f7245096b862d;hpb=14c1d88f583c0f1110b87d4396e0b7063fac231b;p=ghc-hetmet.git diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 4956d8d..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,7 +56,7 @@ 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 varg p _)) = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists @@ -66,9 +67,9 @@ instance Show LlvmType where _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 @@ -99,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 @@ -140,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 @@ -155,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 @@ -193,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 @@ -203,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 @@ -215,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 @@ -308,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 -- ----------------------------------------------------------------------------- @@ -636,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 @@ -662,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"