Commit 5d5abdca authored by Ben Gamari's avatar Ben Gamari Committed by Austin Seipp

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
parent d5a80dbe
......@@ -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]
......
......@@ -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.
......
......@@ -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 =
......
......@@ -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)
......
......@@ -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
--
......
......@@ -4,7 +4,7 @@
--
module LlvmCodeGen.Data (
genLlvmData
genLlvmData, genData
) where
#include "HsVersions.h"
......
......@@ -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
......
......@@ -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"
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment