[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