blob: 576e84dda4851b9480e1f72370f422e9170f8966 (
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
|
{-# LANGUAGE CPP #-}
-- ----------------------------------------------------------------------------
-- | Pretty print helpers for the LLVM Code generator.
--
module LlvmCodeGen.Ppr (
pprLlvmCmmDecl, pprLlvmData, infoSection
) where
#include "HsVersions.h"
import GhcPrelude
import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.Data
import GHC.Cmm.CLabel
import GHC.Cmm
import FastString
import Outputable
import Unique
-- ----------------------------------------------------------------------------
-- * Top level
--
-- | Pretty print LLVM data code
pprLlvmData :: LlvmData -> SDoc
pprLlvmData (globals, types) =
let ppLlvmTys (LMAlias a) = ppLlvmAlias a
ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
ppLlvmTys _other = empty
types' = vcat $ map ppLlvmTys types
globals' = ppLlvmGlobals globals
in types' $+$ globals'
-- | Pretty print LLVM code
pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
pprLlvmCmmDecl (CmmData _ lmdata)
= return (vcat $ map pprLlvmData lmdata, [])
pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
= do let lbl = case mb_info of
Nothing -> entry_lbl
Just (RawCmmStatics 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
let buildArg = fsLit . showSDoc dflags . ppPlainName
funArgs = map buildArg (llvmFunArgs dflags live)
funSect = llvmFunSection dflags (decName funDec)
-- generate the info table
prefix <- case mb_info of
Nothing -> return Nothing
Just (RawCmmStatics _ 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 alias $+$ ppLlvmFunction 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"
|
