Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/1e10605c700553d23460f7d139f6d3d3d2e6b38c >--------------------------------------------------------------- commit 1e10605c700553d23460f7d139f6d3d3d2e6b38c Author: David Terei <[email protected]> Date: Wed Jul 6 01:16:16 2011 -0700 Some general code cleaning in LLVM backend >--------------------------------------------------------------- compiler/llvmGen/LlvmCodeGen.hs | 33 +++++++++++++++---------------- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 21 +++++-------------- 2 files changed, 22 insertions(+), 32 deletions(-) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 21d463e..46f3f26 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -7,12 +7,10 @@ module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where #include "HsVersions.h" import Llvm - import LlvmCodeGen.Base import LlvmCodeGen.CodeGen import LlvmCodeGen.Data import LlvmCodeGen.Ppr - import LlvmMangler import CLabel @@ -50,11 +48,9 @@ llvmCodeGen dflags h us cmms in do bufh <- newBufHandle h Prt.bufLeftRender bufh $ pprLlvmHeader - ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags - + ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata [] cmmProcLlvmGens dflags bufh us env' cmm 1 [] - bFlush bufh return () @@ -83,36 +79,39 @@ cmmDataLlvmGens dflags h env (cmm:cmms) lmdata -- | Do LLVM code generation on all these Cmms procs. -- cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop] - -> Int -- ^ count, used for generating unique subsections - -> [LlvmVar] -- ^ info tables that need to be marked as 'used' + -> Int -- ^ count, used for generating unique subsections + -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used' -> IO () cmmProcLlvmGens _ _ _ _ [] _ [] = return () cmmProcLlvmGens _ h _ _ [] _ ivars - = let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr - ty = (LMArray (length ivars) i8Ptr) - usedArray = LMStaticArray (map cast ivars) ty + = let ivars' = concat ivars + 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 False, Just usedArray) in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], []) -cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars - = do - (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm +cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars + = cmmProcLlvmGens dflags h us env cmms count ivars + +cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars + = cmmProcLlvmGens dflags h us env cmms count ivars +cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do + (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm 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) (ivar ++ ivars) -- | Complete LLVM code generation phase for a single top-level chunk of Cmm. cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] ) -cmmLlvmGen dflags us env cmm - = do +cmmLlvmGen dflags us env cmm = do -- rewrite assignments to global regs let fixed_cmm = fixStgRegisters cmm diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index eb00274..c9ad76e 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -29,28 +29,19 @@ import Util import Data.List ( partition ) import Control.Monad ( liftM ) -type LlvmStatements = OrdList LlvmStatement +type LlvmStatements = OrdList LlvmStatement -- ----------------------------------------------------------------------------- -- | Top-level of the LLVM proc Code generator -- genLlvmProc :: LlvmEnv -> RawCmmTop -> UniqSM (LlvmEnv, [LlvmCmmTop]) -genLlvmProc env (CmmData _ _) - = return (env, []) - -genLlvmProc env (CmmProc _ _ (ListGraph [])) - = return (env, []) - -genLlvmProc env (CmmProc info lbl (ListGraph blocks)) - = do - (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], []) - - let proc = CmmProc info lbl (ListGraph lmblocks) - let tops = lmdata ++ [proc] - - return (env', tops) +genLlvmProc env (CmmProc info lbl (ListGraph blocks)) = do + (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], []) + let proc = CmmProc info lbl (ListGraph lmblocks) + return (env', proc:lmdata) +genLlvmProc _ _ = panic "genLlvmProc: case that shouldn't reach here!" -- ----------------------------------------------------------------------------- -- * Block code generation _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
