module GHC.CmmToLlvm.Ppr (
pprLlvmCmmDecl, pprLlvmData, infoSection
) where
import GHC.Prelude
import GHC.Llvm
import GHC.CmmToLlvm.Base
import GHC.CmmToLlvm.Data
import GHC.CmmToLlvm.Config
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Types.Unique
pprLlvmData :: IsDoc doc => LlvmCgConfig -> LlvmData -> doc
pprLlvmData :: forall doc. IsDoc doc => LlvmCgConfig -> LlvmData -> doc
pprLlvmData LlvmCgConfig
cfg ([LMGlobal]
globals, [LlvmType]
types) =
let ppLlvmTys :: LlvmType -> b
ppLlvmTys (LMAlias LlvmAlias
a) = Line b -> b
forall doc. IsDoc doc => Line doc -> doc
line (Line b -> b) -> Line b -> b
forall a b. (a -> b) -> a -> b
$ LlvmAlias -> Line b
forall doc. IsLine doc => LlvmAlias -> doc
ppLlvmAlias LlvmAlias
a
ppLlvmTys (LMFunction LlvmFunctionDecl
f) = LlvmFunctionDecl -> b
forall doc. IsDoc doc => LlvmFunctionDecl -> doc
ppLlvmFunctionDecl LlvmFunctionDecl
f
ppLlvmTys LlvmType
_other = b
forall doc. IsOutput doc => doc
empty
types' :: doc
types' = [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ([doc] -> doc) -> [doc] -> doc
forall a b. (a -> b) -> a -> b
$ (LlvmType -> doc) -> [LlvmType] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map LlvmType -> doc
forall {b}. IsDoc b => LlvmType -> b
ppLlvmTys [LlvmType]
types
globals' :: doc
globals' = LlvmCgConfig -> [LMGlobal] -> doc
forall doc. IsDoc doc => LlvmCgConfig -> [LMGlobal] -> doc
ppLlvmGlobals LlvmCgConfig
cfg [LMGlobal]
globals
in doc
types' doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ doc
globals'
{-# SPECIALIZE pprLlvmData :: LlvmCgConfig -> LlvmData -> SDoc #-}
{-# SPECIALIZE pprLlvmData :: LlvmCgConfig -> LlvmData -> HDoc #-}
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (HDoc, SDoc)
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (HDoc, SDoc)
pprLlvmCmmDecl (CmmData Section
_ [LlvmData]
lmdata) = do
opts <- LlvmM LlvmCgConfig
getConfig
return ( vcat $ map (pprLlvmData opts) lmdata
, vcat $ map (pprLlvmData opts) lmdata)
pprLlvmCmmDecl (CmmProc Maybe RawCmmStatics
mb_info CLabel
entry_lbl [GlobalRegUse]
live (ListGraph [GenBasicBlock LlvmStatement]
blks))
= do let lbl :: CLabel
lbl = case Maybe RawCmmStatics
mb_info of
Maybe RawCmmStatics
Nothing -> CLabel
entry_lbl
Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) -> CLabel
info_lbl
link :: LlvmLinkageType
link = if CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
then LlvmLinkageType
ExternallyVisible
else LlvmLinkageType
Internal
lmblocks :: [LlvmBlock]
lmblocks = (GenBasicBlock LlvmStatement -> LlvmBlock)
-> [GenBasicBlock LlvmStatement] -> [LlvmBlock]
forall a b. (a -> b) -> [a] -> [b]
map (\(BasicBlock BlockId
id [LlvmStatement]
stmts) ->
LlvmBlockId -> [LlvmStatement] -> LlvmBlock
LlvmBlock (BlockId -> LlvmBlockId
forall a. Uniquable a => a -> LlvmBlockId
getUnique BlockId
id) [LlvmStatement]
stmts) [GenBasicBlock LlvmStatement]
blks
funDec <- [GlobalRegUse]
-> CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl
llvmFunSig [GlobalRegUse]
live CLabel
lbl LlvmLinkageType
link
cfg <- getConfig
platform <- getPlatform
let buildArg = String -> FastString
fsLit (String -> FastString)
-> (LlvmVar -> String) -> LlvmVar -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> SDoc -> String
showSDocOneLine (LlvmCgConfig -> SDocContext
llvmCgContext LlvmCgConfig
cfg)(SDoc -> String) -> (LlvmVar -> SDoc) -> LlvmVar -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmCgConfig -> LlvmVar -> SDoc
forall doc. IsLine doc => LlvmCgConfig -> LlvmVar -> doc
ppPlainName LlvmCgConfig
cfg
funArgs = (LlvmVar -> FastString) -> [LlvmVar] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map LlvmVar -> FastString
buildArg (Platform -> [GlobalRegUse] -> [LlvmVar]
llvmFunArgs Platform
platform [GlobalRegUse]
live)
funSect = LlvmCgConfig -> FastString -> LMSection
llvmFunSection LlvmCgConfig
cfg (LlvmFunctionDecl -> FastString
decName LlvmFunctionDecl
funDec)
prefix <- case mb_info of
Maybe RawCmmStatics
Nothing -> Maybe LlvmStatic -> LlvmM (Maybe LlvmStatic)
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmStatic
forall a. Maybe a
Nothing
Just (CmmStaticsRaw CLabel
_ [CmmStatic]
statics) -> do
infoStatics <- (CmmStatic -> LlvmM LlvmStatic)
-> [CmmStatic] -> LlvmM [LlvmStatic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CmmStatic -> LlvmM LlvmStatic
genData [CmmStatic]
statics
let infoTy = [LlvmType] -> LlvmType
LMStruct ([LlvmType] -> LlvmType) -> [LlvmType] -> LlvmType
forall a b. (a -> b) -> a -> b
$ (LlvmStatic -> LlvmType) -> [LlvmStatic] -> [LlvmType]
forall a b. (a -> b) -> [a] -> [b]
map LlvmStatic -> LlvmType
getStatType [LlvmStatic]
infoStatics
return $ Just $ LMStaticStruc infoStatics infoTy
let fun = LlvmFunctionDecl
-> [FastString]
-> [LlvmFuncAttr]
-> LMSection
-> Maybe LlvmStatic
-> [LlvmBlock]
-> LlvmFunction
LlvmFunction LlvmFunctionDecl
funDec [FastString]
funArgs [LlvmFuncAttr]
llvmStdFunAttrs LMSection
funSect
Maybe LlvmStatic
prefix [LlvmBlock]
lmblocks
name = LlvmFunctionDecl -> FastString
decName (LlvmFunctionDecl -> FastString) -> LlvmFunctionDecl -> FastString
forall a b. (a -> b) -> a -> b
$ LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun
defName = FastString -> FastString
llvmDefLabel FastString
name
funcDecl' = (LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun) { decName = defName }
fun' = LlvmFunction
fun { funcDecl = funcDecl' }
funTy = LlvmFunctionDecl -> LlvmType
LMFunction LlvmFunctionDecl
funcDecl'
funVar = FastString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar FastString
name
(LlvmType -> LlvmType
LMPointer LlvmType
funTy)
LlvmLinkageType
link
LMSection
forall a. Maybe a
Nothing
LMAlign
forall a. Maybe a
Nothing
LMConst
Alias
defVar = FastString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar FastString
defName
(LlvmType -> LlvmType
LMPointer LlvmType
funTy)
(LlvmFunctionDecl -> LlvmLinkageType
funcLinkage LlvmFunctionDecl
funcDecl')
(LlvmFunction -> LMSection
funcSect LlvmFunction
fun)
(LlvmFunctionDecl -> LMAlign
funcAlign LlvmFunctionDecl
funcDecl')
LMConst
Alias
alias = LlvmVar -> Maybe LlvmStatic -> LMGlobal
LMGlobal LlvmVar
funVar
(LlvmStatic -> Maybe LlvmStatic
forall a. a -> Maybe a
Just (LlvmStatic -> Maybe LlvmStatic) -> LlvmStatic -> Maybe LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmStatic -> LlvmType -> LlvmStatic
LMBitc (LlvmVar -> LlvmStatic
LMStaticPointer LlvmVar
defVar)
LlvmType
i8Ptr)
return ( vcat [line $ ppLlvmGlobal cfg alias, ppLlvmFunction cfg fun']
, vcat [line $ ppLlvmGlobal cfg alias, ppLlvmFunction cfg fun'])
infoSection :: String
infoSection :: String
infoSection = String
"X98A__STRIP,__me"