[commit: ghc] wip/kavon-nosplit-llvm: cleaning up cruft (0f36feb)

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


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

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

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

commit 0f36feb9f94bab99b0e1e64fd996fb9911182c70
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Wed Jun 7 15:38:53 2017 +0100

    cleaning up cruft


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

0f36feb9f94bab99b0e1e64fd996fb9911182c70
 compiler/llvmGen/LlvmCodeGen/Data.hs | 48 ++++++++++++++++++++++++++++++++----
 compiler/llvmGen/LlvmMangler.hs      | 40 ++++++------------------------
 2 files changed, 50 insertions(+), 38 deletions(-)

diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 436438d..4996aeb 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -157,13 +157,51 @@ genStaticLit (CmmHighStackMark)
 -- CmmStatic at return points of a cpscall.
 cvtForMangler :: CmmStatics -> LlvmM ManglerStr
 cvtForMangler (Statics _ datum) =
-        mapM doStatic datum
+        mapM cvtStatic datum
     where
-        doStatic :: CmmStatic -> LlvmM (B.ByteString -> B.ByteString)
-        doStatic (CmmStaticLit lit) = return $ \ _ -> B.pack "## todo"
+        cvtStatic :: CmmStatic -> LlvmM (B.ByteString -> B.ByteString)
+        cvtStatic (CmmStaticLit lit) = cvtLit lit
         
         -- XXX these are not expected to appear at return points at the moment.
-        doStatic (CmmUninitialised _) = error "doStatic -- uninit unhandled"
-        doStatic (CmmString _) = error "doStatic -- string unhandled"
+        cvtStatic (CmmUninitialised _) = error "cvtStatic -- uninit unhandled"
+        cvtStatic (CmmString _) = error "cvtStatic -- string unhandled"
+        
+        
+        cvtLit _ = return $ test $ B.pack "## todo: some other CmmLit for " 
+        
+        some bstr _ = bstr
+        
+        test bstr lab = B.concat [
+                bstr,
+                lab,
+                B.pack "\n"
+            ]
+        
+        -- 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"
         
         
diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs
index 63d7d41..27f4a1f 100644
--- a/compiler/llvmGen/LlvmMangler.hs
+++ b/compiler/llvmGen/LlvmMangler.hs
@@ -78,42 +78,16 @@ withComment com line = B.concat [B.pack $ wrap com, line]
 -- above that label.
 addInfoTable :: LabelMap ManglerStr -> Rewrite
 addInfoTable info _ line = do
-        labName <- B.stripPrefix labPrefix line
-        (i, _) <- B.readInt labName
+        retPt <- B.stripPrefix labPrefix line
+        (i, _) <- B.readInt retPt
         statics <- mapLookup (toKey i) info
-        return $ withComment ("found statics for: " ++ show i) line
-        -- return $ emitInfo line statics
-
+        fullName <- B.stripSuffix colon line
+        return $ B.concat $ (map (\f -> f fullName) statics) ++ [line]
     where
-        labPrefix = B.pack "L" -- TODO(kavon): check if this changes on different platforms.
+        -- TODO(kavon): check if prefix changes on different platforms.
+        labPrefix = B.pack "L" 
+        colon = B.pack ":"
         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"
-            
         
 -- | Rewrite a line of assembly source with the given rewrites,
 -- taking the first rewrite that applies for each kind of rewrite (label and non-label).



More information about the ghc-commits mailing list