From 09e6aba8000ccf52943ada4fb9ac76e0d93a202f Mon Sep 17 00:00:00 2001 From: David Terei Date: Mon, 21 Jun 2010 12:52:20 +0000 Subject: [PATCH] Reduce the number of passes over the cmm in llvm BE --- compiler/llvmGen/LlvmCodeGen.hs | 133 +++++++++++-------------------- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 5 +- compiler/llvmGen/LlvmCodeGen/Data.hs | 21 +++-- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 25 +++--- 4 files changed, 71 insertions(+), 113 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index c4848c9..1b1fd96 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -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 diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index f5c71ab..13fe123 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -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 diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index e3d2adc..13da03b 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -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 diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 689be6c..5afbd17 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -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 of text -- 1.7.10.4