[commit: ghc] wip/kavon-nosplit-llvm: need to do preprocessing of CmmStatics (6bb6535)

git at git.haskell.org git at git.haskell.org
Tue Jun 27 09:16:20 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/kavon-nosplit-llvm
Link       : http://ghc.haskell.org/trac/ghc/changeset/6bb6535b1384c6727725ceee410fe7f2ed981f06/ghc

>---------------------------------------------------------------

commit 6bb6535b1384c6727725ceee410fe7f2ed981f06
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Tue Jun 6 17:16:11 2017 +0100

    need to do preprocessing of CmmStatics


>---------------------------------------------------------------

6bb6535b1384c6727725ceee410fe7f2ed981f06
 compiler/llvmGen/LlvmMangler.hs | 64 ++++++++++++++++++++---------------------
 1 file changed, 31 insertions(+), 33 deletions(-)

diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs
index ed38202..4a93b37 100644
--- a/compiler/llvmGen/LlvmMangler.hs
+++ b/compiler/llvmGen/LlvmMangler.hs
@@ -65,43 +65,41 @@ withComment com line = B.concat [B.pack $ wrap com, line]
 -- above that label.
 addInfoTable :: LabelMap CmmStatics -> Rewrite
 addInfoTable info _ line = do
-        return $ withComment (show line) line
-        -- labName <- B.stripPrefix labPrefix line
-        -- return $ withComment "stripped an L" labName
-        -- (i, _) <- B.readInt labName
-        -- return $ withComment (show i) line
-        -- statics <- mapLookup (toKey i) info
+        labName <- B.stripPrefix labPrefix line
+        (i, _) <- B.readInt labName
+        statics <- mapLookup (toKey i) info
+        return $ withComment ("found statics for: " ++ show i) line
         -- return $ emitInfo line statics
 
     where
-        labPrefix = B.pack "\nL" -- TODO(kavon): check if this changes on different platforms.
+        labPrefix = B.pack "L" -- TODO(kavon): check if this changes on different platforms.
         toKey = uniqueToLbl . intToUnique
-        eol = "\n"
-        
-        emitInfo label (Statics _ statics) = 
-            -- TODO(kavon): maybe put an alignment directive first?
-            B.concat $ (map staticToByteStr statics) ++ [label]
-            
-        staticToByteStr :: CmmStatic -> B.ByteString
-        staticToByteStr (CmmUninitialised sz) = let
-                width = gcd sz 8
-                zeroes = take (sz `div` width) ['0','0'..]
-                name = szName width
-            in
-                B.pack $ name ++ (intersperse ',' zeroes) ++ eol
-        
-        staticToByteStr (CmmStaticLit (CmmLabelDiffOff _ _ _)) = B.pack "# label diff static\n"
-                
-        staticToByteStr _ = B.pack "# todo: other static\n"
-                
-        -- TODO(kavon): does this change on ARM?
-        -- translate a size (in bytes) to its assembly directive, followed by a space.
-        szName :: Int -> String
-        szName 1 = ".byte "
-        szName 2 = ".value "
-        szName 4 = ".long "
-        szName 8 = ".quad "
-        szName _ = error "szName -- invalid byte width"
+        -- eol = "\n"
+        -- 
+        -- emitInfo label (Statics _ statics) = 
+        --     -- TODO(kavon): maybe put an alignment directive first?
+        --     B.concat $ (map staticToByteStr statics) ++ [label]
+        --     
+        -- staticToByteStr :: CmmStatic -> B.ByteString
+        -- staticToByteStr (CmmUninitialised sz) = let
+        --         width = gcd sz 8
+        --         zeroes = take (sz `div` width) ['0','0'..]
+        --         name = szName width
+        --     in
+        --         B.pack $ name ++ (intersperse ',' zeroes) ++ eol
+        -- 
+        -- staticToByteStr (CmmStaticLit (CmmLabelDiffOff _ _ _)) = B.pack "# label diff static\n"
+        --         
+        -- staticToByteStr _ = B.pack "# todo: other static\n"
+        --         
+        -- -- TODO(kavon): does this change on ARM?
+        -- -- translate a size (in bytes) to its assembly directive, followed by a space.
+        -- szName :: Int -> String
+        -- szName 1 = ".byte "
+        -- szName 2 = ".value "
+        -- szName 4 = ".long "
+        -- szName 8 = ".quad "
+        -- szName _ = error "szName -- invalid byte width"
             
 
 -- | Rewrite a line of assembly source with the given rewrites,



More information about the ghc-commits mailing list