Skip to content

GitLab

Commit 09e6aba8 authored by dterei's avatar dterei
Browse files
Options

Reduce the number of passes over the cmm in llvm BE

parent 4bb4a1cf
Hide whitespace changes
Inline Side-by-side
Showing with 71 additions and 113 deletions
compiler/llvmGen/LlvmCodeGen.hs
View file @ 09e6aba8
......@@ -35,80 +35,54 @@ import System.IO
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
llvmCodeGen dflags h us cmms
= do
let cmm = concat $ map (\(Cmm top) -> top) cmms
bufh <- newBufHandle h
Prt.bufLeftRender bufh $ pprLlvmHeader
env <- cmmDataLlvmGens dflags bufh cmm
cmmProcLlvmGens dflags bufh us env cmm 1 []
env' <- cmmDataLlvmGens dflags bufh env cdata []
cmmProcLlvmGens dflags bufh us env' cmm 1 []
bFlush bufh
return ()
where
cmm = concat $ map (\(Cmm top) -> top) cmms
(cdata,env) = foldr split ([],initLlvmEnv) cmm
split (CmmData _ d' ) (d,e) = (d':d,e)
split (CmmProc i l _ _) (d,e) =
let lbl = strCLabel_llvm $ if not (null i)
then entryLblToInfoLbl l
else l
env' = funInsert lbl llvmFunTy e
in (d,env')
-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms data sections.
--
cmmDataLlvmGens
:: DynFlags
-> BufHandle
-> [RawCmmTop]
-> IO ( LlvmEnv )
cmmDataLlvmGens _ _ []
= return ( initLlvmEnv )
cmmDataLlvmGens dflags h cmm =
let exData (CmmData s d) = [(s,d)]
exData _ = []
exProclbl (CmmProc i l _ _)
| not (null i) = [strCLabel_llvm $ entryLblToInfoLbl l]
exProclbl (CmmProc _ l _ _) | otherwise = [strCLabel_llvm l]
exProclbl _ = []
cproc = concat $ map exProclbl cmm
cdata = concat $ map exData cmm
env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc
in cmmDataLlvmGens' dflags h env cdata []
cmmDataLlvmGens'
:: DynFlags
-> BufHandle
-> LlvmEnv
-> [(Section, [CmmStatic])]
-> [LlvmUnresData]
-> IO ( LlvmEnv )
cmmDataLlvmGens' dflags h env [] lmdata
= do
let (env', lmdata') = resolveLlvmDatas dflags env lmdata []
let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata'
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]]
-> [LlvmUnresData] -> IO ( LlvmEnv )
cmmDataLlvmGens dflags h env [] lmdata
= let (env', lmdata') = resolveLlvmDatas env lmdata []
lmdoc = Prt.vcat $ map pprLlvmData lmdata'
in do
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
Prt.bufLeftRender h lmdoc
return env'
cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata
= do
let lmdata'@(l, ty, _) = genLlvmData dflags cmm
let env' = funInsert (strCLabel_llvm l) ty env
cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata'])
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
= let lmdata'@(l, ty, _) = genLlvmData cmm
env' = funInsert (strCLabel_llvm l) ty env
in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms procs.
--
cmmProcLlvmGens
:: DynFlags
-> BufHandle
-> UniqSupply
-> LlvmEnv
-> [RawCmmTop]
cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
-> Int -- ^ count, used for generating unique subsections
-> [LlvmVar] -- ^ info tables that need to be marked as 'used'
-> IO ()
......@@ -116,34 +90,28 @@ cmmProcLlvmGens
cmmProcLlvmGens _ _ _ _ [] _ []
= return ()
cmmProcLlvmGens dflags h _ _ [] _ ivars
= do
let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
let ty = (LMArray (length ivars) i8Ptr)
let usedArray = LMStaticArray (map cast ivars) ty
let lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
(Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
Prt.bufLeftRender h $ pprLlvmData dflags ([lmUsed], [])
cmmProcLlvmGens _ h _ _ [] _ ivars
= let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
ty = (LMArray (length ivars) i8Ptr)
usedArray = LMStaticArray (map cast ivars) ty
lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
(Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
in do
Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
= do
(us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
(us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop dflags env' count) llvm
Prt.bufLeftRender h $ Prt.vcat docs
let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
Prt.bufLeftRender h $ Prt.vcat docs
cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
-- | Complete llvm code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen
:: DynFlags
-> UniqSupply
-> LlvmEnv
-> RawCmmTop -- ^ the cmm to generate code for
-> IO ( UniqSupply,
LlvmEnv,
[LlvmCmmTop] ) -- llvm code
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
-> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
cmmLlvmGen dflags us env cmm
= do
......@@ -154,10 +122,10 @@ cmmLlvmGen dflags us env cmm
(pprCmm $ Cmm [fixed_cmm])
-- generate llvm code from cmm
let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm
let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
(vcat $ map (docToSDoc . fst . pprLlvmCmmTop dflags env' 0) llvmBC)
(vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
return (usGen, env', llvmBC)
......@@ -165,18 +133,9 @@ cmmLlvmGen dflags us env cmm
-- -----------------------------------------------------------------------------
-- | Instruction selection
--
genLlvmCode
:: DynFlags
-> LlvmEnv
-> RawCmmTop
-> UniqSM (LlvmEnv, [LlvmCmmTop])
genLlvmCode _ env (CmmData _ _)
= return (env, [])
genLlvmCode _ env (CmmProc _ _ _ (ListGraph []))
= return (env, [])
genLlvmCode _ env cp@(CmmProc _ _ _ _)
= genLlvmProc env cp
genLlvmCode :: LlvmEnv -> RawCmmTop
-> UniqSM (LlvmEnv, [LlvmCmmTop])
genLlvmCode env (CmmData _ _ ) = return (env, [])
genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, [])
genLlvmCode env cp@(CmmProc _ _ _ _ ) = genLlvmProc env cp
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @ 09e6aba8
......@@ -275,7 +275,7 @@ genCall env target res args ret = do
CmmPrim mop -> do
let name = cmmPrimOpFunctions mop
let lbl = mkForeignLabel name Nothing
ForeignLabelInExternalPackage IsFunction
ForeignLabelInExternalPackage IsFunction
getFunPtr $ CmmCallee (CmmLit (CmmLabel lbl)) CCallConv
(env2, fptr, stmts2, top2) <- getFunPtr target
......@@ -335,7 +335,8 @@ arg_vars env (CmmHinted e AddrHint:rest) (vars, stmts, tops)
++ show a ++ ")"
(v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr
arg_vars env' rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1, tops ++ top')
arg_vars env' rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1,
tops ++ top')
arg_vars env (CmmHinted e _:rest) (vars, stmts, tops)
= do (env', v1, stmts', top') <- exprToVar env e
......
compiler/llvmGen/LlvmCodeGen/Data.hs
View file @ 09e6aba8
......@@ -15,7 +15,6 @@ import BlockId
import CLabel
import Cmm
import DynFlags
import FastString
import qualified Outputable
......@@ -38,8 +37,8 @@ structStr = fsLit "_struct"
-- complete this completely though as we need to pass all CmmStatic
-- sections before all references can be resolved. This last step is
-- done by 'resolveLlvmData'.
genLlvmData :: DynFlags -> (Section, [CmmStatic]) -> LlvmUnresData
genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
genLlvmData :: [CmmStatic] -> LlvmUnresData
genLlvmData (CmmDataLabel lbl:xs) =
let static = map genData xs
label = strCLabel_llvm lbl
......@@ -51,20 +50,20 @@ genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
alias = LMAlias (label `appendFS` structStr) strucTy
in (lbl, alias, static)
genLlvmData _ _ = panic "genLlvmData: CmmData section doesn't start with label!"
genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
resolveLlvmDatas :: DynFlags -> LlvmEnv -> [LlvmUnresData] -> [LlvmData]
resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData]
-> (LlvmEnv, [LlvmData])
resolveLlvmDatas _ env [] ldata
resolveLlvmDatas env [] ldata
= (env, ldata)
resolveLlvmDatas dflags env (udata : rest) ldata
= let (env', ndata) = resolveLlvmData dflags env udata
in resolveLlvmDatas dflags env' rest (ldata ++ [ndata])
resolveLlvmDatas env (udata : rest) ldata
= let (env', ndata) = resolveLlvmData env udata
in resolveLlvmDatas env' rest (ldata ++ [ndata])
-- | Fix up CLabel references now that we should have passed all CmmData.
resolveLlvmData :: DynFlags -> LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
resolveLlvmData _ env (lbl, alias, unres) =
resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
resolveLlvmData env (lbl, alias, unres) =
let (env', static, refs) = resDatas env unres ([], [])
refs' = catMaybes refs
struct = Just $ LMStaticStruc static alias
......
compiler/llvmGen/LlvmCodeGen/Ppr.hs
View file @ 09e6aba8
......@@ -15,7 +15,6 @@ import LlvmCodeGen.Data
import CLabel
import Cmm
import DynFlags
import FastString
import Pretty
import Unique
......@@ -61,14 +60,14 @@ pprLlvmHeader = moduleLayout
-- | Pretty print LLVM code
pprLlvmCmmTop :: DynFlags -> LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
pprLlvmCmmTop dflags _ _ (CmmData _ lmdata)
= (vcat $ map (pprLlvmData dflags) lmdata, [])
pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
pprLlvmCmmTop _ _ (CmmData _ lmdata)
= (vcat $ map pprLlvmData lmdata, [])
pprLlvmCmmTop dflags env count (CmmProc info lbl _ (ListGraph blks))
pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
= let static = CmmDataLabel lbl : info
(idoc, ivar) = if not (null info)
then pprCmmStatic dflags env count static
then pprCmmStatic env count static
else (empty, [])
in (idoc $+$ (
let sec = mkLayoutSection (count + 1)
......@@ -87,18 +86,18 @@ pprLlvmCmmTop dflags env count (CmmProc info lbl _ (ListGraph blks))
-- | Pretty print LLVM data code
pprLlvmData :: DynFlags -> LlvmData -> Doc
pprLlvmData _ (globals, types) =
pprLlvmData :: LlvmData -> Doc
pprLlvmData (globals, types) =
let globals' = ppLlvmGlobals globals
types' = ppLlvmTypes types
in types' $+$ globals'
-- | Pretty print CmmStatic
pprCmmStatic :: DynFlags -> LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
pprCmmStatic dflags env count stat
= let unres = genLlvmData dflags (Data,stat)
(_, (ldata, ltypes)) = resolveLlvmData dflags env unres
pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
pprCmmStatic env count stat
= let unres = genLlvmData stat
(_, (ldata, ltypes)) = resolveLlvmData env unres
setSection (gv@(LMGlobalVar s ty l _ _), d)
= let v = if l == Internal then [gv] else []
......@@ -107,7 +106,7 @@ pprCmmStatic dflags env count stat
setSection v = (v,[])
(ldata', llvmUsed) = mapAndUnzip setSection ldata
in (pprLlvmData dflags (ldata', ltypes), concat llvmUsed)
in (pprLlvmData (ldata', ltypes), concat llvmUsed)
-- | Create an appropriate section declaration for subsection <n> of text
......
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