ghc: update to 7.10.3b.
Disable LLVM for now as LLVM 3.7 isn't supported by GHC 7.10.3.
This commit is contained in:
Christian Neukirchen
parent
39febac51f
commit
64debff3db
2 changed files with 10 additions and 525 deletions
|
|
@ -1,519 +0,0 @@
|
||||||
From 5d5abdca31cdb4db5303999778fa25c4a1371084 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Ben Gamari <bgamari.foss@gmail.com>
|
|
||||||
Date: Mon, 9 Feb 2015 15:21:28 -0600
|
|
||||||
Subject: [PATCH 1/1] llvmGen: move to LLVM 3.6 exclusively
|
|
||||||
|
|
||||||
Summary:
|
|
||||||
Rework llvmGen to use LLVM 3.6 exclusively. The plans for the 7.12 release are to ship LLVM alongside GHC in the interests of user (and developer) sanity.
|
|
||||||
|
|
||||||
Along the way, refactor TNTC support to take advantage of the new `prefix` data support in LLVM 3.6. This allows us to drop the section-reordering component of the LLVM mangler.
|
|
||||||
|
|
||||||
Test Plan: Validate, look at emitted code
|
|
||||||
|
|
||||||
Reviewers: dterei, austin, scpmw
|
|
||||||
|
|
||||||
Reviewed By: austin
|
|
||||||
|
|
||||||
Subscribers: erikd, awson, spacekitteh, thomie, carter
|
|
||||||
|
|
||||||
Differential Revision: https://phabricator.haskell.org/D530
|
|
||||||
|
|
||||||
GHC Trac Issues: #10074
|
|
||||||
---
|
|
||||||
compiler/llvmGen/Llvm/AbsSyn.hs | 13 ++++--
|
|
||||||
compiler/llvmGen/Llvm/MetaData.hs | 14 +++---
|
|
||||||
compiler/llvmGen/Llvm/PpLlvm.hs | 37 +++++++++------
|
|
||||||
compiler/llvmGen/LlvmCodeGen.hs | 7 +--
|
|
||||||
compiler/llvmGen/LlvmCodeGen/Base.hs | 26 ++---------
|
|
||||||
compiler/llvmGen/LlvmCodeGen/Data.hs | 2 +-
|
|
||||||
compiler/llvmGen/LlvmCodeGen/Ppr.hs | 90 ++++++++++--------------------------
|
|
||||||
compiler/llvmGen/LlvmMangler.hs | 49 ++------------------
|
|
||||||
8 files changed, 72 insertions(+), 166 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
||||||
index 24d0856..b0eae2c 100644
|
|
||||||
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
||||||
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
||||||
@@ -48,19 +48,22 @@ data LlvmModule = LlvmModule {
|
|
||||||
-- | An LLVM Function
|
|
||||||
data LlvmFunction = LlvmFunction {
|
|
||||||
-- | The signature of this declared function.
|
|
||||||
- funcDecl :: LlvmFunctionDecl,
|
|
||||||
+ funcDecl :: LlvmFunctionDecl,
|
|
||||||
|
|
||||||
-- | The functions arguments
|
|
||||||
- funcArgs :: [LMString],
|
|
||||||
+ funcArgs :: [LMString],
|
|
||||||
|
|
||||||
-- | The function attributes.
|
|
||||||
- funcAttrs :: [LlvmFuncAttr],
|
|
||||||
+ funcAttrs :: [LlvmFuncAttr],
|
|
||||||
|
|
||||||
-- | The section to put the function into,
|
|
||||||
- funcSect :: LMSection,
|
|
||||||
+ funcSect :: LMSection,
|
|
||||||
+
|
|
||||||
+ -- | Prefix data
|
|
||||||
+ funcPrefix :: Maybe LlvmStatic,
|
|
||||||
|
|
||||||
-- | The body of the functions.
|
|
||||||
- funcBody :: LlvmBlocks
|
|
||||||
+ funcBody :: LlvmBlocks
|
|
||||||
}
|
|
||||||
|
|
||||||
type LlvmFunctions = [LlvmFunction]
|
|
||||||
diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/llvmGen/Llvm/MetaData.hs
|
|
||||||
index 36efcd7..e1e63c9 100644
|
|
||||||
--- a/compiler/llvmGen/Llvm/MetaData.hs
|
|
||||||
+++ b/compiler/llvmGen/Llvm/MetaData.hs
|
|
||||||
@@ -20,12 +20,12 @@ import Outputable
|
|
||||||
-- information. They consist of metadata strings, metadata nodes, regular
|
|
||||||
-- LLVM values (both literals and references to global variables) and
|
|
||||||
-- metadata expressions (i.e., recursive data type). Some examples:
|
|
||||||
--- !{ metadata !"hello", metadata !0, i32 0 }
|
|
||||||
--- !{ metadata !1, metadata !{ i32 0 } }
|
|
||||||
+-- !{ !"hello", !0, i32 0 }
|
|
||||||
+-- !{ !1, !{ i32 0 } }
|
|
||||||
--
|
|
||||||
-- * Metadata nodes -- global metadata variables that attach a metadata
|
|
||||||
-- expression to a number. For example:
|
|
||||||
--- !0 = metadata !{ [<metadata expressions>] !}
|
|
||||||
+-- !0 = !{ [<metadata expressions>] !}
|
|
||||||
--
|
|
||||||
-- * Named metadata -- global metadata variables that attach a metadata nodes
|
|
||||||
-- to a name. Used ONLY to communicated module level information to LLVM
|
|
||||||
@@ -39,7 +39,7 @@ import Outputable
|
|
||||||
-- * Attach to instructions -- metadata can be attached to LLVM instructions
|
|
||||||
-- using a specific reference as follows:
|
|
||||||
-- %l = load i32* @glob, !nontemporal !10
|
|
||||||
--- %m = load i32* @glob, !nontemporal !{ i32 0, metadata !{ i32 0 } }
|
|
||||||
+-- %m = load i32* @glob, !nontemporal !{ i32 0, !{ i32 0 } }
|
|
||||||
-- Only metadata nodes or expressions can be attached, named metadata cannot.
|
|
||||||
-- Refer to LLVM documentation for which instructions take metadata and its
|
|
||||||
-- meaning.
|
|
||||||
@@ -63,10 +63,10 @@ data MetaExpr = MetaStr LMString
|
|
||||||
deriving (Eq)
|
|
||||||
|
|
||||||
instance Outputable MetaExpr where
|
|
||||||
- ppr (MetaStr s ) = text "metadata !\"" <> ftext s <> char '"'
|
|
||||||
- ppr (MetaNode n ) = text "metadata !" <> int n
|
|
||||||
+ ppr (MetaStr s ) = text "!\"" <> ftext s <> char '"'
|
|
||||||
+ ppr (MetaNode n ) = text "!" <> int n
|
|
||||||
ppr (MetaVar v ) = ppr v
|
|
||||||
- ppr (MetaStruct es) = text "metadata !{ " <> ppCommaJoin es <> char '}'
|
|
||||||
+ ppr (MetaStruct es) = text "!{ " <> ppCommaJoin es <> char '}'
|
|
||||||
|
|
||||||
-- | Associates some metadata with a specific label for attaching to an
|
|
||||||
-- instruction.
|
|
||||||
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
||||||
index 7307725..0b3deac 100644
|
|
||||||
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
||||||
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
||||||
@@ -77,12 +77,12 @@ ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
|
|
||||||
Nothing -> ppr (pLower $ getVarType var)
|
|
||||||
|
|
||||||
-- Position of linkage is different for aliases.
|
|
||||||
- const_link = case c of
|
|
||||||
- Global -> ppr link <+> text "global"
|
|
||||||
- Constant -> ppr link <+> text "constant"
|
|
||||||
- Alias -> text "alias" <+> ppr link
|
|
||||||
+ const = case c of
|
|
||||||
+ Global -> text "global"
|
|
||||||
+ Constant -> text "constant"
|
|
||||||
+ Alias -> text "alias"
|
|
||||||
|
|
||||||
- in ppAssignment var $ const_link <+> rhs <> sect <> align
|
|
||||||
+ in ppAssignment var $ ppr link <+> const <+> rhs <> sect <> align
|
|
||||||
$+$ newLine
|
|
||||||
|
|
||||||
ppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \dflags ->
|
|
||||||
@@ -117,11 +117,11 @@ ppLlvmMeta (MetaNamed n m)
|
|
||||||
|
|
||||||
-- | Print out an LLVM metadata value.
|
|
||||||
ppLlvmMetaExpr :: MetaExpr -> SDoc
|
|
||||||
-ppLlvmMetaExpr (MetaStr s ) = text "metadata !" <> doubleQuotes (ftext s)
|
|
||||||
-ppLlvmMetaExpr (MetaNode n ) = text "metadata !" <> int n
|
|
||||||
+ppLlvmMetaExpr (MetaStr s ) = text "!" <> doubleQuotes (ftext s)
|
|
||||||
+ppLlvmMetaExpr (MetaNode n ) = text "!" <> int n
|
|
||||||
ppLlvmMetaExpr (MetaVar v ) = ppr v
|
|
||||||
ppLlvmMetaExpr (MetaStruct es) =
|
|
||||||
- text "metadata !{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}'
|
|
||||||
+ text "!{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}'
|
|
||||||
|
|
||||||
|
|
||||||
-- | Print out a list of function definitions.
|
|
||||||
@@ -130,15 +130,18 @@ ppLlvmFunctions funcs = vcat $ map ppLlvmFunction funcs
|
|
||||||
|
|
||||||
-- | Print out a function definition.
|
|
||||||
ppLlvmFunction :: LlvmFunction -> SDoc
|
|
||||||
-ppLlvmFunction (LlvmFunction dec args attrs sec body) =
|
|
||||||
- let attrDoc = ppSpaceJoin attrs
|
|
||||||
- secDoc = case sec of
|
|
||||||
+ppLlvmFunction fun =
|
|
||||||
+ let attrDoc = ppSpaceJoin (funcAttrs fun)
|
|
||||||
+ secDoc = case funcSect fun of
|
|
||||||
Just s' -> text "section" <+> (doubleQuotes $ ftext s')
|
|
||||||
Nothing -> empty
|
|
||||||
- in text "define" <+> ppLlvmFunctionHeader dec args
|
|
||||||
- <+> attrDoc <+> secDoc
|
|
||||||
+ prefixDoc = case funcPrefix fun of
|
|
||||||
+ Just v -> text "prefix" <+> ppr v
|
|
||||||
+ Nothing -> empty
|
|
||||||
+ in text "define" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun)
|
|
||||||
+ <+> attrDoc <+> secDoc <+> prefixDoc
|
|
||||||
$+$ lbrace
|
|
||||||
- $+$ ppLlvmBlocks body
|
|
||||||
+ $+$ ppLlvmBlocks (funcBody fun)
|
|
||||||
$+$ rbrace
|
|
||||||
$+$ newLine
|
|
||||||
$+$ newLine
|
|
||||||
@@ -269,7 +272,7 @@ ppCall ct fptr args attrs = case fptr of
|
|
||||||
where
|
|
||||||
ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
|
|
||||||
let tc = if ct == TailCall then text "tail " else empty
|
|
||||||
- ppValues = ppCommaJoin args
|
|
||||||
+ ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args
|
|
||||||
ppArgTy = (ppCommaJoin $ map fst params) <>
|
|
||||||
(case argTy of
|
|
||||||
VarArgs -> text ", ..."
|
|
||||||
@@ -280,6 +283,10 @@ ppCall ct fptr args attrs = case fptr of
|
|
||||||
<> fnty <+> ppName fptr <> lparen <+> ppValues
|
|
||||||
<+> rparen <+> attrDoc
|
|
||||||
|
|
||||||
+ -- Metadata needs to be marked as having the `metadata` type when used
|
|
||||||
+ -- in a call argument
|
|
||||||
+ ppCallMetaExpr (MetaVar v) = ppr v
|
|
||||||
+ ppCallMetaExpr v = text "metadata" <+> ppr v
|
|
||||||
|
|
||||||
ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
|
|
||||||
ppMachOp op left right =
|
|
||||||
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
|
|
||||||
index 6120a72..f0c184a 100644
|
|
||||||
--- a/compiler/llvmGen/LlvmCodeGen.hs
|
|
||||||
+++ b/compiler/llvmGen/LlvmCodeGen.hs
|
|
||||||
@@ -138,13 +138,8 @@ cmmLlvmGen cmm@CmmProc{} = do
|
|
||||||
-- generate llvm code from cmm
|
|
||||||
llvmBC <- withClearVars $ genLlvmProc fixed_cmm
|
|
||||||
|
|
||||||
- -- allocate IDs for info table and code, so the mangler can later
|
|
||||||
- -- make sure they end up next to each other.
|
|
||||||
- itableSection <- freshSectionId
|
|
||||||
- _codeSection <- freshSectionId
|
|
||||||
-
|
|
||||||
-- pretty print
|
|
||||||
- (docs, ivars) <- fmap unzip $ mapM (pprLlvmCmmDecl itableSection) llvmBC
|
|
||||||
+ (docs, ivars) <- fmap unzip $ mapM pprLlvmCmmDecl llvmBC
|
|
||||||
|
|
||||||
-- Output, note down used variables
|
|
||||||
renderLlvm (vcat docs)
|
|
||||||
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
|
|
||||||
index 83b06a9..15918a3 100644
|
|
||||||
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
|
|
||||||
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
|
|
||||||
@@ -24,11 +24,10 @@ module LlvmCodeGen.Base (
|
|
||||||
|
|
||||||
getMetaUniqueId,
|
|
||||||
setUniqMeta, getUniqMeta,
|
|
||||||
- freshSectionId,
|
|
||||||
|
|
||||||
cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
|
|
||||||
- llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
|
|
||||||
- llvmPtrBits, mkLlvmFunc, tysToParams,
|
|
||||||
+ llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
|
|
||||||
+ llvmPtrBits, tysToParams,
|
|
||||||
|
|
||||||
strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
|
|
||||||
getGlobalPtr, generateExternDecls,
|
|
||||||
@@ -133,15 +132,6 @@ llvmFunSig' live lbl link
|
|
||||||
(map (toParams . getVarType) (llvmFunArgs dflags live))
|
|
||||||
(llvmFunAlign dflags)
|
|
||||||
|
|
||||||
--- | Create a Haskell function in LLVM.
|
|
||||||
-mkLlvmFunc :: LiveGlobalRegs -> CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
|
|
||||||
- -> LlvmM LlvmFunction
|
|
||||||
-mkLlvmFunc live lbl link sec blks
|
|
||||||
- = do funDec <- llvmFunSig live lbl link
|
|
||||||
- dflags <- getDynFlags
|
|
||||||
- let funArgs = map (fsLit . Outp.showSDoc dflags . ppPlainName) (llvmFunArgs dflags live)
|
|
||||||
- return $ LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
|
|
||||||
-
|
|
||||||
-- | Alignment to use for functions
|
|
||||||
llvmFunAlign :: DynFlags -> LMAlign
|
|
||||||
llvmFunAlign dflags = Just (wORD_SIZE dflags)
|
|
||||||
@@ -186,13 +176,13 @@ type LlvmVersion = Int
|
|
||||||
|
|
||||||
-- | The LLVM Version we assume if we don't know
|
|
||||||
defaultLlvmVersion :: LlvmVersion
|
|
||||||
-defaultLlvmVersion = 30
|
|
||||||
+defaultLlvmVersion = 36
|
|
||||||
|
|
||||||
minSupportLlvmVersion :: LlvmVersion
|
|
||||||
-minSupportLlvmVersion = 28
|
|
||||||
+minSupportLlvmVersion = 36
|
|
||||||
|
|
||||||
maxSupportLlvmVersion :: LlvmVersion
|
|
||||||
-maxSupportLlvmVersion = 35
|
|
||||||
+maxSupportLlvmVersion = 36
|
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
|
||||||
-- * Environment Handling
|
|
||||||
@@ -203,7 +193,6 @@ data LlvmEnv = LlvmEnv
|
|
||||||
, envDynFlags :: DynFlags -- ^ Dynamic flags
|
|
||||||
, envOutput :: BufHandle -- ^ Output buffer
|
|
||||||
, envUniq :: UniqSupply -- ^ Supply of unique values
|
|
||||||
- , envNextSection :: Int -- ^ Supply of fresh section IDs
|
|
||||||
, envFreshMeta :: Int -- ^ Supply of fresh metadata IDs
|
|
||||||
, envUniqMeta :: UniqFM Int -- ^ Global metadata nodes
|
|
||||||
, envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type
|
|
||||||
@@ -257,7 +246,6 @@ runLlvm dflags ver out us m = do
|
|
||||||
, envUniq = us
|
|
||||||
, envFreshMeta = 0
|
|
||||||
, envUniqMeta = emptyUFM
|
|
||||||
- , envNextSection = 1
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Get environment (internal)
|
|
||||||
@@ -362,10 +350,6 @@ setUniqMeta f m = modifyEnv $ \env -> env { envUniqMeta = addToUFM (envUniqMeta
|
|
||||||
getUniqMeta :: Unique -> LlvmM (Maybe Int)
|
|
||||||
getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta)
|
|
||||||
|
|
||||||
--- | Returns a fresh section ID
|
|
||||||
-freshSectionId :: LlvmM Int
|
|
||||||
-freshSectionId = LlvmM $ \env -> return (envNextSection env, env { envNextSection = envNextSection env + 1})
|
|
||||||
-
|
|
||||||
-- ----------------------------------------------------------------------------
|
|
||||||
-- * Internal functions
|
|
||||||
--
|
|
||||||
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
|
|
||||||
index 90ce443..42f4dcd 100644
|
|
||||||
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
|
|
||||||
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
|
|
||||||
@@ -4,7 +4,7 @@
|
|
||||||
--
|
|
||||||
|
|
||||||
module LlvmCodeGen.Data (
|
|
||||||
- genLlvmData
|
|
||||||
+ genLlvmData, genData
|
|
||||||
) where
|
|
||||||
|
|
||||||
#include "HsVersions.h"
|
|
||||||
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
|
|
||||||
index 5dd27ab..1a9373b 100644
|
|
||||||
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
|
|
||||||
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
|
|
||||||
@@ -4,7 +4,7 @@
|
|
||||||
-- | Pretty print helpers for the LLVM Code generator.
|
|
||||||
--
|
|
||||||
module LlvmCodeGen.Ppr (
|
|
||||||
- pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf
|
|
||||||
+ pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection
|
|
||||||
) where
|
|
||||||
|
|
||||||
#include "HsVersions.h"
|
|
||||||
@@ -96,28 +96,36 @@ pprLlvmData (globals, types) =
|
|
||||||
|
|
||||||
|
|
||||||
-- | Pretty print LLVM code
|
|
||||||
-pprLlvmCmmDecl :: Int -> LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
|
|
||||||
-pprLlvmCmmDecl _ (CmmData _ lmdata)
|
|
||||||
+pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
|
|
||||||
+pprLlvmCmmDecl (CmmData _ lmdata)
|
|
||||||
= return (vcat $ map pprLlvmData lmdata, [])
|
|
||||||
|
|
||||||
-pprLlvmCmmDecl count (CmmProc mb_info entry_lbl live (ListGraph blks))
|
|
||||||
- = do (idoc, ivar) <- case mb_info of
|
|
||||||
- Nothing -> return (empty, [])
|
|
||||||
- Just (Statics info_lbl dat)
|
|
||||||
- -> pprInfoTable count info_lbl (Statics entry_lbl dat)
|
|
||||||
-
|
|
||||||
- let sec = mkLayoutSection (count + 1)
|
|
||||||
- (lbl',sec') = case mb_info of
|
|
||||||
- Nothing -> (entry_lbl, Nothing)
|
|
||||||
- Just (Statics info_lbl _) -> (info_lbl, sec)
|
|
||||||
- link = if externallyVisibleCLabel lbl'
|
|
||||||
+pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
|
|
||||||
+ = do let lbl = case mb_info of
|
|
||||||
+ Nothing -> entry_lbl
|
|
||||||
+ Just (Statics info_lbl _) -> info_lbl
|
|
||||||
+ link = if externallyVisibleCLabel lbl
|
|
||||||
then ExternallyVisible
|
|
||||||
else Internal
|
|
||||||
lmblocks = map (\(BasicBlock id stmts) ->
|
|
||||||
LlvmBlock (getUnique id) stmts) blks
|
|
||||||
|
|
||||||
- fun <- mkLlvmFunc live lbl' link sec' lmblocks
|
|
||||||
- let name = decName $ funcDecl fun
|
|
||||||
+ funDec <- llvmFunSig live lbl link
|
|
||||||
+ dflags <- getDynFlags
|
|
||||||
+ let buildArg = fsLit . showSDoc dflags . ppPlainName
|
|
||||||
+ funArgs = map buildArg (llvmFunArgs dflags live)
|
|
||||||
+
|
|
||||||
+ -- generate the info table
|
|
||||||
+ prefix <- case mb_info of
|
|
||||||
+ Nothing -> return Nothing
|
|
||||||
+ Just (Statics _ statics) -> do
|
|
||||||
+ infoStatics <- mapM genData statics
|
|
||||||
+ let infoTy = LMStruct $ map getStatType infoStatics
|
|
||||||
+ return $ Just $ LMStaticStruc infoStatics infoTy
|
|
||||||
+
|
|
||||||
+ let fun = LlvmFunction funDec funArgs llvmStdFunAttrs Nothing
|
|
||||||
+ prefix lmblocks
|
|
||||||
+ name = decName $ funcDecl fun
|
|
||||||
defName = name `appendFS` fsLit "$def"
|
|
||||||
funcDecl' = (funcDecl fun) { decName = defName }
|
|
||||||
fun' = fun { funcDecl = funcDecl' }
|
|
||||||
@@ -138,55 +146,7 @@ pprLlvmCmmDecl count (CmmProc mb_info entry_lbl live (ListGraph blks))
|
|
||||||
(Just $ LMBitc (LMStaticPointer defVar)
|
|
||||||
(LMPointer $ LMInt 8))
|
|
||||||
|
|
||||||
- return (ppLlvmGlobal alias $+$ idoc $+$ ppLlvmFunction fun', ivar)
|
|
||||||
-
|
|
||||||
-
|
|
||||||
--- | Pretty print CmmStatic
|
|
||||||
-pprInfoTable :: Int -> CLabel -> CmmStatics -> LlvmM (SDoc, [LlvmVar])
|
|
||||||
-pprInfoTable count info_lbl stat
|
|
||||||
- = do (ldata, ltypes) <- genLlvmData (Text, stat)
|
|
||||||
-
|
|
||||||
- dflags <- getDynFlags
|
|
||||||
- platform <- getLlvmPlatform
|
|
||||||
- let setSection :: LMGlobal -> LlvmM (LMGlobal, [LlvmVar])
|
|
||||||
- setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d) = do
|
|
||||||
- lbl <- strCLabel_llvm info_lbl
|
|
||||||
- let sec = mkLayoutSection count
|
|
||||||
- ilabel = lbl `appendFS` fsLit iTableSuf
|
|
||||||
- gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
|
|
||||||
- -- See Note [Subsections Via Symbols]
|
|
||||||
- v = if (platformHasSubsectionsViaSymbols platform
|
|
||||||
- && l == ExternallyVisible)
|
|
||||||
- || l == Internal
|
|
||||||
- then [gv]
|
|
||||||
- else []
|
|
||||||
- funInsert ilabel ty
|
|
||||||
- return (LMGlobal gv d, v)
|
|
||||||
- setSection v = return (v,[])
|
|
||||||
-
|
|
||||||
- (ldata', llvmUsed) <- unzip `fmap` mapM setSection ldata
|
|
||||||
- ldata'' <- mapM aliasify ldata'
|
|
||||||
- let modUsedLabel (LMGlobalVar name ty link sect align const) =
|
|
||||||
- LMGlobalVar (name `appendFS` fsLit "$def") ty link sect align const
|
|
||||||
- modUsedLabel v = v
|
|
||||||
- llvmUsed' = map modUsedLabel $ concat llvmUsed
|
|
||||||
- return (pprLlvmData (concat ldata'', ltypes), llvmUsed')
|
|
||||||
-
|
|
||||||
-
|
|
||||||
--- | We generate labels for info tables by converting them to the same label
|
|
||||||
--- as for the entry code but adding this string as a suffix.
|
|
||||||
-iTableSuf :: String
|
|
||||||
-iTableSuf = "_itable"
|
|
||||||
-
|
|
||||||
-
|
|
||||||
--- | Create a specially crafted section declaration that encodes the order this
|
|
||||||
--- section should be in the final object code.
|
|
||||||
---
|
|
||||||
--- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
|
|
||||||
--- this section declaration to do its processing.
|
|
||||||
-mkLayoutSection :: Int -> LMSection
|
|
||||||
-mkLayoutSection n
|
|
||||||
- = Just (fsLit $ infoSection ++ show n)
|
|
||||||
+ return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', [])
|
|
||||||
|
|
||||||
|
|
||||||
-- | The section we are putting info tables and their entry code into, should
|
|
||||||
diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs
|
|
||||||
index 8652a89..267feb5 100644
|
|
||||||
--- a/compiler/llvmGen/LlvmMangler.hs
|
|
||||||
+++ b/compiler/llvmGen/LlvmMangler.hs
|
|
||||||
@@ -11,33 +11,24 @@ module LlvmMangler ( llvmFixupAsm ) where
|
|
||||||
|
|
||||||
import DynFlags ( DynFlags )
|
|
||||||
import ErrUtils ( showPass )
|
|
||||||
-import LlvmCodeGen.Ppr ( infoSection )
|
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
import Control.Monad ( when )
|
|
||||||
import qualified Data.ByteString.Char8 as B
|
|
||||||
-import Data.Char
|
|
||||||
import System.IO
|
|
||||||
|
|
||||||
-import Data.List ( sortBy )
|
|
||||||
-import Data.Function ( on )
|
|
||||||
-
|
|
||||||
#if x86_64_TARGET_ARCH
|
|
||||||
#define REWRITE_AVX
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- Magic Strings
|
|
||||||
-secStmt, infoSec, newLine, textStmt, dataStmt, syntaxUnified :: B.ByteString
|
|
||||||
+secStmt, newLine, textStmt, dataStmt, syntaxUnified :: B.ByteString
|
|
||||||
secStmt = B.pack "\t.section\t"
|
|
||||||
-infoSec = B.pack infoSection
|
|
||||||
newLine = B.pack "\n"
|
|
||||||
textStmt = B.pack "\t.text"
|
|
||||||
dataStmt = B.pack "\t.data"
|
|
||||||
syntaxUnified = B.pack "\t.syntax unified"
|
|
||||||
|
|
||||||
-infoLen :: Int
|
|
||||||
-infoLen = B.length infoSec
|
|
||||||
-
|
|
||||||
-- Search Predicates
|
|
||||||
isType :: B.ByteString -> Bool
|
|
||||||
isType = B.isPrefixOf (B.pack "\t.type")
|
|
||||||
@@ -53,7 +44,7 @@ llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do
|
|
||||||
w <- openBinaryFile f2 WriteMode
|
|
||||||
ss <- readSections r w
|
|
||||||
hClose r
|
|
||||||
- let fixed = (map rewriteAVX . fixTables) ss
|
|
||||||
+ let fixed = map rewriteAVX ss
|
|
||||||
mapM_ (writeSection w) fixed
|
|
||||||
hClose w
|
|
||||||
return ()
|
|
||||||
@@ -91,11 +82,7 @@ readSections r w = go B.empty [] []
|
|
||||||
|
|
||||||
-- Decide whether to directly output the section or append it
|
|
||||||
-- to the list for resorting.
|
|
||||||
- let finishSection
|
|
||||||
- | infoSec `B.isInfixOf` hdr =
|
|
||||||
- cts `seq` return $ (hdr, cts):ss
|
|
||||||
- | otherwise =
|
|
||||||
- writeSection w (hdr, cts) >> return ss
|
|
||||||
+ let finishSection = writeSection w (hdr, cts) >> return ss
|
|
||||||
|
|
||||||
case e_l of
|
|
||||||
Right l | l == syntaxUnified
|
|
||||||
@@ -149,33 +136,3 @@ replace matchBS replaceBS = loop
|
|
||||||
(hd,tl) | B.null tl -> hd
|
|
||||||
| otherwise -> hd `B.append` replaceBS `B.append`
|
|
||||||
loop (B.drop (B.length matchBS) tl)
|
|
||||||
-
|
|
||||||
--- | Reorder and convert sections so info tables end up next to the
|
|
||||||
--- code. Also does stack fixups.
|
|
||||||
-fixTables :: [Section] -> [Section]
|
|
||||||
-fixTables ss = map strip sorted
|
|
||||||
- where
|
|
||||||
- -- Resort sections: We only assign a non-zero number to all
|
|
||||||
- -- sections having the "STRIP ME" marker. As sortBy is stable,
|
|
||||||
- -- this will cause all these sections to be appended to the end of
|
|
||||||
- -- the file in the order given by the indexes.
|
|
||||||
- extractIx hdr
|
|
||||||
- | B.null a = 0
|
|
||||||
- | otherwise = 1 + readInt (B.takeWhile isDigit $ B.drop infoLen a)
|
|
||||||
- where (_,a) = B.breakSubstring infoSec hdr
|
|
||||||
-
|
|
||||||
- indexed = zip (map (extractIx . fst) ss) ss
|
|
||||||
-
|
|
||||||
- sorted = map snd $ sortBy (compare `on` fst) indexed
|
|
||||||
-
|
|
||||||
- -- Turn all the "STRIP ME" sections into normal text sections, as
|
|
||||||
- -- they are in the right place now.
|
|
||||||
- strip (hdr, cts)
|
|
||||||
- | infoSec `B.isInfixOf` hdr = (textStmt, cts)
|
|
||||||
- | otherwise = (hdr, cts)
|
|
||||||
-
|
|
||||||
--- | Read an int or error
|
|
||||||
-readInt :: B.ByteString -> Int
|
|
||||||
-readInt str | B.all isDigit str = (read . B.unpack) str
|
|
||||||
- | otherwise = error $ "LLvmMangler Cannot read " ++ show str
|
|
||||||
- ++ " as it's not an Int"
|
|
||||||
--
|
|
||||||
1.9.1
|
|
||||||
|
|
||||||
|
|
@ -1,21 +1,23 @@
|
||||||
# Template file for 'ghc'
|
# Template file for 'ghc'
|
||||||
pkgname=ghc
|
pkgname=ghc
|
||||||
# Keep this synchronized with http://www.stackage.org/lts
|
# Keep this synchronized with http://www.stackage.org/lts
|
||||||
version=7.10.2
|
version=7.10.3b
|
||||||
revision=1
|
revision=1
|
||||||
|
wrksrc="ghc-${version%[!0-9]}"
|
||||||
patch_args="-Np1"
|
patch_args="-Np1"
|
||||||
build_style=gnu-configure
|
build_style=gnu-configure
|
||||||
configure_args="--with-system-libffi"
|
configure_args="--with-system-libffi"
|
||||||
hostmakedepends="ghc-bin docbook-xsl libxslt llvm"
|
hostmakedepends="automake ghc-bin docbook-xsl libxslt"
|
||||||
makedepends="libffi-devel gmp-devel ncurses-devel llvm"
|
makedepends="libffi-devel gmp-devel ncurses-devel"
|
||||||
depends="perl gcc libffi-devel gmp-devel"
|
depends="perl gcc libffi-devel gmp-devel"
|
||||||
short_desc="Glorious Haskell Compiler"
|
short_desc="Glorious Haskell Compiler"
|
||||||
maintainer="Christian Neukirchen <chneukirchen@gmail.com>"
|
maintainer="Christian Neukirchen <chneukirchen@gmail.com>"
|
||||||
license="custom"
|
license="custom"
|
||||||
homepage="http://www.haskell.org/ghc/"
|
homepage="http://www.haskell.org/ghc/"
|
||||||
distfiles="http://www.haskell.org/ghc/dist/$version/$pkgname-$version-src.tar.xz"
|
distfiles="http://www.haskell.org/ghc/dist/${version%[!0-9]}/${pkgname}-${version%[!0-9]}-src.tar.xz"
|
||||||
checksum=54cd73755b784d78e2f13d5eb161bfa38d3efee9e8a56f7eb6cd9f2d6e2615f5
|
checksum=cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef
|
||||||
nocross=yes # ask chris2 before wasting time trying to do that
|
nocross=yes # ask chris2 before wasting time trying to do that
|
||||||
|
nopie=yes
|
||||||
|
|
||||||
pre_configure() {
|
pre_configure() {
|
||||||
export CONF_CC_OPTS_STAGE0=$CFLAGS_FOR_BUILD
|
export CONF_CC_OPTS_STAGE0=$CFLAGS_FOR_BUILD
|
||||||
|
|
@ -27,10 +29,12 @@ pre_configure() {
|
||||||
export CONF_CPP_OPTS_STAGE0=$CPPFLAGS_FOR_BUILD
|
export CONF_CPP_OPTS_STAGE0=$CPPFLAGS_FOR_BUILD
|
||||||
export CONF_CPP_OPTS_STAGE1=$CPPFLAGS
|
export CONF_CPP_OPTS_STAGE1=$CPPFLAGS
|
||||||
export CONF_CPP_OPTS_STAGE2=$CPPFLAGS
|
export CONF_CPP_OPTS_STAGE2=$CPPFLAGS
|
||||||
|
|
||||||
|
autoreconf -fi
|
||||||
}
|
}
|
||||||
|
|
||||||
post_install() {
|
post_install() {
|
||||||
sed -i 's#/usr/lib/ccache/bin/##g' ${DESTDIR}/usr/lib/ghc-${version}/settings
|
sed -i 's#/usr/lib/ccache/bin/##g' ${DESTDIR}/usr/lib/ghc-${version%[!0-9]}/settings
|
||||||
vlicense LICENSE
|
vlicense LICENSE
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue