diff options
-rw-r--r-- | compiler/llvmGen/Llvm.hs | 2 | ||||
-rw-r--r-- | compiler/llvmGen/Llvm/AbsSyn.hs | 15 | ||||
-rw-r--r-- | compiler/llvmGen/Llvm/PpLlvm.hs | 14 | ||||
-rw-r--r-- | compiler/llvmGen/Llvm/Types.hs | 67 |
4 files changed, 71 insertions, 27 deletions
diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs index d05a90609e..d69b88ce23 100644 --- a/compiler/llvmGen/Llvm.hs +++ b/compiler/llvmGen/Llvm.hs @@ -43,7 +43,7 @@ module Llvm ( -- ** Operations on the type system. isGlobal, getLitType, getLit, getName, getPlainName, getVarType, getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower, - pLift, pLower, isInt, isFloat, isPointer, llvmWidthInBits, + pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits, -- * Pretty Printing ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals, diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs index 9133447331..f5f5eacdee 100644 --- a/compiler/llvmGen/Llvm/AbsSyn.hs +++ b/compiler/llvmGen/Llvm/AbsSyn.hs @@ -198,6 +198,21 @@ data LlvmExpression | Compare LlvmCmpOp LlvmVar LlvmVar {- | + Extract a scalar element from a vector + * val: The vector + * idx: The index of the scalar within the vector + -} + | Extract LlvmVar LlvmVar + + {- | + Insert a scalar element into a vector + * val: The source vector + * elt: The scalar to insert + * index: The index at which to insert the scalar + -} + | Insert LlvmVar LlvmVar LlvmVar + + {- | Allocate amount * sizeof(tp) bytes on the heap * tp: LlvmType to reserve room for * amount: The nr of tp's which must be allocated diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index 2b2725d187..2d4be3f8d0 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -230,6 +230,8 @@ ppLlvmExpression expr Call tp fp args attrs -> ppCall tp fp args attrs Cast op from to -> ppCast op from to Compare op left right -> ppCmpOp op left right + Extract vec idx -> ppExtract vec idx + Insert vec elt idx -> ppInsert vec elt idx GetElemPtr inb ptr indexes -> ppGetElementPtr inb ptr indexes Load ptr -> ppLoad ptr Malloc tp amount -> ppMalloc tp amount @@ -383,6 +385,18 @@ ppAsm asm constraints rty vars sideeffect alignstack = in text "call" <+> rty' <+> text "asm" <+> side <+> align <+> asm' <> comma <+> cons <> vars' +ppExtract :: LlvmVar -> LlvmVar -> SDoc +ppExtract vec idx = + text "extractelement" + <+> texts (getVarType vec) <+> text (getName vec) <> comma + <+> texts idx + +ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc +ppInsert vec elt idx = + text "insertelement" + <+> texts (getVarType vec) <+> text (getName vec) <> comma + <+> texts (getVarType elt) <+> text (getName elt) <> comma + <+> texts idx ppMetaStatement :: [MetaData] -> LlvmStatement -> SDoc ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetas meta diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index c4d9995e47..8b33c0b9dd 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -13,6 +13,7 @@ import Numeric import DynFlags import FastString +import Outputable (panic) import Unique -- from NCG @@ -34,33 +35,35 @@ type LlvmAlias = (LMString, LlvmType) -- | 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 LlvmAlias -- ^ 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' + | LMVector Int LlvmType -- ^ A vector 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 deriving (Eq) instance Show LlvmType where - show (LMInt size ) = "i" ++ show size - show (LMFloat ) = "float" - show (LMDouble ) = "double" - show (LMFloat80 ) = "x86_fp80" - show (LMFloat128 ) = "fp128" - show (LMPointer x ) = show x ++ "*" - show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]" - show (LMLabel ) = "label" - show (LMVoid ) = "void" - show (LMStruct tys ) = "<{" ++ (commaCat tys) ++ "}>" + show (LMInt size ) = "i" ++ show size + show (LMFloat ) = "float" + show (LMDouble ) = "double" + show (LMFloat80 ) = "x86_fp80" + show (LMFloat128 ) = "fp128" + show (LMPointer x ) = show x ++ "*" + show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]" + show (LMVector nr tp ) = "<" ++ show nr ++ " x " ++ show tp ++ ">" + show (LMLabel ) = "label" + show (LMVoid ) = "void" + show (LMStruct tys ) = "<{" ++ (commaCat tys) ++ "}>" show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _)) = let varg' = case varg of @@ -143,12 +146,15 @@ data LlvmLit | LMFloatLit Double LlvmType -- | Literal NULL, only applicable to pointer types | LMNullLit LlvmType + -- | Vector literal + | LMVectorLit [LlvmLit] -- | Undefined value, random bit pattern. Useful for optimisations. | LMUndefLit LlvmType deriving (Eq) instance Show LlvmLit where - show l = show (getLitType l) ++ " " ++ getLit l + show l@(LMVectorLit {}) = getLit l + show l = show (getLitType l) ++ " " ++ getLit l -- | Llvm Static Data. @@ -233,6 +239,7 @@ getLit (LMIntLit i _ ) = show (fromInteger i :: Int) getLit (LMFloatLit r LMFloat ) = (dToStr . widenFp . narrowFp) r getLit (LMFloatLit r LMDouble) = dToStr r getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f +getLit (LMVectorLit ls ) = "< " ++ commaCat ls ++ " >" getLit (LMNullLit _ ) = "null" getLit (LMUndefLit _ ) = "undef" @@ -245,10 +252,12 @@ getVarType (LMLitVar l ) = getLitType l -- | Return the 'LlvmType' of a 'LlvmLit' getLitType :: LlvmLit -> LlvmType -getLitType (LMIntLit _ t) = t -getLitType (LMFloatLit _ t) = t -getLitType (LMNullLit t) = t -getLitType (LMUndefLit t) = t +getLitType (LMIntLit _ t) = t +getLitType (LMFloatLit _ t) = t +getLitType (LMVectorLit []) = panic "getLitType" +getLitType (LMVectorLit ls) = LMVector (length ls) (getLitType (head ls)) +getLitType (LMNullLit t) = t +getLitType (LMUndefLit t) = t -- | Return the 'LlvmType' of the 'LlvmStatic' getStatType :: LlvmStatic -> LlvmType @@ -322,6 +331,11 @@ isPointer :: LlvmType -> Bool isPointer (LMPointer _) = True isPointer _ = False +-- | Test if the given 'LlvmType' is an 'LMVector' construct +isVector :: LlvmType -> Bool +isVector (LMVector {}) = True +isVector _ = False + -- | Test if a 'LlvmVar' is global. isGlobal :: LlvmVar -> Bool isGlobal (LMGlobalVar _ _ _ _ _ _) = True @@ -338,6 +352,7 @@ llvmWidthInBits _ (LMFloat128) = 128 -- it points to. We will go with the former for now. llvmWidthInBits dflags (LMPointer _) = llvmWidthInBits dflags (llvmWord dflags) llvmWidthInBits dflags (LMArray _ _) = llvmWidthInBits dflags (llvmWord dflags) +llvmWidthInBits dflags (LMVector n ty) = n * llvmWidthInBits dflags ty llvmWidthInBits _ LMLabel = 0 llvmWidthInBits _ LMVoid = 0 llvmWidthInBits dflags (LMStruct tys) = sum $ map (llvmWidthInBits dflags) tys |