[commit: ghc] wip/kavon-nosplit-llvm: now just need to have mangler use the map (1c3e024)
git at git.haskell.org
git at git.haskell.org
Tue Jun 27 09:16:06 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/kavon-nosplit-llvm
Link : http://ghc.haskell.org/trac/ghc/changeset/1c3e024eaf3ebcfe1c7fecece265ea4fffdcb292/ghc
>---------------------------------------------------------------
commit 1c3e024eaf3ebcfe1c7fecece265ea4fffdcb292
Author: Kavon Farvardin <kavon at farvard.in>
Date: Mon Jun 5 14:45:26 2017 +0100
now just need to have mangler use the map
>---------------------------------------------------------------
1c3e024eaf3ebcfe1c7fecece265ea4fffdcb292
compiler/llvmGen/LlvmCodeGen.hs | 26 ++++++++++++++++++++------
compiler/llvmGen/LlvmCodeGen/Base.hs | 6 +++---
compiler/main/CodeOutput.hs | 1 -
3 files changed, 23 insertions(+), 10 deletions(-)
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 5596d59..00f52da 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -40,7 +40,7 @@ import System.IO
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply
-> Stream.Stream IO RawCmmGroup ()
- -> IO ()
+ -> IO ManglerInfo
llvmCodeGen dflags h us cmm_stream
= withTiming (pure dflags) (text "LLVM CodeGen") (const ()) $ do
bufh <- newBufHandle h
@@ -63,12 +63,13 @@ llvmCodeGen dflags h us cmm_stream
$+$ text "We will try though...")
-- run code generation
- runLlvm dflags ver bufh us $
- llvmCodeGen' (liftStream cmm_stream)
+ info <- runLlvm dflags ver bufh us $
+ llvmCodeGen' (liftStream cmm_stream)
bFlush bufh
+ return info
-llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup () -> LlvmM ()
+llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup () -> LlvmM ManglerInfo
llvmCodeGen' cmm_stream
= do -- Preamble
renderLlvm pprLlvmHeader
@@ -77,7 +78,7 @@ llvmCodeGen' cmm_stream
-- Procedures
let llvmStream = Stream.mapM llvmGroupLlvmGens cmm_stream
- _ <- Stream.collect llvmStream
+ infos <- Stream.collect llvmStream
-- Declare aliases for forward references
renderLlvm . pprLlvmData =<< generateExternDecls
@@ -85,7 +86,12 @@ llvmCodeGen' cmm_stream
-- Postamble
cmmUsedLlvmGens
-llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
+ -- combine all info
+ let info = foldl mapUnion mapEmpty infos
+
+ return $ Just info
+
+llvmGroupLlvmGens :: RawCmmGroup -> LlvmM (LabelMap CmmStatics)
llvmGroupLlvmGens cmm = do
-- Insert functions into map, collect data
@@ -100,11 +106,19 @@ llvmGroupLlvmGens cmm = do
return Nothing
cdata <- fmap catMaybes $ mapM split cmm
+ -- collect mangler info
+ let joinInfo acc grp = case grp of
+ CmmProc info _ _ _ -> mapUnion acc info
+ CmmData _ _ -> acc
+ info = foldl joinInfo mapEmpty cmm
+
{-# SCC "llvm_datas_gen" #-}
cmmDataLlvmGens cdata
{-# SCC "llvm_procs_gen" #-}
mapM_ cmmLlvmGen cmm
+ return info
+
-- -----------------------------------------------------------------------------
-- | Do LLVM code generation on all these Cmms data sections.
--
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 47db6c4..08c2d60 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -252,10 +252,10 @@ liftIO m = LlvmM $ \env -> do x <- m
return (x, env)
-- | Get initial Llvm environment.
-runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> UniqSupply -> LlvmM () -> IO ()
+runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> UniqSupply -> LlvmM a -> IO a
runLlvm dflags ver out us m = do
- _ <- runLlvmM m env
- return ()
+ (a, _) <- runLlvmM m env
+ return a
where env = LlvmEnv { envFunMap = emptyUFM
, envVarMap = emptyUFM
, envStackRegs = []
diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs
index 5a23e06..487dd46 100644
--- a/compiler/main/CodeOutput.hs
+++ b/compiler/main/CodeOutput.hs
@@ -190,7 +190,6 @@ outputLlvm dflags filenm cmm_stream
{-# SCC "llvm_output" #-} doOutput filenm $
\f -> {-# SCC "llvm_CodeGen" #-}
llvmCodeGen dflags f ncg_uniqs cmm_stream
- return Nothing -- TODO(kavon): return something
{-
************************************************************************
More information about the ghc-commits
mailing list