blob: 23bb0bee6577d2f7a635d3ef2147b5522bb5022c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# LANGUAGE CPP #-}
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--
module GHC.CmmToLlvm.Ppr (
pprLlvmCmmDecl, pprLlvmData, infoSection
) where
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
-- ----------------------------------------------------------------------------
-- * Top level
--
-- | Pretty print LLVM data code
pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
pprLlvmData opts (globals, types) =
let ppLlvmTys (LMAlias a) = ppLlvmAlias a
ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
ppLlvmTys _other = empty
types' = vcat $ map ppLlvmTys types
globals' = ppLlvmGlobals opts globals
in types' $+$ globals'
-- | Pretty print LLVM code
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl (CmmData _ lmdata) = do
opts <- getLlvmOpts
return (vcat $ map (pprLlvmData opts) lmdata, [])
pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
= do let lbl = case mb_info of
Nothing -> entry_lbl
Just (CmmStaticsRaw info_lbl _) -> info_lbl
link = if externallyVisibleCLabel lbl
then ExternallyVisible
else Internal
lmblocks = map (\(BasicBlock id stmts) ->
LlvmBlock (getUnique id) stmts) blks
funDec <- llvmFunSig live lbl link
dflags <- getDynFlags
opts <- getLlvmOpts
platform <- getPlatform
let buildArg = fsLit . showSDoc dflags . ppPlainName opts
funArgs = map buildArg (llvmFunArgs platform live)
funSect = llvmFunSection opts (decName funDec)
-- generate the info table
prefix <- case mb_info of
Nothing -> return Nothing
Just (CmmStaticsRaw _ statics) -> do
infoStatics <- mapM genData statics
let infoTy = LMStruct $ map getStatType infoStatics
return $ Just $ LMStaticStruc infoStatics infoTy
let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
prefix lmblocks
name = decName $ funcDecl fun
defName = llvmDefLabel name
funcDecl' = (funcDecl fun) { decName = defName }
fun' = fun { funcDecl = funcDecl' }
funTy = LMFunction funcDecl'
funVar = LMGlobalVar name
(LMPointer funTy)
link
Nothing
Nothing
Alias
defVar = LMGlobalVar defName
(LMPointer funTy)
(funcLinkage funcDecl')
(funcSect fun)
(funcAlign funcDecl')
Alias
alias = LMGlobal funVar
(Just $ LMBitc (LMStaticPointer defVar)
i8Ptr)
return (ppLlvmGlobal opts alias $+$ ppLlvmFunction opts fun', [])
-- | The section we are putting info tables and their entry code into, should
-- be unique since we process the assembly pattern matching this.
infoSection :: String
infoSection = "X98A__STRIP,__me"
|
