{-# LANGUAGE CPP #-}
module GHC.CmmToLlvm.Ppr (
pprLlvmCmmDecl, pprLlvmData, infoSection
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Driver.Ppr
import GHC.Llvm
import GHC.CmmToLlvm.Base
import GHC.CmmToLlvm.Data
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Types.Unique
pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
pprLlvmData LlvmOpts
opts ([LMGlobal]
globals, [LlvmType]
types) =
let ppLlvmTys :: LlvmType -> SDoc
ppLlvmTys (LMAlias LlvmAlias
a) = LlvmAlias -> SDoc
ppLlvmAlias LlvmAlias
a
ppLlvmTys (LMFunction LlvmFunctionDecl
f) = LlvmFunctionDecl -> SDoc
ppLlvmFunctionDecl LlvmFunctionDecl
f
ppLlvmTys LlvmType
_other = SDoc
empty
types' :: SDoc
types' = [SDoc] -> SDoc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LlvmType -> SDoc
ppLlvmTys [LlvmType]
types
globals' :: SDoc
globals' = LlvmOpts -> [LMGlobal] -> SDoc
ppLlvmGlobals LlvmOpts
opts [LMGlobal]
globals
in SDoc
types' SDoc -> SDoc -> SDoc
$+$ SDoc
globals'
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl (CmmData Section
_ [LlvmData]
lmdata) = do
LlvmOpts
opts <- LlvmM LlvmOpts
getLlvmOpts
forall (m :: * -> *) a. Monad m => a -> m a
return ([SDoc] -> SDoc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmOpts -> LlvmData -> SDoc
pprLlvmData LlvmOpts
opts) [LlvmData]
lmdata, [])
pprLlvmCmmDecl (CmmProc Maybe RawCmmStatics
mb_info CLabel
entry_lbl [GlobalReg]
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 = forall a b. (a -> b) -> [a] -> [b]
map (\(BasicBlock BlockId
id [LlvmStatement]
stmts) ->
LlvmBlockId -> [LlvmStatement] -> LlvmBlock
LlvmBlock (forall a. Uniquable a => a -> LlvmBlockId
getUnique BlockId
id) [LlvmStatement]
stmts) [GenBasicBlock LlvmStatement]
blks
LlvmFunctionDecl
funDec <- [GlobalReg] -> CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl
llvmFunSig [GlobalReg]
live CLabel
lbl LlvmLinkageType
link
DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
LlvmOpts
opts <- LlvmM LlvmOpts
getLlvmOpts
Platform
platform <- LlvmM Platform
getPlatform
let buildArg :: LlvmVar -> FastString
buildArg = String -> FastString
fsLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmOpts -> LlvmVar -> SDoc
ppPlainName LlvmOpts
opts
funArgs :: [FastString]
funArgs = forall a b. (a -> b) -> [a] -> [b]
map LlvmVar -> FastString
buildArg (Platform -> [GlobalReg] -> [LlvmVar]
llvmFunArgs Platform
platform [GlobalReg]
live)
funSect :: LMSection
funSect = LlvmOpts -> FastString -> LMSection
llvmFunSection LlvmOpts
opts (LlvmFunctionDecl -> FastString
decName LlvmFunctionDecl
funDec)
Maybe LlvmStatic
prefix <- case Maybe RawCmmStatics
mb_info of
Maybe RawCmmStatics
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (CmmStaticsRaw CLabel
_ [CmmStatic]
statics) -> do
[LlvmStatic]
infoStatics <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CmmStatic -> LlvmM LlvmStatic
genData [CmmStatic]
statics
let infoTy :: LlvmType
infoTy = [LlvmType] -> LlvmType
LMStruct forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LlvmStatic -> LlvmType
getStatType [LlvmStatic]
infoStatics
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticStruc [LlvmStatic]
infoStatics LlvmType
infoTy
let fun :: LlvmFunction
fun = LlvmFunctionDecl
-> [FastString]
-> [LlvmFuncAttr]
-> LMSection
-> Maybe LlvmStatic
-> [LlvmBlock]
-> LlvmFunction
LlvmFunction LlvmFunctionDecl
funDec [FastString]
funArgs [LlvmFuncAttr]
llvmStdFunAttrs LMSection
funSect
Maybe LlvmStatic
prefix [LlvmBlock]
lmblocks
name :: FastString
name = LlvmFunctionDecl -> FastString
decName forall a b. (a -> b) -> a -> b
$ LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun
defName :: FastString
defName = FastString -> FastString
llvmDefLabel FastString
name
funcDecl' :: LlvmFunctionDecl
funcDecl' = (LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun) { decName :: FastString
decName = FastString
defName }
fun' :: LlvmFunction
fun' = LlvmFunction
fun { funcDecl :: LlvmFunctionDecl
funcDecl = LlvmFunctionDecl
funcDecl' }
funTy :: LlvmType
funTy = LlvmFunctionDecl -> LlvmType
LMFunction LlvmFunctionDecl
funcDecl'
funVar :: LlvmVar
funVar = FastString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar FastString
name
(LlvmType -> LlvmType
LMPointer LlvmType
funTy)
LlvmLinkageType
link
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
LMConst
Alias
defVar :: LlvmVar
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 :: LMGlobal
alias = LlvmVar -> Maybe LlvmStatic -> LMGlobal
LMGlobal LlvmVar
funVar
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LlvmStatic -> LlvmType -> LlvmStatic
LMBitc (LlvmVar -> LlvmStatic
LMStaticPointer LlvmVar
defVar)
LlvmType
i8Ptr)
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmOpts -> LMGlobal -> SDoc
ppLlvmGlobal LlvmOpts
opts LMGlobal
alias SDoc -> SDoc -> SDoc
$+$ LlvmOpts -> LlvmFunction -> SDoc
ppLlvmFunction LlvmOpts
opts LlvmFunction
fun', [])
infoSection :: String
infoSection :: String
infoSection = String
"X98A__STRIP,__me"