Commit 90d2acd1 authored by dterei's avatar dterei
Browse files

Add CCS for llvm

parent fe05c022
......@@ -49,8 +49,10 @@ llvmCodeGen dflags h us cmms
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 []
env' <- {-# SCC "llvm_datas_gen" #-}
cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
_ <- {-# SCC "llvm_procs_gen" #-}
cmmProcLlvmGens dflags bufh us env' cmm 1 []
bFlush bufh
return ()
......@@ -62,15 +64,18 @@ cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
-> [LlvmUnresData] -> IO ( LlvmEnv )
cmmDataLlvmGens dflags h env [] lmdata
= let (env', lmdata') = resolveLlvmDatas env lmdata []
lmdoc = Prt.vcat $ map pprLlvmData lmdata'
= let (env', lmdata') = {-# SCC "llvm_resolve" #-}
resolveLlvmDatas env lmdata []
lmdoc = {-# SCC "llvm_data_ppr" #-}
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
= let lmdata'@(l, _, ty, _) = genLlvmData env cmm
= let lmdata'@(l, _, ty, _) = {-# SCC "llvm_data_gen" #-}
genLlvmData env cmm
env' = funInsert (strCLabel_llvm env l) ty env
in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
......@@ -93,7 +98,8 @@ 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 Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
in Prt.bufLeftRender h $ {-# SCC "llvm_data_ppr" #-}
pprLlvmData ([lmUsed], [])
cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
= cmmProcLlvmGens dflags h us env cmms count ivars
......@@ -104,7 +110,7 @@ cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivar
cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
(us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
Prt.bufLeftRender h $ Prt.vcat docs
Prt.bufLeftRender h $ {-# SCC "llvm_proc_ppr" #-} Prt.vcat docs
cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
......@@ -113,13 +119,15 @@ cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
-> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
cmmLlvmGen dflags us env cmm = do
-- rewrite assignments to global regs
let fixed_cmm = fixStgRegisters cmm
let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
fixStgRegisters cmm
dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
(pprCmmGroup (targetPlatform dflags) [fixed_cmm])
-- generate llvm code from cmm
let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
let ((env', llvmBC), usGen) = {-# SCC "llvm_proc_gen" #-}
initUs us $ genLlvmProc env fixed_cmm
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
(vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC)
......
......@@ -158,17 +158,26 @@ initLlvmEnv platform = LlvmEnv (emptyUFM, emptyUFM, defaultLlvmVersion, platform
-- | Clear variables from the environment.
clearVars :: LlvmEnv -> LlvmEnv
clearVars (LlvmEnv (e1, _, n, p)) = LlvmEnv (e1, emptyUFM, n, p)
clearVars (LlvmEnv (e1, _, n, p)) = {-# SCC "llvm_env_clear" #-}
LlvmEnv (e1, emptyUFM, n, p)
-- | Insert functions into the environment.
varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
varInsert s t (LlvmEnv (e1, e2, n, p)) = LlvmEnv (e1, addToUFM e2 s t, n, p)
funInsert s t (LlvmEnv (e1, e2, n, p)) = LlvmEnv (addToUFM e1 s t, e2, n, p)
varInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
varInsert s t (LlvmEnv (e1, e2, n, p)) = {-# SCC "llvm_env_vinsert" #-}
LlvmEnv (e1, addToUFM e2 s t, n, p)
funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
funInsert s t (LlvmEnv (e1, e2, n, p)) = {-# SCC "llvm_env_finsert" #-}
LlvmEnv (addToUFM e1 s t, e2, n, p)
-- | Lookup functions in the environment.
varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
varLookup s (LlvmEnv (_, e2, _, _)) = lookupUFM e2 s
funLookup s (LlvmEnv (e1, _, _, _)) = lookupUFM e1 s
varLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
varLookup s (LlvmEnv (_, e2, _, _)) = {-# SCC "llvm_env_vlookup" #-}
lookupUFM e2 s
funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
funLookup s (LlvmEnv (e1, _, _, _)) = {-# SCC "llvm_env_flookup" #-}
lookupUFM e1 s
-- | Get the LLVM version we are generating code for
getLlvmVer :: LlvmEnv -> LlvmVersion
......@@ -188,8 +197,8 @@ getLlvmPlatform (LlvmEnv (_, _, _, p)) = p
-- | Pretty print a 'CLabel'.
strCLabel_llvm :: LlvmEnv -> CLabel -> LMString
strCLabel_llvm env l
= (fsLit . show . llvmSDoc . pprCLabel (getLlvmPlatform env)) l
strCLabel_llvm env l = {-# SCC "llvm_strCLabel" #-}
(fsLit . show . llvmSDoc . pprCLabel (getLlvmPlatform env)) l
-- | Create an external definition for a 'CLabel' defined in another module.
genCmmLabelRef :: LlvmEnv -> CLabel -> LMGlobal
......
......@@ -41,7 +41,7 @@ type Section = (B.ByteString, B.ByteString)
-- | Read in assembly file and process
llvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()
llvmFixupAsm dflags f1 f2 = do
llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do
showPass dflags "LlVM Mangler"
r <- openBinaryFile f1 ReadMode
w <- openBinaryFile f2 WriteMode
......
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