diff options
author | David Terei <davidterei@gmail.com> | 2011-07-06 01:16:16 -0700 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2011-07-06 01:16:16 -0700 |
commit | 5505fbb784956377b5c57d1e478a4cbb190c6567 (patch) | |
tree | 952928c0084e796e0ed2679153140ec71d509653 /compiler/llvmGen/LlvmCodeGen.hs | |
parent | 2ca430df0dafd858e024c9f058186973d8bbde39 (diff) | |
download | haskell-5505fbb784956377b5c57d1e478a4cbb190c6567.tar.gz |
Some general code cleaning in LLVM backend
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen.hs')
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen.hs | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 21d463e5c5..46f3f268a3 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 |