Commit 09e6aba8 authored by dterei's avatar dterei

Reduce the number of passes over the cmm in llvm BE

parent 4bb4a1cf
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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