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