X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvmCodeGen.hs;h=56d8386431f0c1202a8e0dabfd869cc76f6295a7;hp=c208006516f4f8627e48a9048ab89525b8d58f19;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=3aadff5e31bf6b665cf7ae7606c94cdab85624d2 diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index c208006..56d8386 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -2,7 +2,7 @@ -- | This is the top-level module in the LLVM code generator. -- -module LlvmCodeGen ( llvmCodeGen ) where +module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where #include "HsVersions.h" @@ -13,10 +13,12 @@ import LlvmCodeGen.CodeGen import LlvmCodeGen.Data import LlvmCodeGen.Ppr +import LlvmMangler + import CLabel -import Cmm import CgUtils ( fixStgRegisters ) -import PprCmm +import OldCmm +import OldPprCmm import BufWrite import DynFlags @@ -26,41 +28,39 @@ import Outputable import qualified Pretty as Prt import UniqSupply import Util +import SysTools ( figureLlvmVersion ) +import Data.Maybe ( fromMaybe ) import System.IO -- ----------------------------------------------------------------------------- --- | Top-level of the llvm codegen +-- | Top-level of the LLVM Code generator -- llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO () llvmCodeGen dflags h us cmms - = do - bufh <- newBufHandle h - - Prt.bufLeftRender bufh $ pprLlvmHeader - - env' <- cmmDataLlvmGens dflags bufh env cdata [] - cmmProcLlvmGens dflags bufh us env' cmm 1 [] - - bFlush bufh - - return () - where - cmm = concat $ map (\(Cmm top) -> top) cmms - + = let cmm = concat $ map (\(Cmm top) -> top) cmms (cdata,env) = foldr split ([],initLlvmEnv) cmm - - split (CmmData s d' ) (d,e) = ((s,d'):d,e) - split (CmmProc i l _ _) (d,e) = + split (CmmData s d' ) (d,e) = ((s,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') + in do + bufh <- newBufHandle h + Prt.bufLeftRender bufh $ pprLlvmHeader + ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags + + env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata [] + cmmProcLlvmGens dflags bufh us env' cmm 1 [] + + bFlush bufh + return () -- ----------------------------------------------------------------------------- --- | Do llvm code generation on all these cmms data sections. +-- | Do LLVM code generation on all these Cmms data sections. -- cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])] -> [LlvmUnresData] -> IO ( LlvmEnv ) @@ -80,7 +80,7 @@ cmmDataLlvmGens dflags h env (cmm:cmms) lmdata -- ----------------------------------------------------------------------------- --- | Do llvm code generation on all these cmms procs. +-- | Do LLVM code generation on all these Cmms procs. -- cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop] -> Int -- ^ count, used for generating unique subsections @@ -96,8 +96,7 @@ cmmProcLlvmGens _ h _ _ [] _ ivars usedArray = LMStaticArray (map cast ivars) ty lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray) - in do - Prt.bufLeftRender h $ pprLlvmData ([lmUsed], []) + in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], []) cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do @@ -109,7 +108,7 @@ cmmProcLlvmGens dflags h us env (cmm : cmms) count 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. +-- | 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