Commit 5505fbb7 authored by dterei's avatar dterei
Browse files

Some general code cleaning in LLVM backend

parent 2ca430df
......@@ -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
......
......@@ -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
......
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