[commit: ghc] master: Switch to LLVM version 3.7 (5dc3db7)

git at git.haskell.org git at git.haskell.org
Fri Oct 9 23:42:41 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5dc3db743ec477978b9727a313951be44dbd170f/ghc

>---------------------------------------------------------------

commit 5dc3db743ec477978b9727a313951be44dbd170f
Author: Erik de Castro Lopo <erikd at mega-nerd.com>
Date:   Fri Oct 9 08:21:55 2015 +1100

    Switch to LLVM version 3.7


>---------------------------------------------------------------

5dc3db743ec477978b9727a313951be44dbd170f
 compiler/llvmGen/Llvm/PpLlvm.hs      | 25 +++++++++++++++----------
 compiler/llvmGen/Llvm/Types.hs       |  1 +
 compiler/llvmGen/LlvmCodeGen.hs      | 11 +++--------
 compiler/llvmGen/LlvmCodeGen/Base.hs | 15 ++++-----------
 configure.ac                         |  2 +-
 5 files changed, 24 insertions(+), 30 deletions(-)

diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 8476b9d..e032a51 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -117,6 +117,7 @@ ppLlvmMeta (MetaNamed n m)
 
 -- | Print out an LLVM metadata value.
 ppLlvmMetaExpr :: MetaExpr -> SDoc
+ppLlvmMetaExpr (MetaVar (LMLitVar (LMNullLit _))) = text "null"
 ppLlvmMetaExpr (MetaStr    s ) = text "!" <> doubleQuotes (ftext s)
 ppLlvmMetaExpr (MetaNode   n ) = text "!" <> int n
 ppLlvmMetaExpr (MetaVar    v ) = ppr v
@@ -273,17 +274,12 @@ ppCall ct fptr args attrs = case fptr of
                 ++ "local var of pointer function type."
 
     where
-        ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
+        ppCall' (LlvmFunctionDecl _ _ cc ret _ _ _) =
             let tc = if ct == TailCall then text "tail " else empty
                 ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args
-                ppArgTy  = (ppCommaJoin $ map fst params) <>
-                           (case argTy of
-                               VarArgs   -> text ", ..."
-                               FixedArgs -> empty)
-                fnty = space <> lparen <> ppArgTy <> rparen <> char '*'
                 attrDoc = ppSpaceJoin attrs
             in  tc <> text "call" <+> ppr cc <+> ppr ret
-                    <> fnty <+> ppName fptr <> lparen <+> ppValues
+                    <+> ppName fptr <> lparen <+> ppValues
                     <+> rparen <+> attrDoc
 
         -- Metadata needs to be marked as having the `metadata` type when used
@@ -362,8 +358,11 @@ ppCmpXChg addr old new s_ord f_ord =
 -- of specifying alignment.
 
 ppLoad :: LlvmVar -> SDoc
-ppLoad var = text "load" <+> ppr var <> align
+ppLoad var = text "load" <+> derefType <+> ppr var <> align
   where
+    derefType = case getVarType var of
+                    LMPointer x -> ppr x <> comma
+                    _ -> empty
     align | isVector . pLower . getVarType $ var = text ", align 1"
           | otherwise = empty
 
@@ -373,7 +372,10 @@ ppALoad ord st var = sdocWithDynFlags $ \dflags ->
       align     = text ", align" <+> ppr alignment
       sThreaded | st        = text " singlethread"
                 | otherwise = empty
-  in text "load atomic" <+> ppr var <> sThreaded <+> ppSyncOrdering ord <> align
+      derefType = case getVarType var of
+                    LMPointer x -> ppr x <> comma
+                    _ -> empty
+  in text "load atomic" <+> derefType <+> ppr var <> sThreaded <+> ppSyncOrdering ord <> align
 
 ppStore :: LlvmVar -> LlvmVar -> SDoc
 ppStore val dst
@@ -409,7 +411,10 @@ ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
 ppGetElementPtr inb ptr idx =
   let indexes = comma <+> ppCommaJoin idx
       inbound = if inb then text "inbounds" else empty
-  in text "getelementptr" <+> inbound <+> ppr ptr <> indexes
+      derefType = case getVarType ptr of
+                    LMPointer x -> ppr x <> comma
+                    _ -> error "ppGetElementPtr"
+  in text "getelementptr" <+> inbound <+> derefType <+> ppr ptr <> indexes
 
 
 ppReturn :: Maybe LlvmVar -> SDoc
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 9780bf3..4f8d7ab 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -581,6 +581,7 @@ instance Outputable LlvmCallConvention where
   ppr CC_Ccc       = text "ccc"
   ppr CC_Fastcc    = text "fastcc"
   ppr CC_Coldcc    = text "coldcc"
+  ppr (CC_Ncc 10)  = text "ghccc"
   ppr (CC_Ncc i)   = text "cc " <> ppr i
   ppr CC_X86_Stdcc = text "x86_stdcallcc"
 
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index f0c184a..a4e73c6 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -47,21 +47,16 @@ llvmCodeGen dflags h us cmm_stream
        showPass dflags "LLVM CodeGen"
 
        -- get llvm version, cache for later use
-       ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
+       ver <- (fromMaybe supportedLlvmVersion) `fmap` figureLlvmVersion dflags
        writeIORef (llvmVersion dflags) ver
 
        -- warn if unsupported
        debugTraceMsg dflags 2
             (text "Using LLVM version:" <+> text (show ver))
        let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags
-       when (ver < minSupportLlvmVersion && doWarn) $
-           errorMsg dflags (text "You are using an old version of LLVM that"
-                            <> text " isn't supported anymore!"
+       when (ver /= supportedLlvmVersion && doWarn) $
+           putMsg dflags (text "You are using an unsupported version of LLVM!"
                             $+$ text "We will try though...")
-       when (ver > maxSupportLlvmVersion && doWarn) $
-           putMsg dflags (text "You are using a new version of LLVM that"
-                          <> text " hasn't been tested yet!"
-                          $+$ text "We will try though...")
 
        -- run code generation
        runLlvm dflags ver bufh us $
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 5ef0a4b..7ccc632 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -12,8 +12,7 @@ module LlvmCodeGen.Base (
         LiveGlobalRegs,
         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
 
-        LlvmVersion, defaultLlvmVersion, minSupportLlvmVersion,
-        maxSupportLlvmVersion,
+        LlvmVersion, supportedLlvmVersion,
 
         LlvmM,
         runLlvm, liftStream, withClearVars, varLookup, varInsert,
@@ -174,15 +173,9 @@ llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
 -- | LLVM Version Number
 type LlvmVersion = Int
 
--- | The LLVM Version we assume if we don't know
-defaultLlvmVersion :: LlvmVersion
-defaultLlvmVersion = 36
-
-minSupportLlvmVersion :: LlvmVersion
-minSupportLlvmVersion = 36
-
-maxSupportLlvmVersion :: LlvmVersion
-maxSupportLlvmVersion = 36
+-- | The LLVM Version that is currently supported.
+supportedLlvmVersion :: LlvmVersion
+supportedLlvmVersion = 37
 
 -- ----------------------------------------------------------------------------
 -- * Environment Handling
diff --git a/configure.ac b/configure.ac
index c9a6ed0..3d9ec41 100644
--- a/configure.ac
+++ b/configure.ac
@@ -553,7 +553,7 @@ esac
 # tools we are looking for. In the past, GHC supported a number of
 # versions of LLVM simultaneously, but that stopped working around
 # 3.5/3.6 release of LLVM.
-LlvmVersion=3.6
+LlvmVersion=3.7
 AC_SUBST([LlvmVersion])
 
 dnl ** Which LLVM llc to use?



More information about the ghc-commits mailing list