[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